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

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