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

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