Télécharger la plaquette Cast3M


fr en

Télécharger norv3.eso

Retour à la liste

Numérotation des lignes : 

norv3

  1. C NORV3     SOURCE    CB215821  20/11/25    13:35:14     10792          
  2.       SUBROUTINE NORV3(NSOMM,NBMAX,IPO2,SCMB,INDLI,
  3.      &           VAL1,VAL2,IND22,IND2,IND,IPO3,VAUX,TAB)
  4. C
  5. C************************************************************************
  6. C
  7. C PROJET            :  CASTEM 2000
  8. C
  9. C NOM               :  NORV1
  10. C
  11. C DESCRIPTION       : Appelle par NORV
  12. C
  13. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  14. C
  15. C AUTEUR            :  C. LE POTIER, DM2S/SFME/MTMS
  16. C
  17. C************************************************************************
  18. C
  19.       IMPLICIT INTEGER(I-N)
  20.       IMPLICIT REAL*8 (a-h,o-z)
  21. -INC SMLENTI
  22. -INC SMELEME
  23. -INC SMCHPOI
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC SMCOORD
  28. -INC SMLREEL
  29.       POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME,
  30.      &         MELTFA.MELEME
  31.       POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL,
  32.      & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL,
  33.      & MPOGRA.MPOVAL,MPOTEN.MPOVAL
  34.       POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI,
  35.      &         MLEFA.MLENTI
  36. -INC SMCHAML
  37.       INTEGER NBNN,NBREF
  38.  
  39.  
  40.  
  41. C
  42. C**** Variables de COOPTIO
  43. C
  44. C
  45. C**** Variables de COOPTIO
  46. C
  47. C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  48. C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  49. C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  50. C     &        ,IECHO,   IIMPI,  IOSPI
  51. C     &        ,IDIM
  52. C     &        ,MCOORD
  53. C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  54. C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  55. C     &        ,NORINC,NORVAL,NORIND,NORVAD
  56. C     &        ,NUCROU, IPSAUV
  57.  
  58. C**** Variable de SMLENTI, SMCHPOI
  59. C
  60.       INTEGER JG, N, NC,  NSOUPO, NAT, NBSOUS, NBNO,NBELEM
  61. C
  62. C**** Les includes
  63. C
  64.       INTEGER I1,ICOMP,ICOMGR,IGEOM
  65.      &     ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM
  66.      &     ,ISURF,IMAIL,ICHPO,ICHCL,ICHGRA,ICOEFF
  67.      &     ,NTOT,NSOMM,NCOMP,NFAC,NCEN
  68.      &     ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2
  69.      &     ,NLS1,NLS2,NLFCL
  70.      &     ,ISOUS,IELEM,INOEUD,ICELL
  71.       INTEGER ICEN2
  72.       REAL*8 SCNX,SCNY,SURF,VOL,VAL,VALX,VALY,XG,XD,XF,XS1,XS2
  73.      &     ,YG,YD,YF,YS1,YS2,PSCA,XNORM,VECX,VECY,PSCAGX,PSCAGY,
  74.      &     PSCADX,PSCADY,K11G,K22G,K21G,K11D,K22D,K21D,VXG1,VXG2,
  75.      &     VXAU,VYAU,VXD1,VXD2,VYG1,VYG2,TRG1,TRG2,
  76.      &     TRD1,TRD2,TRG,TRD,VALAUX
  77.       REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2,
  78.      & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,VX,VY,COEF1X,COEF2X,
  79.      & COEF1Y,COEF2Y,CX,CY,ANCX,ANCY,DIFFX,DIFFY,XLONGG,XLONGD
  80.      &  VALD,VALG,COEF,GX,GY,XMINK11,XMAXK11,XMINK22,XMAXK22
  81.  
  82.       REAL*8 VECXG1(2),VECYG1(2)
  83.       REAL*8 VECXG2(2),VECYG2(2)
  84.       REAL*8 VECXD1(2),VECYD1(2)
  85.       REAL*8 VECXD2(2),VECYD2(2)
  86.       REAL*8 EPS
  87.       INTEGER ICRIT
  88.       CHARACTER*(4) NOMCOM(18)
  89.       CHARACTER*8 TYPE
  90. C
  91.       DATA NOMCOM  /'P1DX','P1DY',
  92.      &     'P2DX','P2DY',
  93.      &     'P3DX','P3DY',
  94.      &     'P4DX','P4DY',
  95.      &     'P5DX','P5DY',
  96.      &     'P6DX','P6DY',
  97.      &     'P7DX','P7DY',
  98.      &     'P8DX','P8DY',
  99.      &     'P9DX','P9DY'/
  100.  
  101.       INTEGER NDIM
  102.       SEGMENT MMAT1
  103.       REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM)
  104.       INTEGER IC(NDIM)
  105.       ENDSEGMENT
  106.  
  107.       INTEGER K1,K2
  108.       SEGMENT INDICE
  109.       INTEGER NUME(K1,K2)
  110.       ENDSEGMENT
  111.       POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE
  112.  
  113.       SEGMENT MATRICE
  114.       REAL*8 MAT(K1,K2)
  115.       ENDSEGMENT
  116.       POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE
  117.  
  118.       INTEGER K3
  119.       SEGMENT POINT2
  120.       INTEGER POINT(K3)
  121.       ENDSEGMENT
  122.       POINTEUR IPO2.POINT2
  123.  
  124.       SEGMENT MATRICE2
  125.       REAL*8 MAT2(K1,K2)
  126.       ENDSEGMENT
  127.       POINTEUR MATR1.MATRICE2,MATR2.MATRICE2
  128.  
  129.  
  130.       SEGMENT POINT3
  131.       INTEGER POINT33(K3)
  132.       ENDSEGMENT
  133.       POINTEUR IPO3.POINT3
  134.  
  135.       SEGMENT INDICE3
  136.       INTEGER NU(K1,K2)
  137.       ENDSEGMENT
  138.       POINTEUR INDIC.INDICE3
  139.  
  140.  
  141.  
  142.  
  143.       SEGMENT REP
  144.       INTEGER  ID(K3)
  145.       ENDSEGMENT
  146.       POINTEUR TAB.REP,INDLI.REP
  147.  
  148.  
  149.       K3 = NSOMM
  150.       SEGINI  IPO3
  151. c      SEGINI VAUX
  152.  
  153.  
  154.  
  155.  
  156.  
  157. c      WRITE(6,*) 'DANS NORV3'
  158. c      WRITE(6,*) 'NBMAX= ',NBMAX
  159.  
  160. * ON EST ICI
  161. c INVERSION DE CHAQUE PETITE MATRICE
  162.       EPS = 1.e-30
  163.       XINF = 1.e+30
  164.       NMOY = 0
  165.       DO NLS1=1,NSOMM,1
  166.       NMOY = NMOY + (INDLI.ID(NLS1)*INDLI.ID(NLS1))
  167.           NDIM = INDLI.ID(NLS1)
  168. c          WRITE(6,*) 'NLS1= ',NLS1,'NDIM = ', NDIM
  169.            K1 = NBMAX
  170.            K2 = (NBMAX+1)
  171.           SEGINI MMAT1
  172.  
  173.           K1 = NBMAX
  174.           K2 = NBMAX + 1
  175.           SEGINI INDIC
  176.           IPO3.POINT33(NLS1) = INDIC
  177.  
  178. C ON EST ICI
  179.           MATR1 =  IPO2.POINT(NLS1)
  180.           SEGACT MATR1 *MOD
  181.  
  182.           DO I=1,INDLI.ID(NLS1)
  183.             DO J = 1,INDLI.ID(NLS1)
  184.             PM(I,J) = MATR1.MAT2(I,J)
  185. c            WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,PM(I,J)
  186.             ENDDO
  187. c          WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'SCMB', SCMB.MAT(I,NLS1)
  188.           ENDDO
  189. c          WRITE(6,*) 'NLS1= ',NLS1,'EPS= ',EPS
  190.           CALL INVER(PM,NDIM,ICRIT,PM1,IC,EPS)
  191. c          WRITE(6,*) 'NLS1= ',NLS1,'EPS= ',EPS
  192. c          WRITE(6,*) 'NLS1= ',NLS1,'ICRIT= ',ICRIT
  193.           IF (ICRIT.EQ.1)  THEN
  194.           WRITE(6,*) 'MATRICE PEUT ETRE NON INVERSIBLE'
  195.            WRITE(6,*) 'NLS1= ',NLS1
  196. c          DO I=1,INDLI.ID(NLS1)
  197. c            DO J = 1,INDLI.ID(NLS1)
  198. c            PM(I,J) = 0.0
  199. c            WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,'NOEUD2= ',
  200. c     &     MATR1.MAT2(I,J)
  201. c           WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,'PM= ',PM(I,J)
  202. c            ENDDO
  203. c          ENDDO
  204.           ENDIF
  205.  
  206.           ITROUVE = 0
  207.           DO I=1,INDLI.ID(NLS1)
  208.             DO J = 1,INDLI.ID(NLS1)
  209.             IF (PM(I,J).GT.XINF) THEN
  210.             ITROUVE = 1
  211.             GOTO 444
  212.             ENDIF
  213.             ENDDO
  214.           ENDDO
  215.  444      CONTINUE
  216.  
  217.           IF (ITROUVE.EQ.1) THEN
  218.            WRITE(6,*) 'PM EST TRES GRAND : LE CONDITIONNEMNENT EST PEUT
  219.      &                 ETRE MAUVAIS'
  220. c          DO I=1,INDLI.ID(NLS1)
  221. c            DO J = 1,INDLI.ID(NLS1)
  222. c            PM(I,J) = 0.0D0
  223. c            ENDDO
  224. c          ENDDO
  225.           ENDIF
  226.  
  227.  
  228. c          WRITE(6,*) 'NLS1= ',NLS1,'INDLI(NLS1)=',INDLI.ID(NLS1)
  229.          DO I = 1,INDLI.ID(NLS1)
  230.           XSOL(I) = 0.0D0
  231.           DO J = 1,INDLI.ID(NLS1)
  232. c          WRITE(6,*) 'NLS1= ',NLS1,'J=',J,'SCMB', SCMB.MAT(J,NLS1)
  233. c          WRITE(6,*) 'NLS1= ',NLS1,'J=',J,'SCMB', SCMB.MAT(J,NLS1)
  234. c          WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,'PM= ',PM(I,J)
  235.           XSOL(I) = XSOL(I) + (SCMB.MAT(J,NLS1)*PM(I,J))
  236.           ENDDO
  237.          ENDDO
  238.  
  239.          DO J = 1,INDLI.ID(NLS1)
  240.          SCMB.MAT(J,NLS1) = XSOL(J)
  241. c         WRITE(6,*) 'NLS1= ',NLS1,'J=',J,'XSOL',XSOL(J)
  242.          ENDDO
  243.  
  244.           DO IAUX = 1,INDLI.ID(NLS1)
  245.  
  246.            ICON = 0
  247.           DO JAUX = 1,INDLI.ID(NLS1)
  248.            MATR1.MAT2(IAUX,JAUX) = 0.0D0
  249.            VALAUX =  PM(IAUX,JAUX) *
  250.      &              (VAL1.MAT(JAUX,NLS1))
  251.            NTEST = IND.NUME(JAUX,NLS1)
  252.            IF (NTEST.NE.0) THEN
  253. c          WRITE(6,*) 'NLS1= ',NLS1, 'IND=',IND.NUME(JAUX,NLS1)
  254. c          WRITE(6,*) 'NLS1= ',NLS1, 'VAL1=',VAL1.MAT(JAUX,NLS1)
  255. c          WRITE(6,*) 'NLS1= ',NLS1, 'IND=',IND22.NUME(JAUX,NLS1)
  256. c          WRITE(6,*) 'NLS1= ',NLS1, 'VAL2=',VAL2.MAT(JAUX,NLS1)
  257.  
  258. c RECHERCHE DE NTEST
  259.  
  260.            DO IAUX2=1,INDLI.ID(NLS1)
  261.            J1 = INDIC.NU(IAUX,IAUX2)
  262.            J2 = NTEST
  263.            IF (J1.EQ.J2) THEN
  264.            ITEST = IAUX2
  265.            GOTO 533
  266.            ENDIF
  267.             ENDDO
  268.            ICON = ICON +1
  269.            ITEST = ICON
  270.            IF (ITEST.GT.K2) THEN
  271.            WRITE(6,*) 'K2 TROP PETIT'
  272.            CALL ERREUR(5)
  273.            ENDIF
  274.  
  275.  533       CONTINUE
  276.           INDIC.NU(IAUX,ITEST) =  NTEST
  277.           MATR1.MAT2(IAUX,ITEST) = MATR1.MAT2(IAUX,ITEST)
  278.      &    +   VALAUX
  279.            ENDIF
  280.  
  281.          ENDDO
  282. c         ENDDO
  283.  
  284. C MEME CHOSE POUR VAL2
  285. c          DO IAUX = 1,INDLI.ID(NLS1)
  286.  
  287.           DO JAUX = 1,INDLI.ID(NLS1)
  288.            VALAUX =  PM(IAUX,JAUX) *
  289.      &              (VAL2.MAT(JAUX,NLS1))
  290.            NTEST = IND22.NUME(JAUX,NLS1)
  291.  
  292. c RECHERCHE DE NTEST
  293.  
  294.            IF (NTEST.NE.0) THEN
  295.            DO IAUX2 = 1,ICON
  296.            J1 = INDIC.NU(IAUX,IAUX2)
  297.            J2 = NTEST
  298.            IF (J1.EQ.J2) THEN
  299.            ITEST = IAUX2
  300.            GOTO 633
  301.            ENDIF
  302.            ENDDO
  303.            ICON = ICON +1
  304.            ITEST = ICON
  305.            IF (ITEST.GT.K2) THEN
  306.            WRITE(6,*) 'K2 TROP PETIT'
  307.            CALL ERREUR(5)
  308.            ENDIF
  309.  
  310.  633       CONTINUE
  311.           INDIC.NU(IAUX,ITEST) =  NTEST
  312.           MATR1.MAT2(IAUX,ITEST) = MATR1.MAT2(IAUX,ITEST)
  313.      &    +   VALAUX
  314.           ENDIF
  315.  
  316.          ENDDO
  317.          ENDDO
  318.            TAB.ID(NLS1) = ICON
  319. c          DO IAUX = 1,INDLI.ID(NLS1)
  320. cc          DO IAUX2 = 1,TAB.ID(NLS1)
  321. c          WRITE(6,*) 'NLS1= ',NLS1,'IAUX= ',IAUX ,'IAUX2= ',
  322. c     &                IAUX2,'VAUX',MATR1.MAT2(IAUX,IAUX2)
  323. c     &                 ,'IND3= ',INDIC.NU(IAUX,IAUX2)
  324. c          ENDDO
  325. c          ENDDO
  326. c           WRITE(6,*) 'ICON= ',ICON
  327.  
  328.          SEGDES INDIC
  329.          SEGDES MATR1
  330.          SEGSUP MMAT1
  331.        ENDDO
  332.          NMOY = NMOY/(1.D0*NSOMM)
  333. c         WRITE(6,*) 'NMOY1= ',(NMOY)
  334. c        SEGSUP NOEUD2
  335.          SEGSUP VAL1
  336.          SEGSUP VAL2
  337.          SEGSUP IND
  338.          SEGSUP IND22
  339.  
  340.  
  341.  
  342.  9999 CONTINUE
  343.       RETURN
  344.       END
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  
  359.  

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