Télécharger la plaquette Cast3M


fr en

Télécharger norv2.eso

Retour à la liste

Numérotation des lignes : 

norv2

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

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