Télécharger la plaquette Cast3M


fr en

Télécharger vfsym4.eso

Retour à la liste

Numérotation des lignes : 

vfsym4

  1. C VFSYM4    SOURCE    CB215821  20/11/25    13:42:29     10792          
  2. C NORV4     SOURCE    PV        09/03/12    21:29:43     6325
  3.       SUBROUTINE VFSYM4(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  4.      &            MPOSUR,MELTFA,MLEFA,MPOTEN,MPOCHP,MLENCL,
  5.      &            MPOVCL,ICHTE,ICHCL,ICHCO,MPOVCO,IOP,
  6.      &            IPO2,SCMB,INDLI,VAL1,VAL2,IND22,IND2,IND,
  7.      &            IPO3,VAUX,TAB,MELEME,MPOGRA,MELVA1,MELVA2,
  8.      &            NBNN,NBFAC,MCHEL2,MCHAM2)
  9. C************************************************************************
  10. C
  11. C PROJET            :  CASTEM 2000
  12. C
  13. C NOM               :  NORV4
  14. C
  15. C DESCRIPTION       : Appelle par NORV1
  16. C
  17. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  18. C
  19. C AUTEUR            :  C. LE POTIER, DM2S/SFME/MTMS
  20. C
  21. C************************************************************************
  22. C
  23.       IMPLICIT INTEGER(I-N)
  24.       IMPLICIT REAL*8(A-H,O-Z)
  25.  
  26. -INC SMLENTI
  27. -INC SMELEME
  28. -INC SMCHPOI
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMCOORD
  33. -INC SMLREEL
  34. -INC SMCHAML
  35.  
  36.       POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME,
  37.      &         MELTFA.MELEME
  38.       POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL,
  39.      & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL,
  40.      & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVCO.MPOVAL
  41.       POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI,
  42.      &         MLEFA.MLENTI
  43.       INTEGER NBNN,NBREF
  44.  
  45. C**** Variable de SMLENTI, SMCHPOI
  46. C
  47.       INTEGER JG, N, NC,  NSOUPO, NAT, NBSOUS, NBNO,NBELEM
  48. C
  49. C**** Les includes
  50. C
  51.       INTEGER I1,ICOMP,ICOMGR,IGEOM
  52.      &     ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM
  53.      &     ,ISURF,IMAIL,ICHPO,ICHCL,ICHGRA,ICOEFF
  54.      &     ,NTOT,NSOMM,NCOMP,NFAC,NCEN
  55.      &     ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2
  56.      &     ,NLS1,NLS2,NLFCL
  57.      &     ,ISOUS,IELEM,INOEUD,ICELL,NCON,NFIN,INDGA,INDDR
  58.       INTEGER ICEN2
  59.       REAL*8 SCNX,SCNY,SURF,VOL,VAL,VALX,VALY,XG,XD,XF,XS1,XS2
  60.      &     ,YG,YD,YF,YS1,YS2,PSCA,XNORM,VECX,VECY,PSCAGX,PSCAGY,
  61.      &     PSCADX,PSCADY,K11G,K22G,K21G,K11D,K22D,K21D,VXG1,VXG2,
  62.      &     VXAU,VYAU,VXD1,VXD2,VYG1,VYG2,TRG1,TRG2,
  63.      &     TRD1,TRD2,TRG,TRD,AUX,AUY,UN,TRGNS1,TRGNS2,EXPR1,EXPR2,COEFD
  64.       REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2,
  65.      & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,VX,VY,COEF1X,COEF2X,
  66.      & COEF1Y,COEF2Y,CX,CY,ANCX,ANCY,DIFFX,DIFFY,XLONGG,XLONGD
  67.      &  VALD,VALG,COEF,GX,GY,XMINK11,XMAXK11,XMINK22,XMAXK22,THETA,
  68.      &  AUXRE,AUXMA
  69.  
  70.       REAL*8 VECXG1(2),VECYG1(2)
  71.       REAL*8 VECXG2(2),VECYG2(2)
  72.       REAL*8 VECXD1(2),VECYD1(2)
  73.       REAL*8 VECXD2(2),VECYD2(2)
  74.       REAL*8 EPS,TRACE
  75.       INTEGER ICRIT
  76.       CHARACTER*(4) NOMCOM(18)
  77.       CHARACTER*8 TYPE
  78. C
  79.       DATA NOMCOM  /'P1DX','P1DY',
  80.      &     'P2DX','P2DY',
  81.      &     'P3DX','P3DY',
  82.      &     'P4DX','P4DY',
  83.      &     'P5DX','P5DY',
  84.      &     'P6DX','P6DY',
  85.      &     'P7DX','P7DY',
  86.      &     'P8DX','P8DY',
  87.      &     'P9DX','P9DY'/
  88.  
  89.       INTEGER NDIM
  90.       SEGMENT MMAT1
  91.       REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM)
  92.       INTEGER IC(NDIM)
  93.       ENDSEGMENT
  94.  
  95.       INTEGER K1,K2
  96.       SEGMENT INDICE
  97.       INTEGER NUME(K1,K2)
  98.       ENDSEGMENT
  99.       POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE
  100.  
  101.       SEGMENT MATRICE
  102.       REAL*8 MAT(K1,K2)
  103.       ENDSEGMENT
  104.       POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE
  105.  
  106.       INTEGER K3
  107.       SEGMENT POINT2
  108.       INTEGER POINT(K3)
  109.       ENDSEGMENT
  110.       POINTEUR IPO2.POINT2
  111.  
  112.       SEGMENT MATRICE2
  113.       REAL*8 MAT2(K1,K2)
  114.       ENDSEGMENT
  115.       POINTEUR MATR1.MATRICE2,MATR2.MATRICE2
  116.  
  117.       SEGMENT POINT3
  118.       INTEGER POINT33(K3)
  119.       ENDSEGMENT
  120.       POINTEUR IPO3.POINT3
  121.  
  122.       SEGMENT INDICE3
  123.       INTEGER NU(K1,K2)
  124.       ENDSEGMENT
  125.       POINTEUR INDIC.INDICE3,INDIC2.INDICE3
  126.  
  127.       SEGMENT REP
  128.       INTEGER  ID(K3)
  129.       ENDSEGMENT
  130.       POINTEUR TAB.REP,INDLI.REP
  131.  
  132.       INTEGER K5
  133.       SEGMENT NBFAC
  134.       INTEGER NBFACEL(K5)
  135.       INTEGER IMELEM(K5)
  136.       ENDSEGMENT
  137.  
  138.       INTEGER K7,K8
  139.       SEGMENT MISZERO
  140.       INTEGER  TABL(K7)
  141.       INTEGER  TABL2(K7)
  142.       INTEGER  TABL1(K8),IPOS(K8),ICOURANT(K8)
  143.       REAL*8 XMAX(K7)
  144.       ENDSEGMENT
  145.       POINTEUR ITAB.MISZERO
  146.  
  147.  
  148.        NMAI1 = 0
  149.        NBSO = MAX(1,MELTFA.LISOUS(/1))
  150.        IELTFA = MELTFA
  151.        IF (NBSO.EQ.1) THEN
  152.        K5 = MELTFA.NUM(/2)
  153.        ELSEIF (NBSO.EQ.2) THEN
  154.        IPT1 = MELTFA.LISOUS(1)
  155.        SEGACT IPT1
  156.        N1 = IPT1.NUM(/2)
  157.        NMAI1 = N1
  158.        SEGDES IPT1
  159.        IPT2 = MELTFA.LISOUS(2)
  160.        SEGACT IPT2
  161.        N2 = IPT2.NUM(/2)
  162.        NMAI2 = N2
  163.        SEGDES IPT2
  164.        K5 = N1 + N2
  165.        ENDIF
  166.  
  167.  
  168.  
  169.        IF (NBSO.EQ.1) THEN
  170.        DO I = 1,K5
  171.            NTYPE = MELTFA.ITYPEL
  172.            IF (NTYPE .EQ. 4) THEN
  173.            NBFACEL(I) = 3
  174.            IMELEM(I) = MELTFA
  175.            ELSE
  176.            NBFACEL(I) = 4
  177.            IMELEM(I) = MELTFA
  178.            ENDIF
  179. c       SEGDES MELTFA
  180.        ENDDO
  181.        ELSEIF (NBSO.EQ.2) THEN
  182.          IPT1 = MELTFA.LISOUS(1)
  183.          SEGACT IPT1
  184.          IPT2 = MELTFA.LISOUS(2)
  185.          SEGACT IPT2
  186.        DO I = 1,K5
  187.          N1 = IPT1.NUM(/2)
  188.          IF (I.LE.N1) THEN
  189.            IF (IPT1.ITYPEL .EQ. 4) THEN
  190.            NBFACEL(I) = 3
  191.            IMELEM(I) =  IPT1
  192.            ELSE
  193.            NBFACEL(I) = 4
  194.            IMELEM(I) = IPT1
  195.            ENDIF
  196. c         SEGDES IPT1
  197.          ELSE
  198.            IF (IPT2.ITYPEL .EQ. 4) THEN
  199.            NBFACEL(I) = 3
  200.            IMELEM(I) = IPT2
  201.            ELSE
  202.            NBFACEL(I) = 4
  203.            IMELEM(I) =  IPT2
  204.            ENDIF
  205. c           SEGDES IPT2
  206.         ENDIF
  207.         ENDDO
  208.         ENDIF
  209.  
  210.  
  211.  
  212.       NFAC=MELEFL.NUM(/2)
  213.  
  214. C EVALUATION DE NBNN
  215.       NCON = 0
  216.       DO NLCF= 1, NFAC, 1
  217.  
  218.  
  219.          NGCF=MELEFL.NUM(2,NLCF)
  220.          NGCF1=MELEFA.NUM(1,NLCF)
  221.          NGCF2=MELEFP.NUM(3,NLCF)
  222.          IF((NGCF.NE.NGCF1) .OR. (NGCF.NE.NGCF2))THEN
  223.             WRITE(IOIMP,*)
  224.      &           'Il ne faut pas jouer avec la table domaine!'
  225.             CALL ERREUR(5)
  226.             GOTO 9999
  227.          ENDIF
  228.  
  229.          NGCG=MELEFL.NUM(1,NLCF)
  230.          NGCD=MELEFL.NUM(3,NLCF)
  231.          NLCG=MLECEN.LECT(NGCG)
  232.          NLCD=MLECEN.LECT(NGCD)
  233.  
  234.          NGS1=MELEFP.NUM(1,NLCF)
  235.          NGS2=MELEFP.NUM(2,NLCF)
  236.          NLS1=MLESOM.LECT(NGS1)
  237.          NLS2=MLESOM.LECT(NGS2)
  238.  
  239.  
  240.  
  241.              DO I5 = 1,INDLI.ID(NLS1)
  242.              INDAUX = IND2.NUME(I5,NLS1)
  243.              IF (INDAUX.EQ.NGCF) THEN
  244.              IAFF = I5
  245.              IG = IAFF
  246.              GOTO 6399
  247.              ENDIF
  248.              ENDDO
  249.  6399        CONTINUE
  250.  
  251.  
  252.           INDIC = IPO3.POINT33(NLS1)
  253.           SEGACT INDIC *MOD
  254.           INDIC2 = IPO3.POINT33(NLS2)
  255.           SEGACT INDIC2 *MOD
  256.           ICON = TAB.ID(NLS1)
  257.           DO JAUX = 1,TAB.ID(NLS2)
  258.                J1 = INDIC2.NU(IG,JAUX)
  259. c       WRITE(6,*) 'IG= ',IG,'JAUX= ',JAUX,'NLS2= ',NLS2,'J1= ',J1
  260.                DO IAUX2 = 1,TAB.ID(NLS1)
  261.                J2 = INDIC.NU(IG,IAUX2)
  262. c       WRITE(6,*) 'IG= ',IG,'IAUX2= ',IAUX2,'NLS1= ',NLS1,'J2= ',J2
  263.                IF ((J1.EQ.J2).OR.(J1.EQ.0).OR.(J2.EQ.0)) THEN
  264.                GOTO 5999
  265.                ENDIF
  266.                ENDDO
  267.                ICON = ICON +1
  268.  5999          CONTINUE
  269.  
  270.          ENDDO
  271.           SEGDES INDIC *MOD
  272.           SEGDES INDIC2 *MOD
  273.          NCON = MAX(NCON,ICON)
  274. c         WRITE(6,*) 'NCON= ',NCON
  275.  
  276.          ENDDO
  277.          NCON = NCON + 1
  278.          NBNN = NCON
  279.  
  280.  
  281.  
  282. C DEFINITION DES PARAMETRES DU CHAMELEM DES COEFFICIENTS
  283.  
  284. c INITIALISATION DU CHAMELEM
  285.       N1=1
  286.       N2=1
  287.       N3=6
  288.       L1=8
  289.       SEGINI MCHELM
  290.       ICOEFF = MCHELM
  291.       MCHELM.TITCHE='Gradient'
  292.       MCHELM.IFOCHE=IFOUR
  293. C
  294.       ISOUS=0
  295.       NBSOUS=0
  296.       NBREF=0
  297.       NBELEM = NFAC
  298.       ISOUS=ISOUS+1
  299.       SEGINI MELEME
  300. C     ITYPEL=32 -> 'POLY'
  301.       ITYPEL=32
  302.       MCHELM.IMACHE(ISOUS)=MELEME
  303.       SEGINI MCHAML
  304.       MCHELM.ICHAML(ISOUS)=MCHAML
  305.       MCHAML.NOMCHE(1)='SCAL'
  306.       MCHAML.TYPCHE(1)='REAL*8          '
  307.       N1PTEL=NCON
  308.       N1EL=NBELEM
  309.       N2PTEL=0
  310.       N2EL=0
  311.       SEGINI MELVA1
  312.       MCHAML.IELVAL(1)=MELVA1
  313.  
  314.  
  315.  
  316. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  317. C CALCUL DE LA VITESSE EN CHAQUE FACE
  318.       AA = 0.0
  319.       BB = 0.0
  320. C INDICE QUI COMPTE LES COEFFICIENTS POUR CHAQUE FACE
  321.       NAUX2 = 0
  322.       NMOY = 0
  323.       DO NLCF= 1, NFAC, 1
  324.  
  325.  
  326.          NGCF=MELEFL.NUM(2,NLCF)
  327.          NGCF1=MELEFA.NUM(1,NLCF)
  328.          NGCF2=MELEFP.NUM(3,NLCF)
  329.          IF((NGCF.NE.NGCF1) .OR. (NGCF.NE.NGCF2))THEN
  330.             WRITE(IOIMP,*)
  331.      &           'Il ne faut pas jouer avec la table domaine!'
  332.             CALL ERREUR(5)
  333.             GOTO 9999
  334.          ENDIF
  335.  
  336.          MELEME.NUM(1,NLCF)=NGCF
  337.          MELVA1.VELCHE(1,NLCF)=0.0D0
  338.  
  339.          NGCG=MELEFL.NUM(1,NLCF)
  340.          NGCD=MELEFL.NUM(3,NLCF)
  341.          NLCG=MLECEN.LECT(NGCG)
  342.          NLCD=MLECEN.LECT(NGCD)
  343.  
  344.          NGS1=MELEFP.NUM(1,NLCF)
  345.          NGS2=MELEFP.NUM(2,NLCF)
  346.          NLS1=MLESOM.LECT(NGS1)
  347.          NLS2=MLESOM.LECT(NGS2)
  348.          SCNX=MPONOR.VPOCHA(NLCF,1)
  349.          SCNY=MPONOR.VPOCHA(NLCF,2)
  350.          SCN1X = SCNX
  351.          SCN1Y = SCNY
  352.          SURF=0.5D0*MPOSUR.VPOCHA(NLCF,1)
  353.          SCNX=SCNX*SURF
  354.          SCNY=SCNY*SURF
  355.  
  356.  
  357. C        3=IDIM+1
  358.          ICELL=(3*(NGCG -1))+1
  359.          XG=MCOORD.XCOOR(ICELL)
  360.          YG=MCOORD.XCOOR(ICELL+1)
  361.          ICELL=(3*(NGCD -1))+1
  362.          XD=MCOORD.XCOOR(ICELL)
  363.          YD=MCOORD.XCOOR(ICELL+1)
  364.          ICELL=(3*(NGCF -1))+1
  365.          XF=MCOORD.XCOOR(ICELL)
  366.          YF=MCOORD.XCOOR(ICELL+1)
  367.          ICELL=(3*(NGS1 -1))+1
  368.          XS1=MCOORD.XCOOR(ICELL)
  369.          YS1=MCOORD.XCOOR(ICELL+1)
  370.          ICELL=(3*(NGS2 -1))+1
  371.          XS2=MCOORD.XCOOR(ICELL)
  372.          YS2=MCOORD.XCOOR(ICELL+1)
  373.  
  374.           XLONG = (((XS1-XS2)**2) + ((YS1-YS2)**2))
  375.           XLONG = SQRT(XLONG)
  376.  
  377.          IG1 = 1
  378.          ID1 = 1
  379.          IG2 = 1
  380.          ID2 = 1
  381.          MELTFA =  IMELEM(NLCG)
  382.          NBF = NBFACEL(NLCG)
  383.          IF (NLCG.GT.NMAI1) THEN
  384.          NGAUX = NLCG - NMAI1
  385.          ELSE
  386.          NGAUX = NLCG
  387.          ENDIF
  388.  
  389.          DO J = 1,NBF
  390.          N1 = MELTFA.NUM(J,NGAUX)
  391.          NL1 = MLEFA.LECT(N1)
  392.  
  393.          NSOM1 = MELEFP.NUM(1,NL1)
  394.          NSOM2 = MELEFP.NUM(2,NL1)
  395.  
  396.          IF ((NSOM1.EQ.NGS1).OR.(NSOM2.EQ.NGS1)) THEN
  397.  
  398.          ICELL=(3*(N1 -1))+1
  399.          XF=MCOORD.XCOOR(ICELL)
  400.          YF=MCOORD.XCOOR(ICELL+1)
  401.          ICELL=(3*(NGS1 -1))+1
  402.          XS1=MCOORD.XCOOR(ICELL)
  403.          YS1=MCOORD.XCOOR(ICELL+1)
  404.  
  405. c on corrige pour VFSYM
  406.           IF (NBF.EQ.3) THEN
  407.           XF =  ((2.D0*XF/3.D0) + (XS1/3.D0))
  408.           YF =  ((2.D0*YF/3.D0) + (YS1/3.D0))
  409.           ENDIF
  410.  
  411.  
  412.  
  413.          VECXG1(IG1) = -(YF - YG)
  414.          VECYG1(IG1) = (XF - XG)
  415.          VX = (XG - XS1)
  416.          VY = (YG - YS1)
  417.          PSCA = (VX*VECXG1(IG1)) + (VY*VECYG1(IG1))
  418.          IF (PSCA.LT.0.0D0) THEN
  419.          VECXG1(IG1) = +(YF - YG)
  420.          VECYG1(IG1) = -(XF - XG)
  421.          ENDIF
  422.  
  423. c ON REPERE l'INDICE
  424.              IF ((NSOM2.NE.NGS2).AND.(NSOM1.NE.NGS2)) THEN
  425.              INDG1 = IG1
  426.              NG1 = N1
  427.              ENDIF
  428.  
  429.  
  430.           IG1 = IG1 + 1
  431.  
  432.           ENDIF
  433.          IF ((NSOM1.EQ.NGS2).OR.(NSOM2.EQ.NGS2)) THEN
  434.  
  435.          ICELL=(3*(N1 -1))+1
  436.          XF=MCOORD.XCOOR(ICELL)
  437.          YF=MCOORD.XCOOR(ICELL+1)
  438.          ICELL=(3*(NGS2 -1))+1
  439.          XS2=MCOORD.XCOOR(ICELL)
  440.          YS2=MCOORD.XCOOR(ICELL+1)
  441. c on corrige pour VFSYM
  442.           IF (NBF.EQ.3) THEN
  443.           XF =  ((2.D0*XF/3.D0) + (XS2/3.D0))
  444.           YF =  ((2.D0*YF/3.D0) + (YS2/3.D0))
  445.           ENDIF
  446.  
  447.  
  448.  
  449.          VECXG2(IG2) = -(YF - YG)
  450.          VECYG2(IG2) = (XF - XG)
  451.          VX = (XG - XS2)
  452.          VY = (YG - YS2)
  453.          PSCA = (VX*VECXG2(IG2)) + (VY*VECYG2(IG2))
  454.          IF (PSCA.LT.0.0D0) THEN
  455.          VECXG2(IG2) = +(YF - YG)
  456.          VECYG2(IG2) = -(XF - XG)
  457.          ENDIF
  458.  
  459.              IF ((NSOM2.NE.NGS1).AND.(NSOM1.NE.NGS1)) THEN
  460.              INDG2 = IG2
  461.              NG2 = N1
  462.              ENDIF
  463.           IG2 = IG2 + 1
  464.  
  465.           ENDIF
  466.         ENDDO
  467.  
  468.  
  469.          MELTFA =  IMELEM(NLCD)
  470.          NBF = NBFACEL(NLCD)
  471.          IF (NLCD.GT.NMAI1) THEN
  472.          NDAUX = NLCD -NMAI1
  473.          ELSE
  474.          NDAUX = NLCD
  475.          ENDIF
  476.  
  477.          DO J = 1,NBF
  478.          N1 = MELTFA.NUM(J,NDAUX)
  479.          NL1 = MLEFA.LECT(N1)
  480.  
  481.          NSOM1 = MELEFP.NUM(1,NL1)
  482.          NSOM2 = MELEFP.NUM(2,NL1)
  483.  
  484.          IF ((NSOM1.EQ.NGS1).OR.(NSOM2.EQ.NGS1)) THEN
  485.  
  486.          ICELL=(3*(N1 -1))+1
  487.          XF=MCOORD.XCOOR(ICELL)
  488.          YF=MCOORD.XCOOR(ICELL+1)
  489.          ICELL=(3*(NGS1 -1))+1
  490.          XS1=MCOORD.XCOOR(ICELL)
  491.          YS1=MCOORD.XCOOR(ICELL+1)
  492.  
  493. c on corrige pour VFSYM
  494.           IF (NBF.EQ.3) THEN
  495.           XF =  ((2.D0*XF/3.D0) + (XS1/3.D0))
  496.           YF =  ((2.D0*YF/3.D0) + (YS1/3.D0))
  497.           ENDIF
  498.  
  499.  
  500.  
  501.          VECXD1(ID1) = - (YF - YD)
  502.          VECYD1(ID1) = (XF - XD)
  503.          VX = (XD - XS1)
  504.          VY = (YD - YS1)
  505.          PSCA = (VX*VECXD1(ID1)) + (VY*VECYD1(ID1))
  506.          IF (PSCA.LT.0.0D0) THEN
  507.          VECXD1(ID1) = +(YF - YD)
  508.          VECYD1(ID1) = -(XF - XD)
  509.          ENDIF
  510.  
  511.              IF ((NSOM2.NE.NGS2).AND.(NSOM1.NE.NGS2)) THEN
  512.              INDD1 = ID1
  513.              ND1 = N1
  514.              ENDIF
  515.  
  516.           ID1 = ID1 + 1
  517.  
  518.           ENDIF
  519.          IF ((NSOM1.EQ.NGS2).OR.(NSOM2.EQ.NGS2)) THEN
  520.  
  521.          ICELL=(3*(N1 -1))+1
  522.          XF=MCOORD.XCOOR(ICELL)
  523.          YF=MCOORD.XCOOR(ICELL+1)
  524.          ICELL=(3*(NGS2 -1))+1
  525.          XS2=MCOORD.XCOOR(ICELL)
  526.          YS2=MCOORD.XCOOR(ICELL+1)
  527.  
  528. c on corrige pour VFSYM
  529.           IF (NBF.EQ.3) THEN
  530.           XF =  ((2.D0*XF/3.D0) + (XS2/3.D0))
  531.           YF =  ((2.D0*YF/3.D0) + (YS2/3.D0))
  532.           ENDIF
  533.  
  534.  
  535.  
  536.          VECXD2(ID2) = - (YF - YD)
  537.          VECYD2(ID2) = (XF - XD)
  538.          VX = (XD - XS2)
  539.          VY = (YD - YS2)
  540.          PSCA = (VX*VECXD2(ID2)) + (VY*VECYD2(ID2))
  541.          IF (PSCA.LT.0.0D0) THEN
  542.          VECXD2(ID2) = +(YF - YD)
  543.          VECYD2(ID2) = -(XF - XD)
  544.          ENDIF
  545.  
  546.              IF ((NSOM2.NE.NGS1).AND.(NSOM1.NE.NGS1)) THEN
  547.              INDD2 = ID2
  548.              ND2 = N1
  549.              ENDIF
  550.           ID2 = ID2 + 1
  551.  
  552.           ENDIF
  553.         ENDDO
  554.         AG1=ABS(  ( (VECXG1(1)*VECYG1(2)) -
  555.      &             (VECYG1(1))*VECXG1(2)) )
  556.  
  557.          AG2=ABS(  ( (VECXG2(1)*VECYG2(2)) -
  558.      &              (VECYG2(1))*VECXG2(2)) )
  559.  
  560.          AD1=ABS(  ( (VECXD1(1)*VECYD1(2)) -
  561.      &            (VECYD1(1))*VECXD1(2)) )
  562.  
  563.          AD2=ABS(  ( (VECXD2(1)*VECYD2(2)) -
  564.      &             (VECYD2(1))*VECXD2(2)) )
  565.  
  566. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1
  567.            COEF1 = ( (VECXG1(INDG1)*SCNX) + (VECYG1(INDG1)*SCNY) )
  568.      &              / AG1
  569.            IAUX = 3 - INDG1
  570.            COEF2 = ( (VECXG1(IAUX)*SCNX) + (VECYG1(IAUX)*SCNY) )
  571.      &              / AG1
  572.  
  573.            COEF3 = ( (VECXD1(INDD1)*SCNX) + (VECYD1(INDD1)*SCNY) )
  574.      &              / AD1
  575.            IAUX = 3 - INDD1
  576.            COEF4 = ( (VECXD1(IAUX)*SCNX) + (VECYD1(IAUX)*SCNY) )
  577.      &              / AD1
  578.  
  579.  
  580.                MARQ = 0
  581.                DO I5 = 1,INDLI.ID(NLS1)
  582.                INDAUX = IND2.NUME(I5,NLS1)
  583.                IF (INDAUX.EQ.NG1) THEN
  584.                IAFF = I5
  585.                IG1 = IAFF
  586.                GOTO 62
  587.                ENDIF
  588.                ENDDO
  589.  62              CONTINUE
  590.  
  591.            TRG1 =  SCMB.MAT(IAFF,NLS1)
  592.  
  593.                MARQ = 0
  594.                DO I5 = 1,INDLI.ID(NLS1)
  595.                INDAUX = IND2.NUME(I5,NLS1)
  596.                IF (INDAUX.EQ.NGCF) THEN
  597.                IAFF = I5
  598.                IG = IAFF
  599.                IGNS1 = IAFF
  600.                GOTO 63
  601.                ENDIF
  602.                ENDDO
  603.  63              CONTINUE
  604.            TRG =  SCMB.MAT(IAFF,NLS1)
  605.            TRGAUX =  TRG
  606.            TRGNS1 = TRG
  607.  
  608.             IAUX = 3 - INDG1
  609.             VXG1 = VECXG1(INDG1)/AG1
  610.             VXAU = VECXG1(IAUX)/AG1
  611.             VYG1 = VECYG1(INDG1)/AG1
  612.             VYAU = VECYG1(IAUX)/AG1
  613.  
  614.            IF (ICHTE.GT.0) THEN
  615.             IF (MPOTEN.VPOCHA(/2) .EQ.3) THEN
  616. c LE TENSEUR EST ANISOTROPE
  617.             K11G = MPOTEN.VPOCHA(NLCG,1)
  618.             K22G = MPOTEN.VPOCHA(NLCG,2)
  619.             K21G = MPOTEN.VPOCHA(NLCG,3)
  620.  
  621.             K11D = MPOTEN.VPOCHA(NLCD,1)
  622.             K22D = MPOTEN.VPOCHA(NLCD,2)
  623.             K21D = MPOTEN.VPOCHA(NLCD,3)
  624.             ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN
  625.             K11G = MPOTEN.VPOCHA(NLCG,1)
  626.             K22G = K11G
  627.             K21G = 0.0D0
  628.             K11D = MPOTEN.VPOCHA(NLCD,1)
  629.             K22D = K11D
  630.             K21D = 0.0D0
  631.             ELSE
  632.             WRITE(6,*) 'TENSEUR NON PREVU'
  633.             ENDIF
  634.  
  635. c           NLCG2 = MLECEN2.LECT(NGCG)
  636. c           NLCD2 = MLECEN2.LECT(NGCD)
  637. c           K11G = MPOTEN.VPOCHA(NLCG2,1)
  638. c           K22G = MPOTEN.VPOCHA(NLCG2,2)
  639. c           K21G = MPOTEN.VPOCHA(NLCG2,3)
  640.  
  641. c           K11D = MPOTEN.VPOCHA(NLCD2,1)
  642. c           K22D = MPOTEN.VPOCHA(NLCD2,2)
  643. c           K21D = MPOTEN.VPOCHA(NLCD2,3)
  644. c PRODUIT TENSEUR VECTEUR
  645.          VXG1 = ((VECXG1(INDG1)/AG1)*K11G) + ((VECYG1(INDG1)/AG1)*K21G)
  646.          VYG1 = ((VECXG1(INDG1)/AG1)*K21G) + ((VECYG1(INDG1)/AG1)*K22G)
  647.  
  648.          IAUX = 3 - INDG1
  649.          VXAU = ((VECXG1(IAUX)/AG1)*K11G) + ((VECYG1(IAUX)/AG1)*K21G)
  650.          VYAU = ((VECXG1(IAUX)/AG1)*K21G) + ((VECYG1(IAUX)/AG1)*K22G)
  651. c           WRite(6,*) 'K11G=',K11G,'K22G= ',K22G,'K21G=',K21G
  652. c           WRite(6,*) 'K11D=',K11D,'K22D= ',K22D,'K21D=',K21D
  653. c            WRITE(6,*) 'NLCF= ',NLCF,'VECXG1= ',VXG1
  654. c            IAUX = 3 - INDG1
  655. c            WRITE(6,*) 'NLCF= ',NLCF,'VXAU= ',VXAU
  656. c            WRITE(6,*) 'NLCF= ',NLCF,'VECYG1= ',VYG1
  657. c            IAUX = 3 - INDG1
  658. c            WRITE(6,*) 'NLCF= ',NLCF,'VYAU= ',VYAU
  659. c            WRITE(6,*) 'NLCF= ',NLCF,'VALD= ',VALD
  660. c            WRITE(6,*) 'NLCF= ',NLCF,'VECXG1= ',VECXG1(INDG1)
  661. c            IAUX = 3 - INDG1
  662. c            WRITE(6,*) 'NLCF= ',NLCF,'VXAU= ',VECXG1(IAUX)
  663. c            WRITE(6,*) 'NLCF= ',NLCF,'VECYG1= ',VECYG1(INDG1)
  664. c            IAUX = 3 - INDG1
  665. c            WRITE(6,*) 'NLCF= ',NLCF,'VYAU= ',VECYG1(IAUX)
  666. c            WRITE(6,*) 'NLCF= ',NLCF,'VALD= ',VALD
  667.             ENDIF
  668.  
  669.             VAL = MPOCHP.VPOCHA(NLCG,1)
  670.             VALG = VAL
  671.           COEF1X = VXG1
  672.           COEF2X = VXAU
  673.           COEF1Y = VYG1
  674.           COEF2Y = VYAU
  675.  
  676.          AUX = SCN1X* ( (COEF1X * (TRG - VAL)) +
  677.      &                   (COEF2X * (TRG1 - VAL))  )
  678.          AUY = SCN1Y* ( (COEF1Y * (TRG - VAL)) +
  679.      &                  (COEF2Y * (TRG1 - VAL))  )
  680.             MPOGRA.VPOCHA(NLCF,1) = AUX + AUY
  681.  
  682.  
  683. c          WRITE(6,*) 'NLCF= ',NLCF
  684. c          WRITE(6,*) 'COEF1X= ',COEF1X
  685. c          WRITE(6,*) 'COEF2X= ',COEF2X
  686. c          WRITE(6,*) 'COEF1Y= ',COEF1Y
  687. c          WRITE(6,*) 'COEF2Y= ',COEF2Y
  688.  
  689.  
  690.           INDIC = IPO3.POINT33(NLS1)
  691.           SEGACT INDIC *MOD
  692.           MATR1 = IPO2.POINT(NLS1)
  693.           SEGACT MATR1 *MOD
  694.  
  695.           DO JAUX = 1,TAB.ID(NLS1)
  696.              CX = MATR1.MAT2(IG,JAUX)
  697.              CY = MATR1.MAT2(IG,JAUX)
  698.              INDAUX = INDIC.NU(IG,JAUX)
  699.              MELEME.NUM(JAUX+1,NLCF)  = INDAUX
  700.              IF (INDAUX.EQ.NGCG) THEN
  701.              CX = CX - 1.D0
  702.              CY = CY - 1.D0
  703.              INDGA = JAUX +1
  704.              ENDIF
  705.              IF (INDAUX.EQ.NGCD) THEN
  706.              INDDR = JAUX + 1
  707.              ENDIF
  708.  
  709.              MELVA1.VELCHE(JAUX+1,NLCF) =
  710.      &       (COEF1X*CX*SCN1X) + (COEF1Y*CY*SCN1Y)
  711.           ENDDO
  712.  
  713.  
  714.       ITROUVE = 0
  715.       DO ICOUR = 1,TAB.ID(NLS1)
  716.       IA = ICOUR
  717.          J1 = INDIC.NU(IG1,IA)
  718.          DO IAUX2 = 2,TAB.ID(NLS1)+1
  719.          J2 = MELEME.NUM(IAUX2,NLCF)
  720.          IF (J1.EQ.J2) THEN
  721.          IAUX = IAUX2
  722.          ITROUVE = 1
  723.          GOTO 511
  724.          ENDIF
  725.          ENDDO
  726.  511     CONTINUE
  727.       IF (ITROUVE.EQ.0) THEN
  728.       WRITE(6,*) 'PROBLEME ALGO1'
  729.           WRITE(6,*) 'INDIC= ',INDIC
  730.           DO IAUX2 = 1,TAB.ID(NLS1)+1
  731.           J2 = MELEME.NUM(IAUX2,NLCF)
  732.           WRITE(6,*) 'NLCF= ',NLCF,'IAUX2=',IAUX2,'MELEME= ',J2
  733.           WRITE(6,*) 'IG= ',IG,'IAUX2=',IAUX2,
  734.      &    'NLS1= ',NLS1,'INDIC=',INDIC.NU(IG,IAUX2)
  735.           WRITE(6,*) 'IG1= ',IG1,'IAUX2=',IAUX2,
  736.      &    'NLS1= ',NLS1,'INDIC= ',INDIC.NU(IG1,IAUX2)
  737.           ENDDO
  738.       CALL ERREUR(5)
  739.       ENDIF
  740.  
  741.              CX = MATR1.MAT2(IG1,IA)
  742.              CY = MATR1.MAT2(IG1,IA)
  743.              IF (J1.EQ.NGCG) THEN
  744.              CX = CX - 1.D0
  745.              CY = CY - 1.D0
  746.              ENDIF
  747.              MELVA1.VELCHE(IAUX,NLCF) = MELVA1.VELCHE(IAUX,NLCF) +
  748.      &       (COEF2X*CX*SCN1X)  +   (COEF2Y*CY*SCN1Y)
  749.       ENDDO
  750.  
  751. c          DO IAUX2 = 2,TAB.ID(NLS1)+1
  752. c          J1 = MELEME.NUM(IAUX2,NLCF)
  753. c          WRITE(6,*) 'NLCF= ',NLCF,'IAUX2= ',IAUX2
  754. c          WRITE(6,*) 'MELEME2= ',J1
  755. c          COEF1 = MELVA1.VELCHE(IAUX2,NLCF)
  756. c          COEF2 = MELVA2.VELCHE(IAUX2,NLCF)
  757. c          WRITE(6,*) 'COEF1= ',COEF1,'COEF2= ',COEF2
  758. c          ENDDO
  759.  
  760.  
  761.  
  762. * POUR NLS1
  763. c          DO IAUX2 = 1,INDLI.ID(NLS1)
  764. c          WRITE(6,*) 'NLS1= ',NLS1,'INDIC= ',INDIC(ID,IAUX2)
  765. c          WRITE(6,*) 'NLS1= ',NLS1,'INDIC= ',INDIC(ID1,IAUX2)
  766. c          ENDDO
  767.  
  768. c          DO IAUX2 = 2,TAB.ID(NLS1)+1
  769. c          J1 = MELEME.NUM(IAUX2,NLCF)
  770. c          WRITE(6,*) 'NLCF= ',NLCF,'IAUX2= ',IAUX2
  771. c          WRITE(6,*) 'MELEME3= ',J1
  772. c          COEF1 = MELVA1.VELCHE(IAUX2,NLCF)
  773. c          COEF2 = MELVA2.VELCHE(IAUX2,NLCF)
  774. c          WRITE(6,*) 'COEF1= ',COEF1,'COEF2= ',COEF2
  775. c          ENDDO
  776.  
  777.           SEGDES INDIC *MOD
  778.           SEGDES MATR1 *MOD
  779.  
  780.           INDIC = IPO3.POINT33(NLS2)
  781.           SEGACT INDIC *MOD
  782.           MATR1 = IPO2.POINT(NLS2)
  783.           SEGACT MATR1 *MOD
  784. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS2
  785.  
  786.            COEF1 = ( (VECXG2(INDG2)*SCNX) + (VECYG2(INDG2)*SCNY) )
  787.      &              / AG2
  788.            IAUX = 3 - INDG2
  789.            COEF2 = ( (VECXG2(IAUX)*SCNX) + (VECYG2(IAUX)*SCNY) )
  790.      &              / AG2
  791.  
  792.            COEF3 = ( (VECXD2(INDD2)*SCNX) + (VECYD2(INDD2)*SCNY) )
  793.      &              / AD2
  794.            IAUX = 3 - INDD2
  795.            COEF4 = ( (VECXD2(IAUX)*SCNX) + (VECYD2(IAUX)*SCNY) )
  796.      &              / AD2
  797.  
  798.                DO I5 = 1,INDLI.ID(NLS2)
  799.                INDAUX = IND2.NUME(I5,NLS2)
  800.                IF (INDAUX.EQ.NG2) THEN
  801.                IAFF = I5
  802.                IG2 = IAFF
  803.                GOTO 411
  804.                ENDIF
  805.                ENDDO
  806.  411              CONTINUE
  807.  
  808.            TRG2 =  SCMB.MAT(IAFF,NLS2)
  809.  
  810.                MARQ = 0
  811.                DO I5 = 1,INDLI.ID(NLS2)
  812.                INDAUX = IND2.NUME(I5,NLS2)
  813.                IF (INDAUX.EQ.NGCF) THEN
  814.                IAFF = I5
  815.                IG = IAFF
  816.                IGNS2 = IAFF
  817.                GOTO 635
  818.                ENDIF
  819.                ENDDO
  820.  635              CONTINUE
  821.  
  822.            TRG =  SCMB.MAT(IAFF,NLS2)
  823.            TRGNS2 = TRG
  824.  
  825.             IAUX = 3 - INDG2
  826.             VXG2 = VECXG2(INDG2)/AG2
  827.             VXAU = VECXG2(IAUX)/AG2
  828.             VYG2 = VECYG2(INDG2)/AG2
  829.             VYAU = VECYG2(IAUX)/AG2
  830.  
  831. c            WRITE(6,*) 'NLCF= ',NLCF,'VECXG2= ',VECXG2(INDG2)
  832. c            IAUX = 3 - INDG2
  833. c            WRITE(6,*) 'NLCF= ',NLCF,'VXAU= ',VECXG2(IAUX)
  834. c            WRITE(6,*) 'NLCF= ',NLCF,'VECYG2= ',VECYG2(INDG2)
  835. c            IAUX = 3 - INDG2
  836. c            WRITE(6,*) 'NLCF= ',NLCF,'VYAU= ',VECYG2(IAUX)
  837.  
  838.            IF (ICHTE.GT.0) THEN
  839.  
  840.             IF (MPOTEN.VPOCHA(/2) .EQ.3) THEN
  841. c LE TENSEUR EST ANISOTROPE
  842.             K11G = MPOTEN.VPOCHA(NLCG,1)
  843.             K22G = MPOTEN.VPOCHA(NLCG,2)
  844.             K21G = MPOTEN.VPOCHA(NLCG,3)
  845.  
  846.             K11D = MPOTEN.VPOCHA(NLCD,1)
  847.             K22D = MPOTEN.VPOCHA(NLCD,2)
  848.             K21D = MPOTEN.VPOCHA(NLCD,3)
  849.             ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN
  850.             K11G = MPOTEN.VPOCHA(NLCG,1)
  851.             K22G = K11G
  852.             K21G = 0.0D0
  853.             K11D = MPOTEN.VPOCHA(NLCD,1)
  854.             K22D = K11D
  855.             K21D = 0.0D0
  856.             ELSE
  857.             WRITE(6,*) 'TENSEUR NON PREVU'
  858.             ENDIF
  859.  
  860. c           NLCG2 = MLECEN2.LECT(NGCG)
  861. c           NLCD2 = MLECEN2.LECT(NGCD)
  862. c           K11G = MPOTEN.VPOCHA(NLCG2,1)
  863. c           K22G = MPOTEN.VPOCHA(NLCG2,2)
  864. c           K21G = MPOTEN.VPOCHA(NLCG2,3)
  865. c
  866. c           K11D = MPOTEN.VPOCHA(NLCD2,1)
  867. c           K22D = MPOTEN.VPOCHA(NLCD2,2)
  868. c           K21D = MPOTEN.VPOCHA(NLCD2,3)
  869. c PRODUIT TENSEUR VECTEUR
  870.        VXG2 = ((VECXG2(INDG2)/AG2)*K11G) + ((VECYG2(INDG2)/AG2)*K21G)
  871.        VYG2 = ((VECXG2(INDG2)/AG2)*K21G) + ((VECYG2(INDG2)/AG2)*K22G)
  872.  
  873.        IAUX = 3 - INDG2
  874.        VXAU = ((VECXG2(IAUX)/AG2)*K11G) + ((VECYG2(IAUX)/AG2)*K21G)
  875.        VYAU = ((VECXG2(IAUX)/AG2)*K21G) + ((VECYG2(IAUX)/AG2)*K22G)
  876. c           WRite(6,*) 'K11G=',K11G,'K22G= ',K22G,'K21G=',K21G
  877. c           WRite(6,*) 'K11D=',K11D,'K22D= ',K22D,'K21D=',K21D
  878. c            WRITE(6,*) 'NLCF= ',NLCF,'VECXG2= ',VXG2
  879. c            IAUX = 3 - INDG2
  880. c            WRITE(6,*) 'NLCF= ',NLCF,'VXAU= ',VXAU
  881. c            WRITE(6,*) 'NLCF= ',NLCF,'VECYG2= ',VYG2
  882. c            IAUX = 3 - INDG2
  883. c            WRITE(6,*) 'NLCF= ',NLCF,'VYAU= ',VYAU
  884.            ENDIF
  885.           COEF1X = VXG2
  886.           COEF2X = VXAU
  887.           COEF1Y = VYG2
  888.           COEF2Y = VYAU
  889.  
  890.          AUX = SCN1X* ( (COEF1X * (TRG - VAL)) +
  891.      &                   (COEF2X * (TRG2 - VAL))  )
  892.          AUY = SCN1Y* ( (COEF1Y * (TRG - VAL)) +
  893.      &                  (COEF2Y * (TRG2 - VAL))  )
  894.             MPOGRA.VPOCHA(NLCF,1) =  MPOGRA.VPOCHA(NLCF,1) +
  895.      &                                AUX + AUY
  896.  
  897.  
  898.             ANCX = MPOGRA.VPOCHA(NLCF,1)
  899. * POUR NLS2
  900.  
  901. c          WRITE(6,*) 'COEF1X= ',COEF1X
  902. c          WRITE(6,*) 'COEF2X= ',COEF2X
  903. c          WRITE(6,*) 'COEF1Y= ',COEF1Y
  904. c          WRITE(6,*) 'COEF2Y= ',COEF2Y
  905.           ICON = TAB.ID(NLS1)+1
  906.           DO JAUX = 1,TAB.ID(NLS2)
  907.                J1 = INDIC.NU(IG,JAUX)
  908.                DO IAUX2 = 2,ICON
  909.                J2 = MELEME.NUM(IAUX2,NLCF)
  910.                IF (J1.EQ.J2) THEN
  911.                IAUX = IAUX2
  912.                GOTO 59
  913.                ENDIF
  914.                ENDDO
  915.                ICON = ICON +1
  916.                IAUX = ICON
  917.             IF (IAUX.GT.NBNN) THEN
  918.             WRITE(6,*) 'NBNN TROP PETIT'
  919.             CALL ERREUR(5)
  920.              ENDIF
  921.  59          CONTINUE
  922.  
  923.              CX = MATR1.MAT2(IG,JAUX)
  924.              CY = MATR1.MAT2(IG,JAUX)
  925.              INDAUX = INDIC.NU(IG,JAUX)
  926.              MELEME.NUM(IAUX,NLCF)  = INDAUX
  927.              IF (INDAUX.EQ.NGCG) THEN
  928.              CX = CX - 1.0D0
  929.              CY = CY - 1.0D0
  930.              ENDIF
  931.  
  932.             MELVA1.VELCHE(IAUX,NLCF) = MELVA1.VELCHE(IAUX,NLCF) +
  933.      &      (COEF1X*CX*SCN1X) + (COEF1Y*CY*SCN1Y)
  934.           ENDDO
  935. c          DO IAUX2 = 2,ICON
  936. c          J1 = MELEME.NUM(IAUX2,NLCF)
  937. c          WRITE(6,*) 'NLCF= ',NLCF,'IAUX2= ',IAUX2
  938. c          WRITE(6,*) 'MELEME4= ',J1
  939. c          COEF1 = MELVA1.VELCHE(IAUX2,NLCF)
  940. c          COEF2 = MELVA2.VELCHE(IAUX2,NLCF)
  941. c          WRITE(6,*) 'COEF1= ',COEF1,'COEF2= ',COEF2
  942. c          ENDDO
  943.  
  944.             ITROUVE = 0
  945.             DO ICOUR = 1,TAB.ID(NLS2)
  946.             IA = ICOUR
  947.             J1 = INDIC.NU(IG2,IA)
  948.             DO IAUX2 = 2,ICON
  949.             J2 = MELEME.NUM(IAUX2,NLCF)
  950.             IF (J1.EQ.J2) THEN
  951.             IAUX = IAUX2
  952.             ITROUVE = 1
  953.             GOTO 577
  954.             ENDIF
  955.             ENDDO
  956.  577     CONTINUE
  957.             IF (ITROUVE.EQ.0) THEN
  958.             WRITE(6,*) 'PROBLEME ALGO3'
  959.           WRITE(6,*) 'INDIC= ',INDIC
  960.           DO IAUX2 = 2,ICON
  961.           J1 = MELEME.NUM(IAUX2,NLCF)
  962.           WRITE(6,*) 'NLCF= ',NLCF,'IAUX2=',IAUX2,'MELEME= ',J1
  963.           WRITE(6,*) 'IG= ',IG,'IAUX2=',IAUX2,'INDIC=',
  964.      &    'NLS2= ',NLS2,INDIC.NU(IG,IAUX2)
  965.           WRITE(6,*) 'IG2= ',IG2,'IAUX2=',IAUX2,'INDIC= ',
  966.      &    'NLS2= ',NLS2,INDIC.NU(IG2,IAUX2)
  967.           ENDDO
  968.             CALL ERREUR(5)
  969.             ENDIF
  970.  
  971.              CX = MATR1.MAT2(IG2,IA)
  972.              CY = MATR1.MAT2(IG2,IA)
  973.              IF (J1.EQ.NGCG) THEN
  974.              CX = CX - 1.0D0
  975.              CY = CY - 1.D0
  976.              ENDIF
  977.              MELVA1.VELCHE(IAUX,NLCF) = MELVA1.VELCHE(IAUX,NLCF) +
  978.      &       (COEF2X*CX*SCN1X)  +  (COEF2Y*CY*SCN1Y)
  979.             ENDDO
  980.  
  981.  
  982.              MPOGRA.VPOCHA(NLCF,1) = (-0.5D0)* MPOGRA.VPOCHA(NLCF,1)
  983.  
  984.              ISUP = ICON
  985.              DO J= ISUP+1,NBNN
  986.              MELVA1.VELCHE(J,NLCF) = 0.0D0
  987.              MELEME.NUM(J,NLCF) = MELEME.NUM(ISUP,NLCF)
  988.              ENDDO
  989.              DO J= 1,NBNN
  990.              MELVA1.VELCHE(J,NLCF) = (-0.5D0*MELVA1.VELCHE(J,NLCF))
  991.              ENDDO
  992.  
  993. C  ON RAJOUTE LE CONVECTIF
  994.              IF (ICHCO.GT.0) THEN
  995.  
  996. C BOUCLE POUR CALCUER INDGA,INDDR
  997.              INDFR = 0
  998.              DO J= 1,ISUP
  999.              IF (MELEME.NUM(J,NLCF).EQ.NGCG) INDGA = J
  1000.              IF (MELEME.NUM(J,NLCF).EQ.NGCD) INDDR = J
  1001.              IF (MELEME.NUM(J,NLCF).EQ.NGCF) INDFR = J
  1002.              ENDDO
  1003.              UN =  MPOVCO.VPOCHA(NLCF,1)
  1004. c             WRITE(6,*) 'UN= ',UN
  1005. C OPTION CENTRE
  1006.              IF (IOP.EQ.2) THEN
  1007.              IF (NLCD.NE.NLCG) THEN
  1008.              VAL = 0.5D0*(MPOCHP.VPOCHA(NLCG,1) +
  1009.      &                        MPOCHP.VPOCHA(NLCD,1))*UN
  1010.              MPOGRA.VPOCHA(NLCF,1) =  MPOGRA.VPOCHA(NLCF,1) - VAL
  1011.              ELSE
  1012. C CONDITIONS AUX LIMITES : TRACE CALCULEE PAR LA DIFFUSION
  1013.              TRACE = 0.5*(TRGNS1+TRGNS2)
  1014. c             WRITE(6,*) 'NLCF= ',NLCF,'TRACE= ',TRACE
  1015.              VAL = TRACE*UN
  1016.              MPOGRA.VPOCHA(NLCF,1) =  MPOGRA.VPOCHA(NLCF,1) - VAL
  1017.              ENDIF
  1018.  
  1019. C ON COMPLETE MELVA1 POUR LE CONVECTIF
  1020.             IF (NLCD.NE.NLCG) THEN
  1021.             MELVA1.VELCHE(INDGA,NLCF) = MELVA1.VELCHE(INDGA,NLCF) -
  1022.      &                                  (0.5D0*UN)
  1023.             MELVA1.VELCHE(INDDR,NLCF) = MELVA1.VELCHE(INDDR,NLCF) -
  1024.      &                                  (0.5D0*UN)
  1025. C CONDITION AUX LIMITES : ON RAJOUTE LES DEPENDANCES DES TRACES
  1026. c POUR LES CONDITIONS MIXTES OU DE NEUMAN
  1027.  
  1028.             ELSE
  1029.  
  1030.             NLFCL = MLENCL.LECT(NGCF)
  1031.  
  1032. C ON RAJOUTE CECI POUR L OPTION GRADGEO
  1033.             IF (NLFCL.NE.0) THEN
  1034.             MELVA1.VELCHE(ICON+1,NLCF) =   - UN
  1035.             MELEME.NUM(ICON+1,NLCF) = NGCF
  1036.             ENDIF
  1037.  
  1038.             IF (NLFCL.EQ.0) THEN
  1039.             INDIC = IPO3.POINT33(NLS1)
  1040.             SEGACT INDIC *MOD
  1041.             MATR1 = IPO2.POINT(NLS1)
  1042.             SEGACT MATR1 *MOD
  1043.              DO JAUX = 1,TAB.ID(NLS1)
  1044.                J1 = INDIC.NU(IGNS1,JAUX)
  1045.                DO IAUX2 = 2,ICON
  1046.                J2 = MELEME.NUM(IAUX2,NLCF)
  1047.                IF (J1.EQ.J2) THEN
  1048.                IAUX = IAUX2
  1049.                GOTO 5459
  1050.                ENDIF
  1051.                ENDDO
  1052.  5459          CONTINUE
  1053.  
  1054.              CX = MATR1.MAT2(IGNS1,JAUX)
  1055.  
  1056.             MELVA1.VELCHE(IAUX,NLCF) = MELVA1.VELCHE(IAUX,NLCF)
  1057.      &      - (UN*CX*0.5D0)
  1058.              ENDDO
  1059.  
  1060.             SEGDES INDIC *MOD
  1061.             SEGDES MATR1 *MOD
  1062.  
  1063.             INDIC = IPO3.POINT33(NLS2)
  1064.             SEGACT INDIC *MOD
  1065.             MATR1 = IPO2.POINT(NLS2)
  1066.             SEGACT MATR1 *MOD
  1067.              DO JAUX = 1,TAB.ID(NLS2)
  1068.                J1 = INDIC.NU(IGNS2,JAUX)
  1069.                DO IAUX2 = 2,ICON
  1070.                J2 = MELEME.NUM(IAUX2,NLCF)
  1071.                IF (J1.EQ.J2) THEN
  1072.                IAUX = IAUX2
  1073.                GOTO 5988
  1074.                ENDIF
  1075.                ENDDO
  1076.  5988          CONTINUE
  1077.  
  1078.              CX = MATR1.MAT2(IGNS2,JAUX)
  1079. c             WRITE(6,*) 'NLCF= ',NLCF,'CX= ',CX
  1080.  
  1081.             MELVA1.VELCHE(IAUX,NLCF) = MELVA1.VELCHE(IAUX,NLCF)
  1082.      &      - (UN*CX*0.5D0)
  1083.              ENDDO
  1084.             SEGDES INDIC *MOD
  1085.             SEGDES MATR1 *MOD
  1086.             ENDIF
  1087.  
  1088.             ENDIF
  1089.  
  1090.  
  1091. C OPTION UPWIND
  1092.             ELSEIF (IOP.EQ.1) THEN
  1093.              IF (NLCD.NE.NLCG) THEN
  1094.               IF (UN.GT.0.0D0) THEN
  1095.              VAL = (MPOCHP.VPOCHA(NLCG,1)*UN)
  1096.              ELSE
  1097.              VAL = (MPOCHP.VPOCHA(NLCD,1)*UN)
  1098.              ENDIF
  1099.              MPOGRA.VPOCHA(NLCF,1) =  MPOGRA.VPOCHA(NLCF,1) - VAL
  1100.              ELSE
  1101. C CONDITIONS AUX LIMITES : TRACE CALCULEE PAR LA DIFFUSION
  1102. C CONDITIONS AUX LIMITES : TRACE CALCULEE PAR LA DIFFUSION
  1103.                IF (UN.GT.0.0D0) THEN
  1104.                VAL = (MPOCHP.VPOCHA(NLCG,1)*UN)
  1105.                ELSE
  1106.                TRACE = 0.5*(TRGNS1+TRGNS2)
  1107.                 VAL = TRACE*UN
  1108.                ENDIF
  1109.              MPOGRA.VPOCHA(NLCF,1) =  MPOGRA.VPOCHA(NLCF,1) - VAL
  1110.              ENDIF
  1111.  
  1112. C ON COMPLETE MELVA1 POUR LE CONVECTIF
  1113.             IF (NLCD.NE.NLCG) THEN
  1114.                IF (UN.GT.0.0D0) THEN
  1115.                MELVA1.VELCHE(INDGA,NLCF) = MELVA1.VELCHE(INDGA,NLCF) -
  1116.      &                                     (UN)
  1117.                ELSE
  1118.                MELVA1.VELCHE(INDDR,NLCF) = MELVA1.VELCHE(INDDR,NLCF) -
  1119.      &                                     (UN)
  1120.                ENDIF
  1121. C CONDITION AUX LIMITES : ON RAJOUTE LES DEPENDANCES DES TRACES
  1122. c POUR LES CONDITIONS MIXTES OU DE NEUMAN
  1123.  
  1124.             ELSE
  1125.             IF (UN.GT.0.0D0) THEN
  1126.                MELVA1.VELCHE(INDGA,NLCF) = MELVA1.VELCHE(INDGA,NLCF) -
  1127.      &                                     (UN)
  1128.  
  1129.             ELSE
  1130.             NLFCL = MLENCL.LECT(NGCF)
  1131.  
  1132. C ON RAJOUTE CECI POUR L OPTION GRADGEO
  1133.             IF (NLFCL.NE.0) THEN
  1134.             MELVA1.VELCHE(ICON+1,NLCF) =   - UN
  1135.             MELEME.NUM(ICON+1,NLCF) = NGCF
  1136.             ENDIF
  1137.  
  1138. c            IF (1.EQ.0) THEN
  1139.             IF (NLFCL.EQ.0) THEN
  1140.             INDIC = IPO3.POINT33(NLS1)
  1141.             SEGACT INDIC *MOD
  1142.             MATR1 = IPO2.POINT(NLS1)
  1143.             SEGACT MATR1 *MOD
  1144.              DO JAUX = 1,TAB.ID(NLS1)
  1145.                J1 = INDIC.NU(IGNS1,JAUX)
  1146.                DO IAUX2 = 2,ICON
  1147.                J2 = MELEME.NUM(IAUX2,NLCF)
  1148.                IF (J1.EQ.J2) THEN
  1149.                IAUX = IAUX2
  1150.                GOTO 5449
  1151.                ENDIF
  1152.                ENDDO
  1153.  5449          CONTINUE
  1154.  
  1155.              CX = MATR1.MAT2(IGNS1,JAUX)
  1156.  
  1157.             MELVA1.VELCHE(IAUX,NLCF) = MELVA1.VELCHE(IAUX,NLCF)
  1158.      &      - (UN*CX*0.5D0)
  1159.              ENDDO
  1160.             SEGDES INDIC *MOD
  1161.             SEGDES MATR1 *MOD
  1162.  
  1163.             INDIC = IPO3.POINT33(NLS2)
  1164.             SEGACT INDIC *MOD
  1165.             MATR1 = IPO2.POINT(NLS2)
  1166.             SEGACT MATR1 *MOD
  1167.              DO JAUX = 1,TAB.ID(NLS2)
  1168.                J1 = INDIC.NU(IGNS2,JAUX)
  1169.                DO IAUX2 = 2,ICON
  1170.                J2 = MELEME.NUM(IAUX2,NLCF)
  1171.                IF (J1.EQ.J2) THEN
  1172.                IAUX = IAUX2
  1173.                GOTO 5989
  1174.                ENDIF
  1175.                ENDDO
  1176.  5989          CONTINUE
  1177.  
  1178.              CX = MATR1.MAT2(IGNS2,JAUX)
  1179.  
  1180.             MELVA1.VELCHE(IAUX,NLCF) = MELVA1.VELCHE(IAUX,NLCF)
  1181.      &      - (UN*CX*0.5D0)
  1182.              ENDDO
  1183.             SEGDES INDIC *MOD
  1184.             SEGDES MATR1 *MOD
  1185. c            ENDIF
  1186.  
  1187.             ENDIF
  1188.             ENDIF
  1189.             ENDIF
  1190.  
  1191. C OPTION UPWICENT
  1192.             ELSEIF (IOP.EQ.3) THEN
  1193.              IF (NLCD.NE.NLCG) THEN
  1194.  
  1195.  
  1196. c CALCUL DE THETA
  1197. c DANS MELVA1 :  INDDR EST LA NUM de NLCD
  1198. C COEFD = MELVA1(INDDR,NLCF)
  1199.              COEFD =   MELVA1.VELCHE(INDDR,NLCF)
  1200.  
  1201.              THETA = 0.5D0
  1202.              EXPR1 = (THETA*UN) + COEFD
  1203.              EXPR2 = ((1.D0 - THETA)*UN) - COEFD
  1204.              IF (EXPR1.LT.0.0D0) THEN
  1205.                 IF (ABS(UN) .GT. 1e-20) THEN
  1206.                  THETA = - (0.5*COEFD / UN)
  1207.                 ENDIF
  1208.              ENDIF
  1209.              IF (EXPR2.GT.0.0D0) THEN
  1210.                 IF (ABS(UN) .GT. 1e-20) THEN
  1211.                  THETA = 1.D0 - (0.5*COEFD / UN)
  1212.                 ENDIF
  1213.              ENDIF
  1214.              THETA = MIN(1.D0,THETA)
  1215.              THETA = MAX(0.D0,THETA)
  1216. c             WRITE(6,*) 'THETA= ',THETA
  1217. c             WRITE(6,*) 'COEFD= ',COEFD
  1218. c             WRITE(6,*) 'UN= ',UN
  1219. c             WRITE(6,*) 'EXPR1= ',EXPR1
  1220. c             WRITE(6,*) 'EXPR2= ',EXPR2
  1221.              VAL = (MPOCHP.VPOCHA(NLCG,1)*UN*THETA) +
  1222.      &             (MPOCHP.VPOCHA(NLCD,1)*(1.D0-THETA)*UN)
  1223.              MPOGRA.VPOCHA(NLCF,1) =  MPOGRA.VPOCHA(NLCF,1) - VAL
  1224.             ELSE
  1225. C CONDITIONS AUX LIMITES : TRACE CALCULEE PAR LA DIFFUSION
  1226.  
  1227.             IF (INDFR.NE.0) THEN
  1228.              COEFD =   MELVA1.VELCHE(INDFR,NLCF)
  1229.              ELSE
  1230.              COEFD = 0.0D0
  1231.             ENDIF
  1232.  
  1233.  
  1234. C C'EST LE THETA LE MIEUX ADPATE POUR LES CONDITIONS AUX LIMITES
  1235.              THETA = 0.0D0
  1236.              EXPR1 = (THETA*UN) + COEFD
  1237.              EXPR2 = ((1.D0 - THETA)*UN) - COEFD
  1238.              IF (EXPR1.LT.0.0D0) THEN
  1239.                 IF (ABS(UN) .GT. 1e-20) THEN
  1240.                  THETA = - (0.5*COEFD / UN)
  1241.                 ENDIF
  1242.              ENDIF
  1243.              IF (EXPR2.GT.0.0D0) THEN
  1244.                 IF (ABS(UN) .GT. 1e-20) THEN
  1245.                  THETA = 1.D0 - (0.5*COEFD / UN)
  1246.                 ENDIF
  1247.              ENDIF
  1248.              THETA = MIN(1.D0,THETA)
  1249.              THETA = MAX(0.D0,THETA)
  1250.  
  1251.             TRACE = 0.5*(TRGNS1+TRGNS2)
  1252.  
  1253.  
  1254.              VAL = (MPOCHP.VPOCHA(NLCG,1)*UN*THETA) +
  1255.      &             (TRACE*(1.D0-THETA)*UN)
  1256.              MPOGRA.VPOCHA(NLCF,1) =  MPOGRA.VPOCHA(NLCF,1) - VAL
  1257.  
  1258.              ENDIF
  1259.  
  1260.  
  1261.  
  1262. C ON COMPLETE MELVA1 POUR LE CONVECTIF
  1263.             IF (NLCD.NE.NLCG) THEN
  1264.             MELVA1.VELCHE(INDGA,NLCF) = MELVA1.VELCHE(INDGA,NLCF) -
  1265.      &                                  (THETA*UN)
  1266.             MELVA1.VELCHE(INDDR,NLCF) = MELVA1.VELCHE(INDDR,NLCF) -
  1267.      &                                  ((1.D0-THETA)*UN)
  1268. C CONDITION AUX LIMITES : ON RAJOUTE LES DEPENDANCES DES TRACES
  1269. c POUR LES CONDITIONS MIXTES OU DE NEUMAN
  1270.  
  1271.             ELSE
  1272.  
  1273.             MELVA1.VELCHE(INDGA,NLCF) = MELVA1.VELCHE(INDGA,NLCF) -
  1274.      &                                    (THETA*UN)
  1275.  
  1276.             NLFCL = MLENCL.LECT(NGCF)
  1277.  
  1278. C ON RAJOUTE CECI POUR L OPTION GRADGEO
  1279. c            IF (NLFCL.NE.0) THEN
  1280. c            MELVA1.VELCHE(ICON+1,NLCF) =   - UN
  1281. c            MELEME.NUM(ICON+1,NLCF) = NGCF
  1282. c            ENDIF
  1283.  
  1284. c            IF (1.EQ.0) THEN
  1285. c            IF (NLFCL.EQ.0) THEN
  1286.             INDIC = IPO3.POINT33(NLS1)
  1287.             SEGACT INDIC *MOD
  1288.             MATR1 = IPO2.POINT(NLS1)
  1289.             SEGACT MATR1 *MOD
  1290.              DO JAUX = 1,TAB.ID(NLS1)
  1291.                J1 = INDIC.NU(IGNS1,JAUX)
  1292.                DO IAUX2 = 2,ICON
  1293.                J2 = MELEME.NUM(IAUX2,NLCF)
  1294.                IF (J1.EQ.J2) THEN
  1295.                IAUX = IAUX2
  1296.                GOTO 5549
  1297.                ENDIF
  1298.                ENDDO
  1299.  5549          CONTINUE
  1300.  
  1301.              CX = MATR1.MAT2(IGNS1,JAUX)
  1302.  
  1303.             MELVA1.VELCHE(IAUX,NLCF) = MELVA1.VELCHE(IAUX,NLCF)
  1304.      &      - ((1.D0-THETA)*UN*CX*0.5D0)
  1305.              ENDDO
  1306.             SEGDES INDIC *MOD
  1307.             SEGDES MATR1 *MOD
  1308.  
  1309.             INDIC = IPO3.POINT33(NLS2)
  1310.             SEGACT INDIC *MOD
  1311.             MATR1 = IPO2.POINT(NLS2)
  1312.             SEGACT MATR1 *MOD
  1313.              DO JAUX = 1,TAB.ID(NLS2)
  1314.                J1 = INDIC.NU(IGNS2,JAUX)
  1315.                DO IAUX2 = 2,ICON
  1316.                J2 = MELEME.NUM(IAUX2,NLCF)
  1317.                IF (J1.EQ.J2) THEN
  1318.                IAUX = IAUX2
  1319.                GOTO 5289
  1320.                ENDIF
  1321.                ENDDO
  1322.  5289          CONTINUE
  1323.  
  1324.              CX = MATR1.MAT2(IGNS2,JAUX)
  1325.  
  1326.             MELVA1.VELCHE(IAUX,NLCF) = MELVA1.VELCHE(IAUX,NLCF)
  1327.      &      - ((1.D0-THETA)*UN*CX*0.5D0)
  1328.              ENDDO
  1329.             SEGDES INDIC *MOD
  1330.             SEGDES MATR1 *MOD
  1331. c            ENDIF
  1332. c            ENDIF
  1333.             ENDIF
  1334.  
  1335.  
  1336.             ENDIF
  1337.             ENDIF
  1338.  
  1339.  
  1340.  
  1341.  
  1342.  
  1343.  
  1344. c          DO IAUX2 = 2,ICON
  1345. c          J1 = MELEME.NUM(IAUX2,NLCF)
  1346. c          WRITE(6,*) 'NLCF= ',NLCF,'IAUX2= ',IAUX2
  1347. c          WRITE(6,*) 'MELEME6= ',J1
  1348. c          COEF1 = MELVA1.VELCHE(IAUX2,NLCF)
  1349. c          WRITE(6,*) 'COEF1= ',COEF1
  1350. c          ENDDO
  1351. c          WRITE(6,*) 'MPOGRA= ',MPOGRA.VPOCHA(NLCF,1)
  1352. c            IF (ICHTE.GT.0) THEN
  1353. c            IAUX = 3 - INDD1
  1354. c            XLONGD = (VECXD1(IAUX)*VECXD1(IAUX)) +
  1355. c     &               (VECYD1(IAUX)*VECYD1(IAUX))
  1356. c            XLONGD = XLONGD**0.5
  1357. c            IAUX = 3 - INDG1
  1358. c            XLONGG = (VECXG1(IAUX)*VECXG1(IAUX)) +
  1359. c     &               (VECYG1(IAUX)*VECYG1(IAUX))
  1360. c            XLONGG = XLONGG**0.5
  1361. c            ANCX = ((K11G/XLONGG)*VALG) + ((K11D/XLONGD)*VALD)
  1362. c            ANCX = ANCX/((K11G/XLONGG) + (K11D/XLONGD))
  1363. c            ANCX = (VALD - VALG) /
  1364. c     &       ( (XLONGG/K11G) + (XLONGD/K11D))
  1365. c            ANCX = (VALD - VALG) /
  1366. c     &       ( (XLONGG) + (XLONGD))
  1367. c             MPOGRA.VPOCHA(NLCF,1) = SCN1X*ANCX
  1368. c             MPOGRA.VPOCHA(NLCF,2) = SCN1Y*ANCX
  1369. c            ENDIF
  1370. c             IF (NGCG.NE.NGCD) THEN
  1371. c             AA  = MPOGRA.VPOCHA(NLCF,1) + AA
  1372. c             BB  = MPOGRA.VPOCHA(NLCF,2) +  BB
  1373. c             ENDIF
  1374.  
  1375.  
  1376.             IF (1.EQ.0) THEN
  1377.             WRITE(6,*) 'NLCF= ',NLCF,'GR1= ',MPOGRA.VPOCHA(NLCF,1)
  1378.             WRITE(6,*) 'NLCF= ',NLCF,'GR2= ',MPOGRA.VPOCHA(NLCF,2)
  1379.             WRITE(6,*) 'NLCF= ',NLCF,'TRG= ',TRGAUX
  1380.             WRITE(6,*) 'NLCF= ',NLCF,'TRG1= ',TRG1
  1381.             WRITE(6,*) 'NLCF= ',NLCF,'TRG= ',TRG
  1382.             WRITE(6,*) 'NLCF= ',NLCF,'TRG2= ',TRG2
  1383.             WRITE(6,*) 'NLCF= ',NLCF,'VAL= ',VAL
  1384.             VALD = MPOCHP.VPOCHA(NLCD,1)
  1385.             WRITE(6,*) 'NLCF= ',NLCF,'VALD= ',VALD
  1386.             WRITE(6,*) 'NLCF= ',NLCF,'VECXG1= ',VECXG1(INDG1)
  1387.             IAUX = 3 - INDG1
  1388.             WRITE(6,*) 'NLCF= ',NLCF,'VECXG1= ',VECXG1(IAUX)
  1389.             WRITE(6,*) 'NLCF= ',NLCF,'VECYG1= ',VECYG1(INDG1)
  1390.             IAUX = 3 - INDG1
  1391.             WRITE(6,*) 'NLCF= ',NLCF,'VECYG1= ',VECYG1(IAUX)
  1392.             WRITE(6,*) 'NLCF= ',NLCF,'VECXG2= ',VECXG2(INDG2)
  1393.             IAUX = 3 - INDG2
  1394.             WRITE(6,*) 'NLCF= ',NLCF,'VECXG2= ',VECXG2(IAUX)
  1395.             WRITE(6,*) 'NLCF= ',NLCF,'VECYG2= ',VECYG2(INDG2)
  1396.             IAUX = 3 - INDG2
  1397.             WRITE(6,*) 'NLCF= ',NLCF,'VECYG2= ',VECYG2(IAUX)
  1398.             WRite(6,*) 'AG1=',AG1
  1399.             WRite(6,*) 'AG2=',AG2
  1400.             WRite(6,*) 'AD1=',AD1
  1401.             WRite(6,*) 'AD2=',AD2
  1402.             ENDIF
  1403. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS2
  1404.             NAUX2 = MAX(NAUX2,ICON)
  1405.             NMOY = NMOY + ICON
  1406.  
  1407.           SEGDES INDIC *MOD
  1408.           SEGDES MATR1 *MOD
  1409.  
  1410.          ENDDO
  1411.          NMOY = NMOY/(NFAC*1.D0)
  1412.  
  1413. c         WRITE(6,*) 'NAUX2= ',NAUX2
  1414. c         WRITE(6,*) 'NMOY2= ',NMOY
  1415.       IF (NBSO.EQ.2) THEN
  1416.         SEGDES IPT1
  1417.         SEGDES IPT2
  1418.       ENDIF
  1419.  
  1420.  
  1421.          K7 = NFAC
  1422.          K8 = NAUX2
  1423.          SEGINI ITAB
  1424.  
  1425. c ON SUPPRIME LES ZEROS INTERIEURS
  1426.          IREP = 2
  1427.          DO NLCF = 1,NFAC
  1428.             IREP = 2
  1429.             NFIN = NAUX2
  1430. C ON CALCULE D4ABORD LE MAXIMUM DE LA LIGNE
  1431.             AUXMA = 0.0
  1432.             DO J=2,NFIN
  1433.             AUXRE = ABS(MELVA1.VELCHE(J,NLCF))
  1434.             AUXMA = MAX(AUXRE,AUXMA)
  1435.             ENDDO
  1436.             ITAB.XMAX(NLCF) = AUXMA
  1437.  
  1438.             DO  J=IREP, NFIN
  1439.             IF (ABS(MELVA1.VELCHE(J,NLCF)).Le.(1e-14*AUXMA)) THEN
  1440.  
  1441.  
  1442.                  DO K=1,NFIN-J
  1443.                  AUX = MELVA1.VELCHE(J+K,NLCF)
  1444. C ON DECALE DE K CRAN
  1445.                  IF (ABS(AUX).gt.(1e-14*AUXMA)) THEN
  1446.                   DO I=J,NFIN - K
  1447.                    MELVA1.VELCHE(I,NLCF) = MELVA1.VELCHE(I+K,NLCF)
  1448.                    MELEME.NUM(I,NLCF) = MELEME.NUM(I+K,NLCF)
  1449.                   ENDDO
  1450. C MISE A ZERO DES TERMES DU BOUT
  1451.                   DO I=NFIN-K+1,NFIN
  1452.                    MELVA1.VELCHE(I,NLCF) = 0.0
  1453.                   ENDDO
  1454.                  GOTO 2000
  1455.                  ENDIF
  1456.                  ENDDO
  1457. 2000        CONTINUE
  1458.             ENDIF
  1459.             ENDDO
  1460.          ENDDO
  1461.  
  1462. c TABLEAU CALCULANT LE NOMBRE DE VOISIN NON NUL POUR CHAQUE FACE
  1463.          NMOY = 0
  1464.          INF = NAUX2
  1465.          DO NLCF = 1,NFAC
  1466.            IREC = 3
  1467.            DO J=NAUX2,1,-1
  1468.            IF (ABS(MELVA1.VELCHE(J,NLCF)).gt.
  1469.      &        (1e-14*ITAB.XMAX(NLCF))) THEN
  1470.            IREC = J
  1471.            GOTO 1111
  1472.            ENDIF
  1473.            ENDDO
  1474. 1111     CONTINUE
  1475.            ITAB.TABL(NLCF) = IREC
  1476.            NMOY = NMOY + IREC
  1477.         ENDDO
  1478.          NMOY = NMOY/(NFAC*1.D0)
  1479. c         WRITE(6,*) 'NEWMOY2= ',NMOY
  1480. c         WRITE(6,*) 'NFAC= ',NFAC
  1481.  
  1482.  
  1483. C   TAB1(U) TABLEAU QUI CONTIENT LE NOMBRE DE FACE AYANT U VOISIN
  1484.           NMAX = 0
  1485.           DO ICOUR = 1,NAUX2
  1486.           ITAB.TABL1(ICOUR) = 0
  1487.           ENDDO
  1488.  
  1489.           DO NLCF = 1,NFAC
  1490.           ICOUR =  ITAB.TABL(NLCF)
  1491.           ITAB.TABL1(ICOUR)=ITAB.TABL1(ICOUR) + 1
  1492.           ENDDO
  1493.  
  1494. C ON COMPTE LE NOMVRE DE SOUS DOMAINE
  1495.           NTSOUS = 0
  1496.           DO ICOUR = 1,NAUX2
  1497.           IF (ITAB.TABL1(ICOUR) .NE.0) NTSOUS = NTSOUS +1
  1498.           ENDDO
  1499. C IPOS INDICE DE LA PREMIERE FACE AYANT I VOISIN
  1500. C ICOUR INDICE COURANT INITIALISE A IPOS
  1501.  
  1502.  
  1503.           ITAB.IPOS(1) = 1
  1504.           DO I = 2,NAUX2
  1505.           ITAB.IPOS(I) = ITAB.IPOS(I-1) + ITAB.TABL1(I-1)
  1506.           ITAB.ICOURANT(I) = ITAB.IPOS(I)
  1507.           ENDDO
  1508.  
  1509.  
  1510. c TABL2 TABLEAU QUI RANGE DANS L4ODRES DES SOUS DOMAINES LES FACES NLCF
  1511.  
  1512.            DO I =1,NFAC
  1513.            IHELP = ITAB.TABL(I)
  1514.            IAUX = ITAB.ICOURANT(IHELP)
  1515.            ITAB.TABL2(IAUX) = I
  1516.            IAUX2 = ITAB.TABL(I)
  1517.            ITAB.ICOURANT(IAUX2) = ITAB.ICOURANT(IAUX2) + 1
  1518.            ENDDO
  1519.  
  1520.  
  1521. c          WRITE(6,*) 'NTSOUS= ',NTSOUS
  1522. C**** Initialisation du MCHELM
  1523. C
  1524.       N1=NTSOUS
  1525.       N2=1
  1526.       N3=6
  1527.       L1=8
  1528.       SEGINI MCHEL2
  1529.       MCHEL2.TITCHE='Gradient'
  1530.       MCHEL2.IFOCHE=IFOUR
  1531. C
  1532.       ISOUS=0
  1533.       NBSOUS=0
  1534.       NBREF=0
  1535.       DO I1 = 1, NAUX2, 1
  1536.          NBELEM=ITAB.TABL1(I1)
  1537.          IF(NBELEM .GT. 0)THEN
  1538.             ISOUS=ISOUS+1
  1539.             NBNN=I1
  1540.             SEGINI IPT8
  1541. C           ITYPEL=32 -> 'POLY'
  1542.             ITYPEL=32
  1543.             MCHEL2.IMACHE(ISOUS)=IPT8
  1544.             SEGINI MCHAM2
  1545.             MCHEL2.ICHAML(ISOUS)=MCHAM2
  1546.             MCHAM2.NOMCHE(1)='SCAL'
  1547.             MCHAM2.TYPCHE(1)='REAL*8          '
  1548.             N1PTEL=NBNN
  1549.             N1EL=NBELEM
  1550.             N2PTEL=0
  1551.             N2EL=0
  1552.             SEGINI MELVA2
  1553.             MCHAM2.IELVAL(1)=MELVA2
  1554.  
  1555. C            WRITE(6,*) 'I1= ',I1
  1556. C           WRITE(6,*) 'NBELEM= ',NBELEM
  1557. C           WRITE(6,*) 'NBNN= ',NBNN
  1558.  
  1559.             DO I2=1,NBELEM,1
  1560.                DO I3=1,NBNN,1
  1561.                   IAUX = ITAB.IPOS(I1)
  1562.                   IP= ITAB.TABL2(I2 + IAUX - 1)
  1563. c                  IAUX = MELEME.NUM(I3,1)
  1564. c                  IAUX2 = MLEFA.LECT
  1565. c             WRITE(6,*) 'IP= ',IP,'I1= ',I1,'I2=',I2,'I3=',I3
  1566. c             WRITE(6,*) 'ISOUS= ',ISOUS,'MELEME= ',MELEME.NUM(I3,IP)
  1567.                   IPT8.NUM(I3,I2)= MELEME.NUM(I3,IP)
  1568.                   MELVA2.VELCHE(I3,I2)=MELVA1.VELCHE(I3,IP)
  1569.                ENDDO
  1570.             ENDDO
  1571. C
  1572.             SEGDES MCHAM2
  1573.             SEGDES IPT8
  1574.             SEGDES MELVA2
  1575.          ENDIF
  1576.       ENDDO
  1577.          SEGDES MCHEL2
  1578.          SEGDES ITAB
  1579.  
  1580.  
  1581.  
  1582.  
  1583.  
  1584.          SEGDES MCHAML
  1585.          SEGDES MELEME
  1586.          SEGDES MELVA1
  1587.          SEGDES MCHELM
  1588.  
  1589.          SEGSUP IPO3
  1590.          SEGSUP IPO2
  1591.          SEGSUP INDLI
  1592.          SEGSUP TAB
  1593.          SEGSUP IND2
  1594.          SEGSUP IND
  1595.          SEGSUP IND22
  1596.          SEGSUP VAL1
  1597.          SEGSUP VAL2
  1598.          SEGSUP SCMB
  1599.  
  1600.  
  1601.  
  1602.  9999 CONTINUE
  1603.       RETURN
  1604.       END
  1605.  
  1606.  
  1607.  
  1608.  
  1609.  
  1610.  
  1611.  
  1612.  
  1613.  
  1614.  
  1615.  
  1616.  
  1617.  
  1618.  

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