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