Télécharger la plaquette Cast3M


fr en

Télécharger norv4.eso

Retour à la liste

Numérotation des lignes : 

norv4

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

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