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

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