Télécharger la plaquette Cast3M


fr en

Télécharger norv5.eso

Retour à la liste

Numérotation des lignes : 

norv5

  1. C NORV5     SOURCE    CB215821  20/11/25    13:35:18     10792          
  2.       SUBROUTINE NORV5(NFAC,MPOGRA,ICOEFF,MELVA1,MELEFL,
  3.      &                 MLECEN,MLEFA,MPOCHP,MLENCL,MPOVCL,
  4.      &                 MLENNE,MPOVNE,MLENMI,MPOVMI,
  5.      &                 LOGBOR,LOGCCL,LOGCOE)
  6. C
  7. C************************************************************************
  8. C
  9. C PROJET            :  CASTEM 2000
  10. C
  11. C NOM               :  NORV1
  12. C
  13. C DESCRIPTION       : Appelle par NORV
  14. C
  15. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  16. C
  17. C AUTEUR            :  C. LE POTIER, DM2S/SFME/MTMS
  18. C
  19. C************************************************************************
  20. C
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT REAL*8(A-H,O-Z)
  23.  
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC SMLENTI
  28. -INC SMELEME
  29. -INC SMCHPOI
  30. -INC SMCOORD
  31. -INC SMLREEL
  32. -INC SMCHAML
  33.  
  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.      &         MLEFA2.MLENTI
  42.       INTEGER NBNN,NBREF
  43.  
  44.  
  45. C**** Variable de SMLENTI, SMCHPOI
  46. C
  47.       INTEGER JG, N, NC,  NSOUPO, NAT, NBSOUS, NBNO,NBELEM
  48. C
  49. C**** Les includes
  50. C
  51.       INTEGER I1,ICOMP,ICOMGR,IGEOM
  52.      &     ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM
  53.      &     ,ISURF,IMAIL,ICHPO,ICHCL,ICHNE,ICHGRA,ICOEFF
  54.      &     ,NTOT,NSOMM,NCOMP,NFAC,NCEN
  55.      &     ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2
  56.      &     ,NLS1,NLS2,NLFCL
  57.      &     ,ISOUS,IELEM,INOEUD,ICELL
  58.       INTEGER ICEN2
  59.       REAL*8 SCNX,SCNY,SCNZ,SURF,VOL,VAL,VALX,VALY,XG,XD,XF,XS1,XS2
  60.      &     ,YG,YD,YF,YS1,YS2,PSCA,XNORM,VECX,VECY,PSCAGX,PSCAGY,
  61.      &     PSCADX,PSCADY,K11G,K22G,K21G,K11D,K22D,K21D,VXG1,VXG2,
  62.      &     VXAU,VYAU,VXD1,VXD2,VYG1,VYG2,TRG1,TRG2,
  63.      &     TRD1,TRD2,TRG,TRD
  64.       REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2,
  65.      & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,SCN1Z,VX,VY,COEF1X,COEF2X,
  66.      & COEF1Y,COEF2Y,CX,CY,ANCX,ANCY,DIFFX,DIFFY,XLONGG,XLONGD
  67.      &  VALD,VALG,COEF,GX,GY,XMINK11,XMAXK11,XMINK22,XMAXK22
  68.      &  QIMPX,QIMPY,QIMPZ
  69.  
  70.       REAL*8 EPS
  71.       INTEGER ICRIT
  72.       CHARACTER*8 TYPE
  73.       INTEGER LOGBOR,LOGCOE,LOGCCL
  74. C
  75.          MCHELM = ICOEFF
  76.          SEGACT MCHELM
  77.          NBSOUS=MCHELM.IMACHE(/1)
  78.  
  79.  
  80.          IF (LOGBOR.EQ.0) THEN
  81.          DO ISOUS=1,NBSOUS,1
  82.          MELEME=MCHELM.IMACHE(ISOUS)
  83.          MCHAM1=MCHELM.ICHAML(ISOUS)
  84.          SEGACT MELEME
  85.          SEGACT MCHAM1
  86.          MELVA1=MCHAM1.IELVAL(1)
  87.          SEGACT MELVA1
  88. C
  89.          NBNN=MELEME.NUM(/1)
  90.          NFAC=MELEME.NUM(/2)
  91. C
  92.             DO IELEM = 1,NFAC
  93.             NGF=MELEME.NUM(1,IELEM)
  94.             NLCF=MLEFA.LECT(NGF)
  95.             MPOGRA.VPOCHA(NLCF,1) = 0.D0
  96. C            NGCF=MELEFL.NUM(2,NLCF)
  97.              DO IVOI=2,NBNN
  98.              ICENT =  MELEME.NUM(IVOI,IELEM)
  99.              ICEN = MLECEN.LECT(ICENT)
  100.              VAL = 0.0D0
  101.              IF (ICEN.EQ.0) THEN
  102. c             WRITE(6,*) 'INTERIEUR'
  103. c             VAL = MPOCHP.VPOCHA(ICEN,1)
  104. c             ELSE
  105.              ICENL = MLENCL.LECT(ICENT)
  106.              IF (ICENL.GT.0) THEN
  107. c              WRITE(6,*) 'DIRICHLET'
  108.              VAL = MPOVCL.VPOCHA(ICENL,1)
  109. c             WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL,'VAL= ',VAL
  110.              ELSE
  111. C CONDITIONS DE FLUX
  112. c              WRITE(6,*) 'FLUX'
  113.               ICENNE = MLENNE.LECT(ICENT)
  114.               IF (ICENNE.GT.0) THEN
  115.               QIMPX = MPOVNE.VPOCHA(ICENNE,1)
  116.               VAL = (QIMPX)
  117.               ELSE
  118.               ICENMI = MLENMI.LECT(ICENT)
  119.               IF (ICENMI .EQ.0) THEN
  120.               WRITE(IOIMP,*)
  121.      &           'PROBLEME DANS LES CONDITIONS AUX LIMITES'
  122.  
  123.               ELSE
  124.               QIMPX = MPOVMI.VPOCHA(ICENMI,3)
  125.               VAL = (QIMPX)
  126.  
  127.               ENDIF
  128.              ENDIF
  129.              ENDIF
  130.  
  131.  
  132. c            WRITE(6,*) 'NLCF= ',NLCF,'VAL= ',VAL
  133. c            WRITE(6,*) 'IVOI= ',IVOI,'MELEME= ', MELEME.NUM(IVOI,NLCF),
  134. c     &                 'COEF1 = ',COEF1
  135.  
  136.              COEF1 =  MELVA1.VELCHE(IVOI,IELEM)
  137.              MPOGRA.VPOCHA(NLCF,1)= MPOGRA.VPOCHA(NLCF,1) +
  138.      &       (COEF1 * VAL)
  139.              ENDIF
  140.              ENDDO
  141. c            WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',NGCF
  142. c            WRITE(6,*) 'MPOGRA1= ', MPOGRA.VPOCHA(NLCF,1)
  143. c            WRITE(6,*) 'MPOGRA2= ', MPOGRA.VPOCHA(NLCF,2)
  144. c            WRITE(6,*) 'MPOGRA3= ', MPOGRA.VPOCHA(NLCF,3)
  145. c             ENDIF
  146.          ENDDO
  147.          ENDDO
  148.  
  149. C ON CONNAIT LES COEFFICIENTS : ON EN DEDUIT LE GRADIENT
  150.  
  151.  
  152.          ELSEIF (LOGCOE.EQ.0) THEN
  153.          DO ISOUS=1,NBSOUS,1
  154.          MELEME=MCHELM.IMACHE(ISOUS)
  155.          MCHAM1=MCHELM.ICHAML(ISOUS)
  156.          SEGACT MELEME
  157.          SEGACT MCHAM1
  158.          MELVA1=MCHAM1.IELVAL(1)
  159.          SEGACT MELVA1
  160. C
  161.          NBNN=MELEME.NUM(/1)
  162.          NFAC=MELEME.NUM(/2)
  163. C
  164.             DO IELEM = 1,NFAC
  165.             NGF=MELEME.NUM(1,IELEM)
  166.             NLCF=MLEFA.LECT(NGF)
  167.             MPOGRA.VPOCHA(NLCF,1) = 0.D0
  168. C            NGCF=MELEFL.NUM(2,NLCF)
  169.             NGCG=MELEFL.NUM(1,NLCF)
  170.             NGCD=MELEFL.NUM(3,NLCF)
  171. c         IF (NGCG.EQ.NGCD) THEN
  172.              DO IVOI=2,NBNN
  173.              ICENT =  MELEME.NUM(IVOI,IELEM)
  174. c             WRITE(6,*) 'ISOUS= ',ISOUS
  175. c             WRITE(6,*) 'IELEM= ',IELEM,'IVOI= ',IVOI
  176. c             WRITE(6,*) 'ICENT= ',ICENT
  177.              ICEN = MLECEN.LECT(ICENT)
  178.              VAL = 0.0D0
  179.              IF (ICEN.NE.0) THEN
  180. c             WRITE(6,*) 'INTERIEUR'
  181.              VAL = MPOCHP.VPOCHA(ICEN,1)
  182.              ELSE
  183.              ICENL = MLENCL.LECT(ICENT)
  184. c             WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL
  185.              IF (ICENL.GT.0) THEN
  186. c              WRITE(6,*) 'DIRICHLET'
  187.              VAL = MPOVCL.VPOCHA(ICENL,1)
  188. c             WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL,'VAL= ',VAL
  189.              ELSE
  190. C CONDITIONS DE FLUX
  191. c              WRITE(6,*) 'FLUX'
  192.               ICENNE = MLENNE.LECT(ICENT)
  193.               IF (ICENNE.GT.0) THEN
  194. c              WRITE(6,*) 'NLCF= ',NLCF,'SCN1X= ',SCN1X
  195. c              WRITE(6,*) 'NLCF= ',NLCF,'SCN1Y= ',SCN1Y
  196.               QIMPX = MPOVNE.VPOCHA(ICENNE,1)
  197. c              WRITE(6,*) 'NLCF= ',NLCF,'QIMPX= ',QIMPX
  198. c              WRITE(6,*) 'NLCF= ',NLCF,'QIMPY= ',QIMPY
  199.               VAL = (QIMPX)
  200. c              WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENT,'VAL= ',VAL
  201.               ELSE
  202.               ICENMI = MLENMI.LECT(ICENT)
  203.               IF (ICENMI .EQ.0) THEN
  204.               WRITE(IOIMP,*)
  205.      &           'PROBLEME DANS LES CONDITIONS AUX LIMITES'
  206.  
  207.               ELSE
  208.               QIMPX = MPOVMI.VPOCHA(ICENMI,3)
  209.               VAL = (QIMPX)
  210.  
  211.               ENDIF
  212.              ENDIF
  213.              ENDIF
  214.  
  215.              ENDIF
  216.  
  217. c            WRITE(6,*) 'NLCF= ',NLCF,'VAL= ',VAL
  218. c            WRITE(6,*) 'IVOI= ',IVOI,'MELEME= ', MELEME.NUM(IVOI,NLCF),
  219. c     &                 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ',COEF3
  220.  
  221.              COEF1 =  MELVA1.VELCHE(IVOI,IELEM)
  222.              MPOGRA.VPOCHA(NLCF,1)= MPOGRA.VPOCHA(NLCF,1) +
  223.      &       (COEF1 * VAL)
  224.              ENDDO
  225. C             ENDIF
  226. c            WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',NGCF
  227. c            WRITE(6,*) 'MPOGRA1= ', MPOGRA.VPOCHA(NLCF,1)
  228. c            WRITE(6,*) 'MPOGRA2= ', MPOGRA.VPOCHA(NLCF,2)
  229. c            WRITE(6,*) 'MPOGRA3= ', MPOGRA.VPOCHA(NLCF,3)
  230.          ENDDO
  231.          ENDDO
  232.          ELSEIF (LOGCCL.EQ.0) THEN
  233.  
  234.  
  235.          DO ISOUS=1,NBSOUS,1
  236.          MELEME=MCHELM.IMACHE(ISOUS)
  237.          MCHAM1=MCHELM.ICHAML(ISOUS)
  238.          SEGACT MELEME
  239.          SEGACT MCHAM1
  240.          MELVA1=MCHAM1.IELVAL(1)
  241.          SEGACT MELVA1
  242. C
  243.          NBNN=MELEME.NUM(/1)
  244.          NFAC=MELEME.NUM(/2)
  245. C
  246.          DO IELEM = 1,NFAC
  247.             NGF=MELEME.NUM(1,IELEM)
  248.             NLCF=MLEFA.LECT(NGF)
  249.             MPOGRA.VPOCHA(NLCF,1) = 0.D0
  250. C            NGCF=MELEFL.NUM(2,NLCF)
  251.             NGCG=MELEFL.NUM(1,NLCF)
  252.             NGCD=MELEFL.NUM(3,NLCF)
  253.          IF (NGCG.EQ.NGCD) THEN
  254.              DO IVOI=2,MELEME.NUM(/1)
  255.              ICENT =  MELEME.NUM(IVOI,IELEM)
  256.              ICEN = MLECEN.LECT(ICENT)
  257.              VAL = 0.0D0
  258.              IF (ICEN.NE.0) THEN
  259. c             WRITE(6,*) 'INTERIEUR'
  260.              VAL = MPOCHP.VPOCHA(ICEN,1)
  261.              ELSE
  262.              ICENL = MLENCL.LECT(ICENT)
  263. c             WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL
  264.              IF (ICENL.GT.0) THEN
  265. c              WRITE(6,*) 'DIRICHLET'
  266.              VAL = MPOVCL.VPOCHA(ICENL,1)
  267. c             WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENL,'VAL= ',VAL
  268.              ELSE
  269. C CONDITIONS DE FLUX
  270. c              WRITE(6,*) 'FLUX'
  271.               ICENNE = MLENNE.LECT(ICENT)
  272.               IF (ICENNE.GT.0) THEN
  273. c              WRITE(6,*) 'NLCF= ',NLCF,'SCN1X= ',SCN1X
  274. c              WRITE(6,*) 'NLCF= ',NLCF,'SCN1Y= ',SCN1Y
  275.               QIMPX = MPOVNE.VPOCHA(ICENNE,1)
  276. c              WRITE(6,*) 'NLCF= ',NLCF,'QIMPX= ',QIMPX
  277. c              WRITE(6,*) 'NLCF= ',NLCF,'QIMPY= ',QIMPY
  278.               VAL = (QIMPX)
  279. c              WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',ICENT,'VAL= ',VAL
  280.               ELSE
  281.               ICENMI = MLENMI.LECT(ICENT)
  282.               IF (ICENMI .EQ.0) THEN
  283.               WRITE(IOIMP,*)
  284.      &           'PROBLEME DANS LES CONDITIONS AUX LIMITES'
  285.  
  286.               ELSE
  287.               QIMPX = MPOVMI.VPOCHA(ICENMI,3)
  288.               VAL = (QIMPX)
  289.  
  290.               ENDIF
  291.              ENDIF
  292.              ENDIF
  293.  
  294.              ENDIF
  295.  
  296. c            WRITE(6,*) 'NLCF= ',NLCF,'VAL= ',VAL
  297. c            WRITE(6,*) 'IVOI= ',IVOI,'MELEME= ', MELEME.NUM(IVOI,NLCF),
  298. c     &                 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ',COEF3
  299.  
  300.              COEF1 =  MELVA1.VELCHE(IVOI,IELEM)
  301.              MPOGRA.VPOCHA(NLCF,1)= MPOGRA.VPOCHA(NLCF,1) +
  302.      &       (COEF1 * VAL)
  303.              ENDDO
  304.              ENDIF
  305. c            WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',NGCF
  306. c            WRITE(6,*) 'MPOGRA1= ', MPOGRA.VPOCHA(NLCF,1)
  307. c            WRITE(6,*) 'MPOGRA2= ', MPOGRA.VPOCHA(NLCF,2)
  308. c            WRITE(6,*) 'MPOGRA3= ', MPOGRA.VPOCHA(NLCF,3)
  309.          ENDDO
  310.          ENDDO
  311.          ENDIF
  312. C         SEGDES MCHAM1
  313. C         SEGDES MELVA1
  314. C         SEGDES MELEME
  315. C         SEGDES MCHELM
  316. C         SEGDES MPOGRA
  317.       END
  318.  
  319.  
  320.  
  321.  

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