Télécharger la plaquette Cast3M


fr en

Télécharger ni.eso

Retour à la liste

Numérotation des lignes : 

ni

  1. C NI        SOURCE    FANDEUR   22/05/02    21:15:26     11359          
  2.       SUBROUTINE NI(MYLRF,MYPG,PNM1,
  3.      $     FNPG,DFNPG,
  4.      $     IMPR,IRET)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM         : NI
  9. C PROJET      : Noyau linéaire NLIN
  10. C DESCRIPTION : Calcul des valeurs des fonctions de forme et des
  11. C               valeurs de leurs dérivées premières aux points de Gauss.
  12. C
  13. C               On utilise la relation (produit) suivante :
  14. C
  15. C               < Ni (point) > = < Pi (point) > [Pn]^{-1}
  16. C
  17. C               avec (cf. CALPN) :
  18. C               [PN] = ( P1(ksi1)  .....   Pn(ksi1))
  19. C                      (   ...     .....     ...   )
  20. C                      ( P1(ksin)  .....   Pn(ksin))
  21. C               n = nb. ddl sur l'élément (NDFN)
  22. C               ksii = coords. du ieme noeud d'approximation
  23. C                      dans l'espace de référence (de dimension
  24. C                      NDIML)
  25. C               Pi   = ieme polynome d'interpolation sur
  26. C                      l'élément de référence.
  27. C               Ni   = ieme fonction nodale d'interpolation sur
  28. C                      l'élément de référence.
  29. C               point= point quelconque sur l'élément de référence
  30. C                      (donc en particulier les points de Gauss)
  31. C LANGAGE     : Esope
  32. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  33. C               mél : gounand@semt2.smts.cea.fr
  34. C***********************************************************************
  35. C APPELES          : VALPOL
  36. C APPELE PAR       : KFNREF
  37. C***********************************************************************
  38. C ENTREES            : MYLRF, MYPG, PNM1
  39. C ENTREES/SORTIES    : -
  40. C SORTIES            : FNPG, DFNPG
  41. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  42. C***********************************************************************
  43. C VERSION    : v1, 16/09/99, version initiale
  44. C HISTORIQUE : v1, 16/09/99, création
  45. C HISTORIQUE : v2, 10/05/00, modif. du segment ELREF
  46. C HISTORIQUE :
  47. C HISTORIQUE :
  48. C***********************************************************************
  49. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  50. C en cas de modification de ce sous-programme afin de faciliter
  51. C la maintenance !
  52. C***********************************************************************
  53.  
  54. -INC PPARAM
  55. -INC CCOPTIO
  56. -INC TNLIN      
  57. *-INC SPOGAU
  58.       POINTEUR MYPG.POGAU
  59. *-INC SELREF
  60.       POINTEUR MYLRF.ELREF
  61. *-INC SPOLYNO
  62.       POINTEUR MYBPOL.POLYNS
  63.       POINTEUR MYPOLY.POLYNO
  64. -INC TMXMAT
  65.       POINTEUR PNM1.MXMAT
  66. -INC SMLENTI
  67.       POINTEUR ORDER1.MLENTI
  68. -INC SMLREEL
  69.       POINTEUR VECTPI.MLREEL
  70. *-INC SMCHAEL
  71.       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  72.       POINTEUR FNPG.MCHEVA
  73.       POINTEUR DFNPG.MCHEVA
  74. *
  75.       INTEGER IMPR,IRET
  76. *
  77. * Fonction Blas (produit scalaire)
  78. *
  79.       REAL*8   DDOT
  80.       EXTERNAL DDOT
  81. *
  82.       INTEGER NBMONO
  83.       INTEGER NDIML,NDPG,NBFN
  84.       INTEGER INDIML,JNDIML,INDPG,INBFN
  85. *
  86. * Executable statements
  87. *
  88.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ni'
  89. *
  90. * Initialisations
  91. *
  92.       SEGACT MYPG
  93.       NDIML=MYPG.XCOPG(/1)
  94.       NDPG=MYPG.XCOPG(/2)
  95.       SEGACT MYLRF
  96.       MYBPOL=MYLRF.MBPOLY
  97.       SEGDES MYLRF
  98.       SEGACT MYBPOL
  99.       SEGACT MYBPOL.LIPOLY(*)
  100.       NBFN=MYBPOL.LIPOLY(/1)
  101.       SEGACT PNM1
  102.       JG=NDIML
  103.       SEGINI ORDER1
  104.       JG=NBFN
  105.       SEGINI VECTPI
  106. *
  107. * On calcule les valeurs des fonctions de forme aux points de Gauss
  108. *
  109.       NBLIG=1
  110.       NBCOL=NBFN
  111.       N2LIG=1
  112.       N2COL=1
  113.       NBPOI=NDPG
  114.       NBELM=1
  115.       SEGINI FNPG
  116.       DO 1 INDIML=1,NDIML
  117.          ORDER1.LECT(INDIML)=0
  118.  1    CONTINUE
  119.       DO 3 INDPG=1,NDPG
  120. * Calcul de < P (pg) > = < P1(pg) ... Pnbfn(pg) > où pg est le
  121. * INDPGieme point de Gauss
  122.          DO 32 INBFN=1,NBFN
  123.             MYPOLY=MYBPOL.LIPOLY(INBFN)
  124.             NBMONO=MYPOLY.EXPMON(/2)
  125.             CALL VALPOL(NDIML,NBMONO,
  126.      $           MYPG.XCOPG(1,INDPG),
  127.      $           MYPOLY.COEMON,MYPOLY.EXPMON,
  128.      $           ORDER1.LECT,
  129.      $           VECTPI.PROG(INBFN),
  130.      $           IMPR,IRET)
  131.             IF (IRET.NE.0) GOTO 9999
  132.  32      CONTINUE
  133. * On calcule : < N (pg) > = < P (pg) > [Pn]^{-1}
  134.          DO 34 INBFN=1,NBFN
  135.             FNPG.WELCHE(1,INBFN,1,1,INDPG,1)=
  136.      $           DDOT(NBFN,VECTPI.PROG,1,PNM1.XMAT(1,INBFN),1)
  137.  34      CONTINUE
  138.  3    CONTINUE
  139.       IF (IMPR.GT.3) THEN
  140.          WRITE(IOIMP,*) 'Ordre de dérivation / coordonnée de réf. :'
  141.          WRITE(IOIMP,4003) (ORDER1.LECT(INDIML),INDIML=1,NDIML)
  142.          DO 5 INDPG=1,NDPG
  143.             WRITE(IOIMP,*) 'Noeud de coordonnées :'
  144.             WRITE(IOIMP,4004) (MYPG.XCOPG(INDIML,INDPG),
  145.      $           INDIML=1,NDIML)
  146.             WRITE(IOIMP,*) 'FNPG.WELCHE(nb.fns.forme) :'
  147.             WRITE(IOIMP,4004) (FNPG.WELCHE(1,INBFN,1,1,INDPG,1),
  148.      $           INBFN=1,NBFN)
  149.  5       CONTINUE
  150.       ENDIF
  151.       SEGDES FNPG
  152. *
  153. * On calcule les valeurs des dérivées premières des fonctions
  154. * de forme aux points de Gauss
  155. *
  156.       NBLIG=1
  157.       NBCOL=NBFN
  158.       N2LIG=1
  159.       N2COL=NDIML
  160.       NBPOI=NDPG
  161.       NBELM=1
  162.       SEGINI DFNPG
  163.       IF (IRET.NE.0) GOTO 9999
  164.       DO 7 INDIML=1,NDIML
  165.          DO 72 JNDIML=1,NDIML
  166.             IF (JNDIML.EQ.INDIML) THEN
  167.                ORDER1.LECT(JNDIML)=1
  168.             ELSE
  169.                ORDER1.LECT(JNDIML)=0
  170.             ENDIF
  171.  72      CONTINUE
  172.          DO 74 INDPG=1,NDPG
  173.             DO 742 INBFN=1,NBFN
  174. * Calcul de < dP/dksi_indiml (pg) > où pg est le
  175. * INDPGieme point de Gauss
  176.                MYPOLY=MYBPOL.LIPOLY(INBFN)
  177.                NBMONO=MYPOLY.EXPMON(/2)
  178.                CALL VALPOL(NDIML,NBMONO,
  179.      $              MYPG.XCOPG(1,INDPG),
  180.      $              MYPOLY.COEMON,MYPOLY.EXPMON,
  181.      $              ORDER1.LECT,
  182.      $              VECTPI.PROG(INBFN),
  183.      $              IMPR,IRET)
  184.                IF (IRET.NE.0) GOTO 9999
  185.  742        CONTINUE
  186. * On calcule : < dN/dksi_indiml (pg) > = < dP/dksi_indiml (pg) > [Pn]^{-1}
  187.             DO 744 INBFN=1,NBFN
  188.                DFNPG.WELCHE(1,INBFN,1,INDIML,INDPG,1)=
  189.      $              DDOT(NBFN,VECTPI.PROG,1,PNM1.XMAT(1,INBFN),1)
  190.  744        CONTINUE
  191.  74      CONTINUE
  192.          IF (IMPR.GT.3) THEN
  193.             WRITE(IOIMP,*)
  194.      $           'Ordre de dérivation / coordonnée de réf. :'
  195.             WRITE(IOIMP,4003) (ORDER1.LECT(JNDIML),JNDIML=1,NDIML)
  196.             DO 76 INDPG=1,NDPG
  197.                WRITE(IOIMP,*) 'Noeud de coordonnées :'
  198.                WRITE(IOIMP,4004) (MYPG.XCOPG(JNDIML,INDPG),
  199.      $              JNDIML=1,NDIML)
  200.                WRITE(IOIMP,*) 'DFNPG.WELCHE(nb.fns.forme) :'
  201.                WRITE(IOIMP,4004)
  202.      $              (DFNPG.WELCHE(1,INBFN,1,INDIML,INDPG,1),
  203.      $              INBFN=1,NBFN)
  204.  76         CONTINUE
  205.          ENDIF
  206.  7    CONTINUE
  207.       SEGDES DFNPG
  208.       SEGSUP VECTPI
  209.       SEGSUP ORDER1
  210.       SEGDES PNM1
  211.       SEGDES MYBPOL.LIPOLY(*)
  212.       SEGDES MYBPOL
  213.       SEGDES MYPG
  214. *
  215. * Normal termination
  216. *
  217.       IRET=0
  218.       RETURN
  219. *
  220. * Format handling
  221. *
  222.  4003 FORMAT (2X,6(1X,I3))
  223.  4004 FORMAT (2X,6(1X,1PE13.5))
  224. *
  225. * Error handling
  226. *
  227.  9999 CONTINUE
  228.       IRET=1
  229.       WRITE(IOIMP,*) 'An error was detected in subroutine ni'
  230.       RETURN
  231. *
  232. * End of subroutine NI
  233. *
  234.       END
  235.  
  236.  
  237.  

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