Télécharger la plaquette Cast3M


fr en

Télécharger vfsym2.eso

Retour à la liste

Numérotation des lignes : 

vfsym2

  1. C VFSYM2    SOURCE    OF166741  24/12/13    21:17:36     12097          
  2.  
  3.        SUBROUTINE VFSYM2(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  4.      &             MPOSUR,MELTFA,MLEFA,MPOTEN,MPOCHP,MLENCL,
  5.      &             MLENNE,MLENMI,MPOVCL,
  6.      &             MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE,IPO2,SCMB,INDLI,
  7.      &             TAB,VAL1,VAL2,IND22,IND2,IND,NBFAC,NSOMM,NBMAX)
  8. C
  9. C************************************************************************
  10. C
  11. C PROJET            :  CASTEM 2000
  12. C
  13. C NOM               :  NORV2
  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. -INC SMLENTI
  26. -INC SMELEME
  27. -INC SMCHPOI
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC SMCOORD
  32. -INC SMLREEL
  33.       POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME,
  34.      &         MELTFA.MELEME
  35.       POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL,
  36.      & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL,
  37.      & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVNE.MPOVAL,MPOVMI.MPOVAL
  38.       POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI,
  39.      &         MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI
  40. -INC SMCHAML
  41.       INTEGER NBNN,NBREF
  42.  
  43. C**** Variable de SMLENTI, SMCHPOI
  44. C
  45.       INTEGER JG, N, NC,  NSOUPO, NAT, NBSOUS, NBNO,NBELEM
  46. C
  47. C**** Les includes
  48. C
  49.       INTEGER I1,ICOMP,ICOMGR,IGEOM
  50.      &     ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM
  51.      &     ,ISURF,IMAIL,ICHPO,ICHCL,ICHGRA,ICOEFF
  52.      &     ,NTOT,NSOMM,NCOMP,NFAC,NCEN
  53.      &     ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2
  54.      &     ,NLS1,NLS2,NLFCL
  55.      &     ,ISOUS,IELEM,INOEUD,ICELL
  56.       INTEGER ICEN2
  57.       REAL*8 SCNX,SCNY,SURF,VOL,VAL,VALX,VALY,XG,XD,XF,XS1,XS2
  58.      &     ,YG,YD,YF,YS1,YS2,PSCA,XNORM,VECX,VECY,PSCAGX,PSCAGY,
  59.      &     PSCADX,PSCADY,K11G,K22G,K21G,K11D,K22D,K21D,VXG1,VXG2,
  60.      &     VXAU,VYAU,VXD1,VXD2,VYG1,VYG2,TRG1,TRG2,
  61.      &     TRD1,TRD2,TRG,TRD
  62.       REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2,
  63.      & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,VX,VY,COEF1X,COEF2X,
  64.      & COEF1Y,COEF2Y,CX,CY,ANCX,ANCY,DIFFX,DIFFY,XLONGG,XLONGD
  65.      &  VALD,VALG,COEF,GX,GY,XMINK11,XMAXK11,XMINK22,XMAXK22,
  66.      & QIMPX,QIMPY,QIMPS,XLAMBDA1,XLAMBDA2
  67.  
  68.       REAL*8 VECXG1(2),VECYG1(2)
  69.       REAL*8 VECXG2(2),VECYG2(2)
  70.       REAL*8 VECXD1(2),VECYD1(2)
  71.       REAL*8 VECXD2(2),VECYD2(2)
  72.       REAL*8 EPS
  73.       INTEGER ICRIT
  74.       CHARACTER*(4) NOMCOM(18)
  75.       CHARACTER*8 TYPE
  76. C
  77.       DATA NOMCOM  /'P1DX','P1DY',
  78.      &     'P2DX','P2DY',
  79.      &     'P3DX','P3DY',
  80.      &     'P4DX','P4DY',
  81.      &     'P5DX','P5DY',
  82.      &     'P6DX','P6DY',
  83.      &     'P7DX','P7DY',
  84.      &     'P8DX','P8DY',
  85.      &     'P9DX','P9DY'/
  86.  
  87.       INTEGER NDIM
  88.       SEGMENT MMAT1
  89.       REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM)
  90.       INTEGER IC(NDIM)
  91.       ENDSEGMENT
  92.  
  93.       INTEGER K1,K2
  94.       SEGMENT INDICE
  95.       INTEGER NUME(K1,K2)
  96.       ENDSEGMENT
  97.       POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE
  98.  
  99.       SEGMENT MATRICE
  100.       REAL*8 MAT(K1,K2)
  101.       ENDSEGMENT
  102.       POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE
  103.  
  104.       INTEGER K3
  105.       SEGMENT POINT2
  106.       INTEGER POINT(K3)
  107.       ENDSEGMENT
  108.       POINTEUR IPO2.POINT2
  109.  
  110.       SEGMENT MATRICE2
  111.       REAL*8 MAT2(K1,K2)
  112.       ENDSEGMENT
  113.       POINTEUR MATR1.MATRICE2,MATR2.MATRICE2
  114.  
  115.       SEGMENT INDICE3
  116.       INTEGER IND3(K1,K2,K3)
  117.       ENDSEGMENT
  118.  
  119.  
  120.       SEGMENT REP
  121.       INTEGER  ID(K3)
  122.       ENDSEGMENT
  123.       POINTEUR TAB.REP,INDLI.REP
  124.  
  125.       INTEGER K5
  126.       SEGMENT NBFAC
  127.       INTEGER NBFACEL(K5)
  128.       INTEGER IMELEM(K5)
  129.       ENDSEGMENT
  130.  
  131.  
  132. c CALCUL DES DIFFERENTS POINTEURS A ACTIVER DANS POUR PLUSIIEURS
  133. c SOUS DOMAINE
  134.  
  135.        MAUX = MELTFA
  136.        NMAI1 = 0
  137.        NBSO = MAX(1,MELTFA.LISOUS(/1))
  138. c       WRITE(6,*) 'NBSO= ',NBSO
  139.        IELTFA = MELTFA
  140.        IF (NBSO.EQ.1) THEN
  141.        K5 = MELTFA.NUM(/2)
  142.        ELSEIF (NBSO.EQ.2) THEN
  143.        IPT1 = MELTFA.LISOUS(1)
  144.        SEGACT IPT1
  145.        N1 = IPT1.NUM(/2)
  146.        NMAI1 = N1
  147.        SEGDES IPT1
  148.        IPT2 = MELTFA.LISOUS(2)
  149.        SEGACT IPT2
  150.        N2 = IPT2.NUM(/2)
  151.        NMAI2 = N2
  152.        SEGDES IPT2
  153.        K5 = N1 + N2
  154.        ENDIF
  155.  
  156.  
  157.  
  158.        IF (NBSO.EQ.1) THEN
  159.        DO I = 1,K5
  160.            NTYPE = MELTFA.ITYPEL
  161.            IF (NTYPE .EQ. 4) THEN
  162.            NBFACEL(I) = 3
  163.            IMELEM(I) = MELTFA
  164.            ELSE
  165.            NBFACEL(I) = 4
  166.            IMELEM(I) = MELTFA
  167.            ENDIF
  168. c       SEGDES MELTFA
  169.        ENDDO
  170.        ELSEIF (NBSO.EQ.2) THEN
  171.          IPT1 = MELTFA.LISOUS(1)
  172.          SEGACT IPT1
  173.          IPT2 = MELTFA.LISOUS(2)
  174.          SEGACT IPT2
  175.        DO I = 1,K5
  176.          N1 = IPT1.NUM(/2)
  177.          IF (I.LE.N1) THEN
  178.            IF (IPT1.ITYPEL .EQ. 4) THEN
  179.            NBFACEL(I) = 3
  180.            IMELEM(I) =  IPT1
  181.            ELSE
  182.            NBFACEL(I) = 4
  183.            IMELEM(I) = IPT1
  184.            ENDIF
  185. c         SEGDES IPT1
  186.          ELSE
  187.            IF (IPT2.ITYPEL .EQ. 4) THEN
  188.            NBFACEL(I) = 3
  189.            IMELEM(I) = IPT2
  190.            ELSE
  191.            NBFACEL(I) = 4
  192.            IMELEM(I) =  IPT2
  193.            ENDIF
  194. c           SEGDES IPT2
  195.         ENDIF
  196.         ENDDO
  197.         ENDIF
  198.  
  199. C SEGMENT  SERVANT A UN PRECALCUL DE NBMAX
  200.       K3 = NSOMM
  201.       SEGINI INDLI
  202.       SEGINI TAB
  203.       DO I = 1,K3
  204.         INDLI.ID(I) = 0
  205.         TAB.ID(I) = 0
  206.       ENDDO
  207.  
  208.       NFAC=MELEFL.NUM(/2)
  209.       NBMAX = 0
  210.  
  211. C PRECALCUL DE NBMAX
  212.       DO NLCF= 1, NFAC, 1
  213. c        WRITE(6,*) 'NLCF= ',NLCF
  214.          NGCF=MELEFL.NUM(2,NLCF)
  215.          NGCF1=MELEFA.NUM(1,NLCF)
  216.          NGCF2=MELEFP.NUM(3,NLCF)
  217.          IF((NGCF.NE.NGCF1) .OR. (NGCF.NE.NGCF2))THEN
  218.             WRITE(IOIMP,*)
  219.      &           'Il ne faut pas jouer avec la table domaine!'
  220.             CALL ERREUR(5)
  221.             GOTO 9999
  222.          ENDIF
  223.          NGCG=MELEFL.NUM(1,NLCF)
  224.          NGCD=MELEFL.NUM(3,NLCF)
  225.          NLCG=MLECEN.LECT(NGCG)
  226.          NLCD=MLECEN.LECT(NGCD)
  227.  
  228.          NGS1=MELEFP.NUM(1,NLCF)
  229.          NGS2=MELEFP.NUM(2,NLCF)
  230.          NLS1=MLESOM.LECT(NGS1)
  231.          NLS2=MLESOM.LECT(NGS2)
  232.  
  233.            INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1
  234.            NBMAX = MAX(NBMAX,INDLI.ID(NLS1))
  235.  
  236.            INDLI.ID(NLS2) = INDLI.ID(NLS2) + 1
  237.            NBMAX = MAX(NBMAX,INDLI.ID(NLS2))
  238.  
  239.       ENDDO
  240.       SEGSUP INDLI
  241.       SEGSUP TAB
  242.  
  243.  
  244.  
  245.  
  246. C ON CONNAIT NBMAX, ON PEUT INITIALISER LES SEGMENTS DE TRAVAIL
  247. c INITIALISATION DES MATRICES
  248. c      NBMAX = 10
  249. c      NBMAX = NBMAX + 1
  250. c      WRITE(6,*) 'NBMAX= ',NBMAX
  251.       K3 = NSOMM
  252.       SEGINI INDLI
  253.       SEGINI TAB
  254.       DO I = 1,K3
  255.         INDLI.ID(I) = 0
  256.         TAB.ID(I) = 0
  257.       ENDDO
  258.  
  259.       K1 = NBMAX
  260.       K2 = NSOMM
  261.       SEGINI IND2
  262.       SEGINI IND
  263.       SEGINI IND22
  264.       SEGINI VAL1
  265.       SEGINI VAL2
  266.       SEGINI SCMB
  267.  
  268. C INITIALISATION DU POINTEUR MATRICE2
  269.       K3 = NSOMM
  270.       SEGINI IPO2
  271.       DO I = 1,K3
  272.       K1 =   NBMAX
  273.       K2 =   NBMAX + 1
  274.       SEGINI MATR1
  275.       IPO2.POINT(I) =  MATR1
  276.       SEGDES  MATR1
  277.       ENDDO
  278.  
  279.       NFAC=MELEFL.NUM(/2)
  280.  
  281.  
  282.       DO NLCF= 1, NFAC, 1
  283. c        WRITE(6,*) 'NLCF= ',NLCF
  284.          NGCF=MELEFL.NUM(2,NLCF)
  285.          NGCF1=MELEFA.NUM(1,NLCF)
  286.          NGCF2=MELEFP.NUM(3,NLCF)
  287.          IF((NGCF.NE.NGCF1) .OR. (NGCF.NE.NGCF2))THEN
  288.             WRITE(IOIMP,*)
  289.      &           'Il ne faut pas jouer avec la table domaine!'
  290.             CALL ERREUR(5)
  291.             GOTO 9999
  292.          ENDIF
  293.          NGCG=MELEFL.NUM(1,NLCF)
  294.          NGCD=MELEFL.NUM(3,NLCF)
  295.          NLCG=MLECEN.LECT(NGCG)
  296.          NLCD=MLECEN.LECT(NGCD)
  297.  
  298.          NGS1=MELEFP.NUM(1,NLCF)
  299.          NGS2=MELEFP.NUM(2,NLCF)
  300.          NLS1=MLESOM.LECT(NGS1)
  301.          NLS2=MLESOM.LECT(NGS2)
  302.          SCNX=MPONOR.VPOCHA(NLCF,1)
  303.          SCNY=MPONOR.VPOCHA(NLCF,2)
  304.          SCN1X = SCNX
  305.          SCN1Y = SCNY
  306.          SURF=0.5D0*MPOSUR.VPOCHA(NLCF,1)
  307.          SCNX=SCNX*SURF
  308.          SCNY=SCNY*SURF
  309.  
  310.  
  311. C        3=IDIM+1
  312.          ICELL=(3*(NGCG -1))+1
  313.          XG=MCOORD.XCOOR(ICELL)
  314.          YG=MCOORD.XCOOR(ICELL+1)
  315.          ICELL=(3*(NGCD -1))+1
  316.          XD=MCOORD.XCOOR(ICELL)
  317.          YD=MCOORD.XCOOR(ICELL+1)
  318.          ICELL=(3*(NGCF -1))+1
  319.          XF=MCOORD.XCOOR(ICELL)
  320.          YF=MCOORD.XCOOR(ICELL+1)
  321.  
  322.          ICELL=(3*(NGS1 -1))+1
  323.          XS1=MCOORD.XCOOR(ICELL)
  324.          YS1=MCOORD.XCOOR(ICELL+1)
  325.          ICELL=(3*(NGS2 -1))+1
  326.          XS2=MCOORD.XCOOR(ICELL)
  327.          YS2=MCOORD.XCOOR(ICELL+1)
  328.  
  329.           XLONG = (((XS1-XS2)**2) + ((YS1-YS2)**2))
  330.           XLONG = SQRT(XLONG)
  331.  
  332.           AG1 = 0.0D0
  333.           AD1 = 0.0D0
  334.           AG2 = 0.0D0
  335.           AD2 = 0.0D0
  336.  
  337.          PSCAG1 = 0.0D0
  338.          PSCAG2 =  0.0D0
  339.          PSCAD1 = 0.0D0
  340.          PSCAD2 = 0.0D0
  341.  
  342.          IG1 = 1
  343.          ID1 = 1
  344.          IG2 = 1
  345.          ID2 = 1
  346.  
  347.  
  348.          MELTFA =  IMELEM(NLCG)
  349.          NBF = NBFACEL(NLCG)
  350.  
  351.          IF (NLCG.GT.NMAI1) THEN
  352.          NGAUX = NLCG - NMAI1
  353.          ELSE
  354.          NGAUX = NLCG
  355.          ENDIF
  356. c         WRITE(6,*) 'NLCG= ',NLCG
  357. c         WRITE(6,*) 'NBF= ',NBFA
  358. c         WRITE(6,*) 'MELTFA= ',MELTFA
  359. c         WRITE(6,*) 'DIMENSION1 ',MELTFA.NUM(/1)
  360. c         WRITE(6,*) 'DIMENSION2 ',MELTFA.NUM(/2)
  361. c         WRITE(6,*) 'NGAUX ',MELTFA.NUM(/2)
  362.  
  363. c         SEGACT MELTFA
  364.          DO J = 1,NBF
  365.          N1 = MELTFA.NUM(J,NGAUX)
  366.          NL1 = MLEFA.LECT(N1)
  367.  
  368.          NSOM1 = MELEFP.NUM(1,NL1)
  369.          NSOM2 = MELEFP.NUM(2,NL1)
  370.  
  371.          IF ((NSOM1.EQ.NGS1).OR.(NSOM2.EQ.NGS1)) THEN
  372.  
  373.          ICELL=(3*(NGS1 -1))+1
  374.          XS1=MCOORD.XCOOR(ICELL)
  375.          YS1=MCOORD.XCOOR(ICELL+1)
  376.  
  377.          ICELL=(3*(N1 -1))+1
  378.          XF=MCOORD.XCOOR(ICELL)
  379.          YF=MCOORD.XCOOR(ICELL+1)
  380. c on corrige pour VFSYM
  381.           IF (NBF.EQ.3) THEN
  382.           XF =  ((2.D0*XF/3.D0) + (XS1/3.D0))
  383.           YF =  ((2.D0*YF/3.D0) + (YS1/3.D0))
  384.           ENDIF
  385.  
  386.  
  387.          VECXG1(IG1) = -(YF - YG)
  388.          VECYG1(IG1) = (XF - XG)
  389.          VX = (XG - XS1)
  390.          VY = (YG - YS1)
  391.          PSCA = (VX*VECXG1(IG1)) + (VY*VECYG1(IG1))
  392.          IF (PSCA.LT.0.0D0) THEN
  393.          VECXG1(IG1) = +(YF - YG)
  394.          VECYG1(IG1) = -(XF - XG)
  395.          ENDIF
  396.  
  397. c ON REPERE l'INDICE
  398.              IF ((NSOM2.NE.NGS2).AND.(NSOM1.NE.NGS2)) THEN
  399.              INDG1 = IG1
  400.              NG1 = N1
  401.              ENDIF
  402.  
  403.  
  404.           IG1 = IG1 + 1
  405.  
  406. c          WRITE(6,*) 'NLCF= ',NLCF,'VECXG11= ',VECXG1(1)
  407. c          WRITE(6,*) 'NLCF= ',NLCF,'VECYG11= ',VECYG1(1)
  408. c          WRITE(6,*) 'NLCF= ',NLCF,'VECXG12= ',VECXG1(2)
  409. c          WRITE(6,*) 'NLCF= ',NLCF,'VECYG12= ',VECYG1(2)
  410. c          WRITE(6,*) 'NGCF= ',NGCF
  411. c          WRITE(6,*) 'N1= ',N1,'XF= ',XF,'YF= ',YF
  412. c          WRITE(6,*) 'N1= ',N1,'XG= ',XG,'YG= ',YG
  413.           ENDIF
  414.          IF ((NSOM1.EQ.NGS2).OR.(NSOM2.EQ.NGS2)) THEN
  415.  
  416.          ICELL=(3*(NGS2 -1))+1
  417.          XS2=MCOORD.XCOOR(ICELL)
  418.          YS2=MCOORD.XCOOR(ICELL+1)
  419.  
  420.          ICELL=(3*(N1 -1))+1
  421.          XF=MCOORD.XCOOR(ICELL)
  422.          YF=MCOORD.XCOOR(ICELL+1)
  423. c on corrige pour VFSYM
  424.           IF (NBF.EQ.3) THEN
  425.           XF =  ((2.D0*XF/3.D0) + (XS2/3.D0))
  426.           YF =  ((2.D0*YF/3.D0) + (YS2/3.D0))
  427.           ENDIF
  428.  
  429.          VECXG2(IG2) = -(YF - YG)
  430.          VECYG2(IG2) = (XF - XG)
  431.          VX = (XG - XS2)
  432.          VY = (YG - YS2)
  433.          PSCA = (VX*VECXG2(IG2)) + (VY*VECYG2(IG2))
  434.          IF (PSCA.LT.0.0D0) THEN
  435.          VECXG2(IG2) = +(YF - YG)
  436.          VECYG2(IG2) = -(XF - XG)
  437.          ENDIF
  438.  
  439.              IF ((NSOM2.NE.NGS1).AND.(NSOM1.NE.NGS1)) THEN
  440.              INDG2 = IG2
  441.              NG2 = N1
  442.              ENDIF
  443.           IG2 = IG2 + 1
  444.  
  445.           ENDIF
  446.         ENDDO
  447. c         SEGDES MELTFA
  448.  
  449.          MELTFA =  IMELEM(NLCD)
  450.          NBF = NBFACEL(NLCD)
  451. c         WRITE(6,*) 'NLCD= ',NLCD
  452. c         WRITE(6,*) 'NBF= ',NBF
  453. c         WRITE(6,*) 'MELTFA= ',MELTFA
  454. c         WRITE(6,*) 'DIMENSION1 ',MELTFA.NUM(/1)
  455. c         WRITE(6,*) 'DIMENSION2 ',MELTFA.NUM(/2)
  456.          IF (NLCD.GT.NMAI1) THEN
  457.          NDAUX = NLCD -NMAI1
  458.          ELSE
  459.          NDAUX = NLCD
  460.          ENDIF
  461. c         SEGACT MELTFA
  462.          DO J = 1,NBF
  463.          N1 = MELTFA.NUM(J,NDAUX)
  464.          NL1 = MLEFA.LECT(N1)
  465.  
  466.          NSOM1 = MELEFP.NUM(1,NL1)
  467.          NSOM2 = MELEFP.NUM(2,NL1)
  468.  
  469.          IF ((NSOM1.EQ.NGS1).OR.(NSOM2.EQ.NGS1)) THEN
  470.  
  471.          ICELL=(3*(N1 -1))+1
  472.          XF=MCOORD.XCOOR(ICELL)
  473.          YF=MCOORD.XCOOR(ICELL+1)
  474.          ICELL=(3*(NGS1 -1))+1
  475.          XS1=MCOORD.XCOOR(ICELL)
  476.          YS1=MCOORD.XCOOR(ICELL+1)
  477.  
  478. c on corrige pour VFSYM
  479.           IF (NBF.EQ.3) THEN
  480.           XF =  ((2.D0*XF/3.D0) + (XS1/3.D0))
  481.           YF =  ((2.D0*YF/3.D0) + (YS1/3.D0))
  482.           ENDIF
  483.  
  484.  
  485.          VECXD1(ID1) = - (YF - YD)
  486.          VECYD1(ID1) = (XF - XD)
  487.          VX = (XD - XS1)
  488.          VY = (YD - YS1)
  489.          PSCA = (VX*VECXD1(ID1)) + (VY*VECYD1(ID1))
  490.          IF (PSCA.LT.0.0D0) THEN
  491.          VECXD1(ID1) = +(YF - YD)
  492.          VECYD1(ID1) = -(XF - XD)
  493.          ENDIF
  494.  
  495.              IF ((NSOM2.NE.NGS2).AND.(NSOM1.NE.NGS2)) THEN
  496.              INDD1 = ID1
  497.              ND1 = N1
  498.              ENDIF
  499.  
  500.           ID1 = ID1 + 1
  501.  
  502.           ENDIF
  503.          IF ((NSOM1.EQ.NGS2).OR.(NSOM2.EQ.NGS2)) THEN
  504.  
  505.          ICELL=(3*(N1 -1))+1
  506.          XF=MCOORD.XCOOR(ICELL)
  507.          YF=MCOORD.XCOOR(ICELL+1)
  508.          ICELL=(3*(NGS2 -1))+1
  509.          XS2=MCOORD.XCOOR(ICELL)
  510.          YS2=MCOORD.XCOOR(ICELL+1)
  511.  
  512. c on corrige pour VFSYM
  513.           IF (NBF.EQ.3) THEN
  514.           XF =  ((2.D0*XF/3.D0) + (XS2/3.D0))
  515.           YF =  ((2.D0*YF/3.D0) + (YS2/3.D0))
  516.           ENDIF
  517.  
  518.  
  519.          VECXD2(ID2) = - (YF - YD)
  520.          VECYD2(ID2) = (XF - XD)
  521.          VX = (XD - XS2)
  522.          VY = (YD - YS2)
  523.          PSCA = (VX*VECXD2(ID2)) + (VY*VECYD2(ID2))
  524.          IF (PSCA.LT.0.0D0) THEN
  525.          VECXD2(ID2) = +(YF - YD)
  526.          VECYD2(ID2) = -(XF - XD)
  527.          ENDIF
  528.  
  529.              IF ((NSOM2.NE.NGS1).AND.(NSOM1.NE.NGS1)) THEN
  530.              INDD2 = ID2
  531.              ND2 = N1
  532.              ENDIF
  533.           ID2 = ID2 + 1
  534.  
  535.           ENDIF
  536.         ENDDO
  537. c        SEGDES MELTFA
  538.          AG1=0.5D0*ABS(  ( (VECXG1(1)*VECYG1(2)) -
  539.      &             (VECYG1(1))*VECXG1(2)) )
  540.  
  541.          AG2=0.5D0*ABS(  ( (VECXG2(1)*VECYG2(2)) -
  542.      &              (VECYG2(1))*VECXG2(2)) )
  543.  
  544.          AD1=0.5D0*ABS(  ( (VECXD1(1)*VECYD1(2)) -
  545.      &            (VECYD1(1))*VECXD1(2)) )
  546.  
  547.  
  548.          AD2=0.5D0*ABS(  ( (VECXD2(1)*VECYD2(2)) -
  549.      &             (VECYD2(1))*VECXD2(2)) )
  550.  
  551. c          WRITE(6,*) 'NLCF=',NLCF
  552. c          WRITE(6,*) 'NLCD=',NLCD
  553. c          WRITE(6,*) 'NLCG=',NLCG
  554. c          WRite(6,*) 'AG1=',AG1
  555. c          WRite(6,*) 'AG2=',AG2
  556. c          WRite(6,*) 'AD1=',AD1
  557. c          WRite(6,*) 'AD2=',AD2
  558. c          WRITE(6,*) 'NLCF= ',NLCF,'VECXG11= ',VECXG1(1)
  559. c          WRITE(6,*) 'NLCF= ',NLCF,'VECYG11= ',VECYG1(1)
  560. c          WRITE(6,*) 'NLCF= ',NLCF,'VECXG12= ',VECXG1(2)
  561. c          WRITE(6,*) 'NLCF= ',NLCF,'VECYG12= ',VECYG1(2)
  562. c          WRite(6,*) 'PSCAG1=',PSCAG1
  563. c          WRite(6,*) 'PSCAG2=',PSCAG2
  564. c          WRite(6,*) 'PSCAD1=',PSCAD1
  565. c          WRite(6,*) 'PSCAD2=',PSCAD2
  566. c          WRite(6,*) 'COEF1D=',COEF1D
  567. c          WRite(6,*) 'COEF2D=',COEF2D
  568. c          WRite(6,*) 'BETA1GD=',BETA1GD
  569. c          WRite(6,*) 'BETA2GD=',BETA2GD
  570. c          WRite(6,*) 'INDD2=',INDD2
  571.  
  572. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1
  573.            IF (ICHTE.EQ.0) THEN
  574.            COEF1 = ( (VECXG1(INDG1)*SCN1X) + (VECYG1(INDG1)*SCN1Y) )
  575.      &              / AG1
  576.            IAUX = 3 - INDG1
  577.            COEF2 = ( (VECXG1(IAUX)*SCN1X) + (VECYG1(IAUX)*SCN1Y) )
  578.      &              / AG1
  579.  
  580.            COEF3 = ( (VECXD1(INDD1)*SCN1X) + (VECYD1(INDD1)*SCN1Y) )
  581.      &              / AD1
  582.            IAUX = 3 - INDD1
  583.            COEF4 = ( (VECXD1(IAUX)*SCN1X) + (VECYD1(IAUX)*SCN1Y) )
  584.      &              / AD1
  585.            ELSE
  586. c           WRITE(6,*) 'NLCG= ',NLCG,'NLCG2= ',NLCG2
  587. c           WRITE(6,*) 'NLCD= ',NLCD,'NLCD2= ',NLCD2
  588.             IF (MPOTEN.VPOCHA(/2) .EQ.3) THEN
  589. c LE TENSEUR EST ANISOTROPE
  590.             K11G = MPOTEN.VPOCHA(NLCG,1)
  591.             K22G = MPOTEN.VPOCHA(NLCG,2)
  592.             K21G = MPOTEN.VPOCHA(NLCG,3)
  593.  
  594.             K11D = MPOTEN.VPOCHA(NLCD,1)
  595.             K22D = MPOTEN.VPOCHA(NLCD,2)
  596.             K21D = MPOTEN.VPOCHA(NLCD,3)
  597.             ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN
  598. c LE TENSEUR EST DIAGONAL
  599.             K11G = MPOTEN.VPOCHA(NLCG,1)
  600.             K22G = K11G
  601.             K21G = 0.0D0
  602.             K11D = MPOTEN.VPOCHA(NLCD,1)
  603.             K22D = K11D
  604.             K21D = 0.0D0
  605.             ELSE
  606.             WRITE(6,*) 'TENSEUR NON PREVU'
  607.             STOP
  608.             ENDIF
  609. c            xmink11 = min(K11G,xmink11)
  610. c            xmink11 = min(K11D,xmink11)
  611. c            xmaxk11 = max(K11G,xmaxk11)
  612. c            xmaxk11 = max(K11D,xmaxk11)
  613. c            xmink22 = min(K22G,xmink22)
  614. c            xmink22 = min(K22D,xmink22)
  615. c            xmaxk22 = max(K22G,xmaxk22)
  616. c            xmaxk22 = max(K22D,xmaxk22)
  617. c           WRITE(6,*) 'NLCF= ',NLCF
  618. c           WRITE(6,*) 'NLCG= ',NLCG, 'NLCD= ',NLCD
  619. c           WRite(6,*) 'K11G=',K11G,'K22G= ',K22G,'K21G=',K21G
  620. c           WRite(6,*) 'K11D=',K11D,'K22D= ',K22D,'K21D=',K21D
  621. c ON EST ICI
  622.  
  623. c PRODUIT TENSEUR VECTEUR
  624.             IAUX = 3 - INDD1
  625.             XLONGD = (VECXD1(IAUX)*VECXD1(IAUX)) +
  626.      &               (VECYD1(IAUX)*VECYD1(IAUX))
  627.             XLONGD = XLONGD**0.5
  628.             IAUX = 3 - INDG1
  629.             XLONGG = (VECXG1(IAUX)*VECXG1(IAUX)) +
  630.      &               (VECYG1(IAUX)*VECYG1(IAUX))
  631.             XLONGG = XLONGG**0.5
  632.         PSCAGX = (K11G*(VECXG1(INDG1)/AG1)) + (K21G*(VECYG1(INDG1)/AG1))
  633.         PSCAGY = (K21G*(VECXG1(INDG1))/AG1) + (K22G*(VECYG1(INDG1)/AG1))
  634.         COEF1 = ( (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) )
  635.  
  636.         IAUX = 3 - INDG1
  637.         PSCAGX = (K11G*(VECXG1(IAUX)/AG1)) + (K21G*(VECYG1(IAUX)/AG1))
  638.         PSCAGY = (K21G*(VECXG1(IAUX)/AG1)) + (K22G*(VECYG1(IAUX)/AG1))
  639.         COEF2 = ( (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) )
  640.  
  641.         PSCADX = (K11D*(VECXD1(INDD1)/AD1)) + (K21D*(VECYD1(INDD1)/AD1))
  642.         PSCADY = (K21D*(VECXD1(INDD1)/AD1)) + (K22D*(VECYD1(INDD1)/AD1))
  643.         COEF3 = ( (PSCADX*SCN1X) + (PSCADY*SCN1Y) )
  644.  
  645.         IAUX = 3 - INDD1
  646.         PSCADX = (K11D*(VECXD1(IAUX)/AD1)) + (K21D*(VECYD1(IAUX)/AD1))
  647.         PSCADY = (K21D*(VECXD1(IAUX)/AD1)) + (K22D*(VECYD1(IAUX)/AD1))
  648.         COEF4 = ( (PSCADX*SCN1X) + (PSCADY*SCN1Y) )
  649.  
  650.            ENDIF
  651.  
  652. c          WRite(6,*) 'COEF1=',COEF1
  653. c          WRite(6,*) 'COEF2=',COEF2
  654. c          WRite(6,*) 'COEF3=',COEF3
  655. c          WRite(6,*) 'COEF4=',COEF4
  656.  
  657.                MARQ = 0
  658.                DO I5 = 1,INDLI.ID(NLS1)
  659.                INDAUX = IND2.NUME(I5,NLS1)
  660.                IF (INDAUX.EQ.NGCF) THEN
  661.                MARQ = 1
  662.                IAFF = I5
  663.                GOTO 4
  664.                ENDIF
  665.                ENDDO
  666.  4              CONTINUE
  667.  
  668.  
  669.            IF (MARQ.EQ.0) THEN
  670.            INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1
  671.            ICOU = INDLI.ID(NLS1)
  672.            IND2.NUME(ICOU,NLS1) = NGCF
  673.            ELSE
  674.            ICOU = IAFF
  675.            ENDIF
  676.  
  677.  
  678.            COEF = (COEF1 - COEF3)
  679.            MATR1 = IPO2.POINT(NLS1)
  680.            SEGACT MATR1 *MOD
  681.            MATR1.MAT2(ICOU,ICOU) = COEF
  682.  
  683.                MARQ = 0
  684.                DO I5 = 1,INDLI.ID(NLS1)
  685.                INDAUX = IND2.NUME(I5,NLS1)
  686.                IF (INDAUX.EQ.NG1) THEN
  687.                MARQ = 1
  688.                IAFF = I5
  689.                GOTO 5
  690.                ENDIF
  691.                ENDDO
  692.  5              CONTINUE
  693.  
  694.  
  695.            IF (MARQ.EQ.0) THEN
  696.            INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1
  697.            ICOUCO = INDLI.ID(NLS1)
  698.            IND2.NUME(ICOUCO,NLS1) = NG1
  699.            ELSE
  700.            ICOUCO = IAFF
  701.            ENDIF
  702.            ICOUG = ICOUCO
  703.  
  704.  
  705.            MATR1.MAT2(ICOU,ICOUCO) = COEF2
  706.  
  707.  
  708.                MARQ = 0
  709.                DO I5 = 1,INDLI.ID(NLS1)
  710.                INDAUX = IND2.NUME(I5,NLS1)
  711.                IF (INDAUX.EQ.ND1) THEN
  712.                MARQ = 1
  713.                IAFF = I5
  714.                GOTO 6
  715.                ENDIF
  716.                ENDDO
  717.  6              CONTINUE
  718.  
  719.  
  720.            IF (MARQ.EQ.0) THEN
  721.            INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1
  722.            ICOUCO = INDLI.ID(NLS1)
  723.            IND2.NUME(ICOUCO,NLS1) = ND1
  724.            ELSE
  725.            ICOUCO = IAFF
  726.            ENDIF
  727.            ICOUD = ICOUCO
  728.  
  729.  
  730.  
  731.            MATR1.MAT2(ICOU,ICOUCO) = -COEF4
  732.  
  733.            SCMB.MAT(ICOU,NLS1) =
  734.      &      (((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)) -
  735.      &       ((COEF3+COEF4)*MPOCHP.VPOCHA(NLCD,1)))
  736.  
  737.  
  738.  
  739.  
  740. * COEF POUR INVERSER LA MATRICE
  741.  
  742. * ON CORRIGE ICI
  743.                VAL1.MAT(ICOU,NLS1) = (COEF1 + COEF2)
  744.                VAL2.MAT(ICOU,NLS1) =  - ((COEF3 + COEF4))
  745.                IND.NUME(ICOU,NLS1) = NGCG
  746.                IND22.NUME(ICOU,NLS1) = NGCD
  747.  
  748. * CONDITION AUX LIMITE DE DIRICICHLET
  749.            IF (NGCG.EQ.NGCD) THEN
  750.            NLFCL=MLENCL.LECT(NGCF)
  751.            NL1=MLENCL.LECT(NGS1)
  752.            NL2=MLENCL.LECT(NGS2)
  753.  
  754.            IF ((NL1.GT.0).AND.(NL2.GT.0)) THEN
  755.            COEF = COEF1
  756.            MATR1.MAT2(ICOU,ICOU) = COEF
  757.            MATR1.MAT2(ICOU,ICOUG) = 0.0D0
  758.            MATR1.MAT2(ICOU,ICOUD) = 0.0D0
  759.            IF (NBF.EQ.3) THEN
  760.            SCMB.MAT(ICOU,NLS1) =
  761.      c    (COEF*2.D0*MPOVCL.VPOCHA(NL1,1)/3.D0) +
  762.      c    (COEF*MPOVCL.VPOCHA(NL2,1)/3.D0)
  763.            ELSE
  764.            SCMB.MAT(ICOU,NLS1) =
  765.      c    (COEF*MPOVCL.VPOCHA(NL1,1)/2.D0) +
  766.      c    (COEF*MPOVCL.VPOCHA(NL2,1)/2.D0)
  767.  
  768.            ENDIF
  769.  
  770.                VAL1.MAT(ICOU,NLS1) = COEF
  771.                VAL2.MAT(ICOU,NLS1) = 0.0D0
  772. c ON AJOUTE ICI UN POINT FACE POUR COMPATIBILITE AVEC LAPN
  773.                IND.NUME(ICOU,NLS1) = NGCF
  774.                IND22.NUME(ICOU,NLS1) = NGCD
  775.            ELSE
  776.            NLFNE=MLENNE.LECT(NGCF)
  777.  
  778. c CONDITION DE FLUX
  779.            IF (NLFNE.GT.0) THEN
  780.            QIMPX = MPOVNE.VPOCHA(NLFNE,1)
  781. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  782.            QIMPS = (QIMPX)
  783.  
  784.            COEF = COEF1
  785.            MATR1.MAT2(ICOU,ICOU) =    COEF
  786.            MATR1.MAT2(ICOU,ICOUG) =  COEF2
  787.  
  788.            SCMB.MAT(ICOU,NLS1) = (
  789.      &    ((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1))) + (2.D0*QIMPS)
  790.            VAL1.MAT(ICOU,NLS1) = (COEF1 + COEF2)
  791.                VAL2.MAT(ICOU,NLS1) =  2.D0
  792.                IND.NUME(ICOU,NLS1) = NGCG
  793.                IND22.NUME(ICOU,NLS1) = NGCF
  794.  
  795.            ELSE
  796. c CONDITION MIXTE
  797.            NLFMI=MLENMI.LECT(NGCF)
  798.            IF (NLFMI.GT.0) THEN
  799.            XLAMBDA1 = MPOVMI.VPOCHA(NLFMI,1)
  800.            XLAMBDA2 = MPOVMI.VPOCHA(NLFMI,2)
  801.            QIMPX = MPOVMI.VPOCHA(NLFMI,3)
  802. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  803.            QIMPS = (QIMPX)
  804.  
  805. c           WRITE(6,*) 'NLCF= ',NLCF
  806. c           WRITE(6,*) 'NGCF= ',NGCF
  807. c           WRITE(6,*) 'XLAMBDA1= ',XLAMBDA1,'XLAMBDA2= ',XLAMBDA2
  808. c           WRITE(6,*) 'QIMPX= ',QIMPX,'QIMPY= ',QIMPY
  809.            COEF = COEF1
  810.            MATR1.MAT2(ICOU,ICOU) =  (XLAMBDA1*COEF) -
  811.      &      (2.D0*XLAMBDA2)
  812.            MATR1.MAT2(ICOU,ICOUG) =  (XLAMBDA1*COEF2)
  813.            SCMB.MAT(ICOU,NLS1) =
  814.      &     (XLAMBDA1*((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)))
  815.      &      + (2.D0*QIMPS)
  816.                VAL1.MAT(ICOU,NLS1) = XLAMBDA1*(COEF1 + COEF2)
  817.                VAL2.MAT(ICOU,NLS1) =  2.D0
  818.                IND.NUME(ICOU,NLS1) = NGCG
  819.                IND22.NUME(ICOU,NLS1) = NGCF
  820.            ELSE
  821. C PAR DEFAUT FLUX NUL
  822.            QIMPS = 0
  823.            COEF = COEF1
  824.            MATR1.MAT2(ICOU,ICOU) =  COEF
  825.            MATR1.MAT2(ICOU,ICOUG) =  COEF2
  826.            SCMB.MAT(ICOU,NLS1) =
  827.      &     (((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)))
  828.                VAL1.MAT(ICOU,NLS1) = (COEF1 + COEF2)
  829.                VAL2.MAT(ICOU,NLS1) =  0.D0
  830.                IND.NUME(ICOU,NLS1) = NGCG
  831.                IND22.NUME(ICOU,NLS1) = NGCD
  832.            ENDIF
  833.  
  834.            ENDIF
  835.  
  836.            ENDIF
  837.            ENDIF
  838.  
  839. c       WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  840. c     &             'IND= ',IND.NUME(ICOU,NLS1),
  841. c     &                  'IND22= ',IND22.NUME(ICOU,NLS1),
  842. c     &   'SCMB', SCMB.MAT(ICOU,NLS1),
  843. c     &  'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1),
  844. c     &  'ICOUG= ',ICOUG,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG,NLS1),
  845. c     &  'ICOUD= ',ICOUD,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD,NLS1)
  846. c       WRITE(6,*) 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ',
  847. c     &  COEF3,'COEF4=',COEF4,'HG=',MPOCHP.VPOCHA(NLCG,1),
  848. c     &   'HD= ',MPOCHP.VPOCHA(NLCD,1)
  849.  
  850.            SEGDES MATR1 *MOD
  851.  
  852. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS2
  853.  
  854.            IF (ICHTE.EQ.0) THEN
  855.            COEF1 = ( (VECXG2(INDG2)*SCN1X) + (VECYG2(INDG2)*SCN1Y) )
  856.      &              / AG2
  857.            IAUX = 3 - INDG2
  858.            COEF2 = ( (VECXG2(IAUX)*SCN1X) + (VECYG2(IAUX)*SCN1Y) )
  859.      &              / AG2
  860.  
  861.            COEF3 = ( (VECXD2(INDD2)*SCN1X) + (VECYD2(INDD2)*SCN1Y) )
  862.      &              / AD2
  863.            IAUX = 3 - INDD2
  864.            COEF4 = ( (VECXD2(IAUX)*SCN1X) + (VECYD2(IAUX)*SCN1Y) )
  865.      &              / AD2
  866.            ELSE
  867.  
  868.             IF (MPOTEN.VPOCHA(/2) .EQ.3) THEN
  869. c LE TENSEUR EST ANISOTROPE
  870.             K11G = MPOTEN.VPOCHA(NLCG,1)
  871.             K22G = MPOTEN.VPOCHA(NLCG,2)
  872.             K21G = MPOTEN.VPOCHA(NLCG,3)
  873.  
  874.             K11D = MPOTEN.VPOCHA(NLCD,1)
  875.             K22D = MPOTEN.VPOCHA(NLCD,2)
  876.             K21D = MPOTEN.VPOCHA(NLCD,3)
  877.             ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN
  878. c LE TENSEUR EST DIAGONAL
  879.             K11G = MPOTEN.VPOCHA(NLCG,1)
  880.             K22G = K11G
  881.             K21G = 0.0D0
  882.             K11D = MPOTEN.VPOCHA(NLCD,1)
  883.             K22D = K11D
  884.             K21D = 0.0D0
  885.             ELSE
  886.             WRITE(6,*) 'TENSEUR NON PREVU'
  887.             STOP
  888.             ENDIF
  889.  
  890. c PRODUIT TENSEUR VECTEUR
  891.             IAUX = 3 - INDD1
  892.             XLONGD = (VECXD1(IAUX)*VECXD1(IAUX)) +
  893.      &               (VECYD1(IAUX)*VECYD1(IAUX))
  894.             XLONGD = XLONGD**0.5
  895.             IAUX = 3 - INDG1
  896.             XLONGG = (VECXG1(IAUX)*VECXG1(IAUX)) +
  897.      &               (VECYG1(IAUX)*VECYG1(IAUX))
  898.             XLONGG = XLONGG**0.5
  899.  
  900.         PSCAGX = (K11G*(VECXG2(INDG2)/AG2)) + (K21G*(VECYG2(INDG2)/AG2))
  901.         PSCAGY = (K21G*(VECXG2(INDG2))/AG2) + (K22G*(VECYG2(INDG2)/AG2))
  902.         COEF1 = ( (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) )
  903.  
  904.         IAUX = 3 - INDG2
  905.         PSCAGX = (K11G*(VECXG2(IAUX)/AG2)) + (K21G*(VECYG2(IAUX)/AG2))
  906.         PSCAGY = (K21G*(VECXG2(IAUX)/AG2)) + (K22G*(VECYG2(IAUX)/AG2))
  907.         COEF2 = ( (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) )
  908.  
  909.         PSCADX = (K11D*(VECXD2(INDD2)/AD2)) + (K21D*(VECYD2(INDD2)/AD2))
  910.         PSCADY = (K21D*(VECXD2(INDD2)/AD2)) + (K22D*(VECYD2(INDD2)/AD2))
  911.         COEF3 = ( (PSCADX*SCN1X) + (PSCADY*SCN1Y) )
  912.  
  913.         IAUX = 3 - INDD2
  914.         PSCADX = (K11D*(VECXD2(IAUX)/AD2)) + (K21D*(VECYD2(IAUX)/AD2))
  915.         PSCADY = (K21D*(VECXD2(IAUX)/AD2)) + (K22D*(VECYD2(IAUX)/AD2))
  916.         COEF4 = ( (PSCADX*SCN1X) + (PSCADY*SCN1Y) )
  917.                ENDIF
  918.  
  919.                MARQ = 0
  920.                DO I5 = 1,INDLI.ID(NLS2)
  921.                INDAUX = IND2.NUME(I5,NLS2)
  922.                IF (INDAUX.EQ.NGCF) THEN
  923.                MARQ = 1
  924.                IAFF = I5
  925.                GOTO 41
  926.                ENDIF
  927.                ENDDO
  928.  41              CONTINUE
  929.  
  930.  
  931.            IF (MARQ.EQ.0) THEN
  932.            INDLI.ID(NLS2) = INDLI.ID(NLS2) + 1
  933.            ICOU = INDLI.ID(NLS2)
  934.            IND2.NUME(ICOU,NLS2) = NGCF
  935.            ELSE
  936.            ICOU = IAFF
  937.            ENDIF
  938.  
  939.            COEF = (COEF1 - COEF3)
  940.  
  941.            MATR1 = IPO2.POINT(NLS2)
  942.            SEGACT MATR1 *MOD
  943.            MATR1.MAT2(ICOU,ICOU) = COEF
  944.  
  945.                MARQ = 0
  946.                DO I5 = 1,INDLI.ID(NLS2)
  947.                INDAUX = IND2.NUME(I5,NLS2)
  948.                IF (INDAUX.EQ.NG2) THEN
  949.                MARQ = 1
  950.                IAFF = I5
  951.                GOTO 51
  952.                ENDIF
  953.                ENDDO
  954.  51              CONTINUE
  955.  
  956.  
  957.            IF (MARQ.EQ.0) THEN
  958.            INDLI.ID(NLS2) = INDLI.ID(NLS2) + 1
  959.            ICOUCO = INDLI.ID(NLS2)
  960.            IND2.NUME(ICOUCO,NLS2) = NG2
  961.            ELSE
  962.            ICOUCO = IAFF
  963.            ENDIF
  964.            ICOUG = ICOUCO
  965.  
  966.  
  967.            MATR1.MAT2(ICOU,ICOUCO) = COEF2
  968.  
  969.  
  970.                MARQ = 0
  971.                DO I5 = 1,INDLI.ID(NLS2)
  972.                INDAUX = IND2.NUME(I5,NLS2)
  973.                IF (INDAUX.EQ.ND2) THEN
  974.                MARQ = 1
  975.                IAFF = I5
  976.                GOTO 61
  977.                ENDIF
  978.                ENDDO
  979.  61              CONTINUE
  980.  
  981.  
  982.            IF (MARQ.EQ.0) THEN
  983.            INDLI.ID(NLS2) = INDLI.ID(NLS2) + 1
  984.            ICOUCO = INDLI.ID(NLS2)
  985.            IND2.NUME(ICOUCO,NLS2) = ND2
  986.            ELSE
  987.            ICOUCO = IAFF
  988.            ENDIF
  989.            ICOUD = ICOUCO
  990.  
  991.  
  992.  
  993.            MATR1.MAT2(ICOU,ICOUCO) = -COEF4
  994.  
  995.            SCMB.MAT(ICOU,NLS2) =(
  996.      &     ((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)) -
  997.      &     ((COEF3+COEF4)*MPOCHP.VPOCHA(NLCD,1)))
  998.  
  999.                VAL1.MAT(ICOU,NLS2) = (COEF1 + COEF2)
  1000.                VAL2.MAT(ICOU,NLS2) =  - ((COEF3 + COEF4))
  1001.                IND.NUME(ICOU,NLS2) = NGCG
  1002.                IND22.NUME(ICOU,NLS2) = NGCD
  1003.  
  1004. * CONDITION AUX LIMITE DE DIRICICHLET
  1005.            IF (NGCG.EQ.NGCD) THEN
  1006.            NLFCL=MLENCL.LECT(NGCF)
  1007.            NL1=MLENCL.LECT(NGS1)
  1008.            NL2=MLENCL.LECT(NGS2)
  1009.            IF ((NL1.GT.0).AND.(NL2.GT.0)) THEN
  1010. c           WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',NGCF
  1011. c           WRITE(6,*) 'CLIM= ', MPOVCL.VPOCHA(NLFCL,1)
  1012.            COEF = MAX(ABS(COEF1),ABS(COEF2))
  1013. c           WRITE(6,*) 'COEF= ',COEF
  1014. c           WRITE(6,*) 'COEF1= ',COEF1
  1015. c           WRITE(6,*) 'COEF2= ',COEF2
  1016.            MATR1.MAT2(ICOU,ICOU) =  COEF
  1017.            MATR1.MAT2(ICOU,ICOUG) = 0.0D0
  1018.            MATR1.MAT2(ICOU,ICOUD) = 0.0D0
  1019.  
  1020. c           SCMB.MAT(ICOU,NLS2) = (COEF*MPOVCL.VPOCHA(NLFCL,1))
  1021.            IF (NBF.EQ.3) THEN
  1022.            SCMB.MAT(ICOU,NLS2) =
  1023.      c    (COEF*2.D0*MPOVCL.VPOCHA(NL2,1)/3.D0) +
  1024.      c    (COEF*MPOVCL.VPOCHA(NL1,1)/3.D0)
  1025.            ELSE
  1026.            SCMB.MAT(ICOU,NLS2) =
  1027.      c    (COEF*MPOVCL.VPOCHA(NL2,1)/2.D0) +
  1028.      c    (COEF*MPOVCL.VPOCHA(NL1,1)/2.D0)
  1029.            ENDIF
  1030.                VAL1.MAT(ICOU,NLS2) = COEF
  1031.                VAL2.MAT(ICOU,NLS2) = 0.0D0
  1032. c ON AJOUTE ICI UN POINT FACE POUR COMPATIBILITE AVEC LAPN
  1033.                IND.NUME(ICOU,NLS2) = NGCF
  1034.                IND22.NUME(ICOU,NLS2) = NGCD
  1035.            ELSE
  1036. c CONDITION DE FLUX
  1037.            NLFNE=MLENNE.LECT(NGCF)
  1038.  
  1039.            IF (NLFNE.GT.0) THEN
  1040.            QIMPX = MPOVNE.VPOCHA(NLFNE,1)
  1041. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  1042.            QIMPS = (QIMPX)
  1043.  
  1044.            COEF = COEF1
  1045.            MATR1.MAT2(ICOU,ICOU) =  COEF
  1046.            MATR1.MAT2(ICOU,ICOUG) =  COEF2
  1047.            SCMB.MAT(ICOU,NLS2) =
  1048.      &     (((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)))
  1049.      &      + (2.D0*QIMPS)
  1050.                VAL1.MAT(ICOU,NLS2) = (COEF1 + COEF2)
  1051.                VAL2.MAT(ICOU,NLS2) =  2.D0
  1052.                IND.NUME(ICOU,NLS2) = NGCG
  1053.                IND22.NUME(ICOU,NLS2) = NGCF
  1054.            ELSE
  1055. c CONDITION MIXTE
  1056.            NLFMI=MLENMI.LECT(NGCF)
  1057.            IF (NLFMI.GT.0) THEN
  1058.            XLAMBDA1 = MPOVMI.VPOCHA(NLFMI,1)
  1059.            XLAMBDA2 = MPOVMI.VPOCHA(NLFMI,2)
  1060.            QIMPX = MPOVMI.VPOCHA(NLFMI,3)
  1061. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  1062.            QIMPS = (QIMPX)
  1063. c           WRITE(6,*) 'QIMPX= ',QIMPX,'QIMPY= ',QIMPY
  1064. c
  1065.            COEF = COEF1
  1066. c           WRITE(6,*) 'NGCF= ',NGCF
  1067. c           WRITE(6,*) 'XLAMBDA1= ',XLAMBDA1,'XLAMBDA2= ',XLAMBDA2
  1068. c           WRITE(6,*) 'COEF= ',COEF
  1069.            MATR1.MAT2(ICOU,ICOU) =  (XLAMBDA1*COEF) -
  1070.      &     (2.D0*XLAMBDA2)
  1071.            MATR1.MAT2(ICOU,ICOUG) =  (XLAMBDA1*COEF2)
  1072.            SCMB.MAT(ICOU,NLS2) =
  1073.      &     (XLAMBDA1*((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)))
  1074.      &      + (2.D0*QIMPS)
  1075.                VAL1.MAT(ICOU,NLS2) = XLAMBDA1*(COEF1 + COEF2)
  1076.                VAL2.MAT(ICOU,NLS2) =  2.D0
  1077.                IND.NUME(ICOU,NLS2) = NGCG
  1078.                IND22.NUME(ICOU,NLS2) = NGCF
  1079.            ELSE
  1080. C PAR DEFAUT FLUX NUL
  1081.            QIMPS = 0
  1082.            COEF = COEF1
  1083.            MATR1.MAT2(ICOU,ICOU) =  COEF
  1084.            MATR1.MAT2(ICOU,ICOUG) =  COEF2
  1085.            SCMB.MAT(ICOU,NLS2) =
  1086.      &     (((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)))
  1087.                VAL1.MAT(ICOU,NLS2) = (COEF1 + COEF2)
  1088.                VAL2.MAT(ICOU,NLS2) =  0.D0
  1089.                IND.NUME(ICOU,NLS2) = NGCG
  1090.                IND22.NUME(ICOU,NLS2) = NGCD
  1091.            ENDIF
  1092.  
  1093.            ENDIF
  1094.  
  1095.            ENDIF
  1096.            ENDIF
  1097.  
  1098.            SEGDES MATR1 *MOD
  1099. c       WRITE(6,*) 'NLS2= ',NLS2,'ICOU=',ICOU,
  1100. c     &             'IND= ',IND.NUME(ICOU,NLS2),
  1101. c     &                  'IND22= ',IND22.NUME(ICOU,NLS2)
  1102. c       WRITE(6,*) 'NLS2= ',NLS2,'ICOU=',ICOU,'SCMB', SCMB.MAT(NLS2,ICOU)
  1103. c       WRITE(6,*) 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ',
  1104. c     &  COEF3,'COEF4=',COEF4,'HG=',MPOCHP.VPOCHA(NLCG,1),
  1105. c     &   'HD= ',MPOCHP.VPOCHA(NLCD,1)
  1106.  
  1107. c       WRITE(6,*) 'NLS2= ',NLS2,'ICOU=',ICOU,
  1108. c     &             'IND= ',IND.NUME(ICOU,NLS2),
  1109. c     &                  'IND22= ',IND22.NUME(ICOU,NLS2),
  1110. c     &   'SCMB', SCMB.MAT(ICOU,NLS2),
  1111. c     &  'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS2),
  1112. c     &  'ICOUG= ',ICOUG,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG,NLS2),
  1113. c     &  'ICOUD= ',ICOUD,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD,NLS2)
  1114. c       WRITE(6,*) 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ',
  1115. c          DO I=1,INDLI.ID(NLS1)
  1116. c            DO J = 1,INDLI.ID(NLS1)
  1117. c            WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,MATR1.MAT2(I,J,NLS1)
  1118. c            WRITE(6,*) 'NLS2= ',NLS2,'I=',I,'J=',J,MATR1.MAT2(I,J,NLS2)
  1119. c            ENDDO
  1120. c          ENDDO
  1121.  
  1122.  
  1123.         ENDDO
  1124. c             DO J= 1,INDLI.ID(NLS1)
  1125. c             WRITE(6,*)  'MELVA1=',MELVA1.VELCHE(J,NLCF)
  1126. c             WRITE(6,*)  'MELVA2=',MELVA1.VELCHE(J,NLCF)
  1127. c             WRITE(6,*)  'MELEME=',MELEME.NUM(J,NLCF)
  1128. c             ENDDO
  1129.  
  1130.       MELTFA = MAUX
  1131.       IF (NBSO.EQ.2) THEN
  1132.       SEGDES IPT1
  1133.       SEGDES IPT2
  1134.       ENDIF
  1135.  
  1136.  
  1137.  9999 CONTINUE
  1138.       RETURN
  1139.       END
  1140.  
  1141.  
  1142.  
  1143.  
  1144.  
  1145.  
  1146.  
  1147.  
  1148.  
  1149.  
  1150.  
  1151.  
  1152.  
  1153.  
  1154.  
  1155.  
  1156.  
  1157.  

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