Télécharger ni.eso

Retour à la liste

Numérotation des lignes :

  1. C NI SOURCE GOUNAND 05/12/21 21:34:26 5281
  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. -INC CCOPTIO
  54. CBEGININCLUDE SPOGAU
  55. SEGMENT POGAU
  56. CHARACTER*(LNNPG) NOMPG
  57. CHARACTER*(LNTPG) TYPMPG
  58. CHARACTER*(LNFPG) FORLPG
  59. INTEGER NORDPG
  60. REAL*8 XCOPG(NDLPG,NBPG)
  61. REAL*8 XPOPG(NBPG)
  62. ENDSEGMENT
  63. SEGMENT POGAUS
  64. POINTEUR LISPG(0).POGAU
  65. ENDSEGMENT
  66. CENDINCLUDE SPOGAU
  67. POINTEUR MYPG.POGAU
  68. CBEGININCLUDE SELREF
  69. SEGMENT ELREF
  70. CHARACTER*(LNNOM) NOMLRF
  71. CHARACTER*(LNFORM) FORME
  72. CHARACTER*(LNTYPL) TYPEL
  73. CHARACTER*(LNESP) ESPACE
  74. INTEGER DEGRE
  75. REAL*8 XCONOD(NDIMEL,NBNOD)
  76. INTEGER NPQUAF(NBDDL)
  77. INTEGER NUMCMP(NBDDL)
  78. INTEGER QUENOD(NBDDL)
  79. INTEGER ORDDER(NDIMEL,NBDDL)
  80. POINTEUR MBPOLY.POLYNS
  81. ENDSEGMENT
  82. SEGMENT ELREFS
  83. POINTEUR LISEL(0).ELREF
  84. ENDSEGMENT
  85. CENDINCLUDE SELREF
  86. POINTEUR MYLRF.ELREF
  87. CBEGININCLUDE SPOLYNO
  88. SEGMENT POLYNO
  89. REAL*8 COEMON(NBMON)
  90. INTEGER EXPMON(NDIML,NBMON)
  91. ENDSEGMENT
  92. SEGMENT POLYNS
  93. POINTEUR LIPOLY(NBPOLY).POLYNO
  94. ENDSEGMENT
  95. CENDINCLUDE SPOLYNO
  96. POINTEUR MYBPOL.POLYNS
  97. POINTEUR MYPOLY.POLYNO
  98. CBEGININCLUDE SMMREEL
  99. SEGMENT MMREEL
  100. REAL*8 MAT(JLIG,JCOL)
  101. ENDSEGMENT
  102. CENDINCLUDE SMMREEL
  103. POINTEUR PNM1.MMREEL
  104. -INC SMLENTI
  105. INTEGER JG
  106. POINTEUR ORDER1.MLENTI
  107. -INC SMLREEL
  108. POINTEUR VECTPI.MLREEL
  109. CBEGININCLUDE SMCHAEL
  110. SEGMENT MCHAEL
  111. POINTEUR IMACHE(N1).MELEME
  112. POINTEUR ICHEVA(N1).MCHEVA
  113. ENDSEGMENT
  114. SEGMENT MCHEVA
  115. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  116. ENDSEGMENT
  117. SEGMENT LCHEVA
  118. POINTEUR LISCHE(NBCHE).MCHEVA
  119. ENDSEGMENT
  120. CENDINCLUDE SMCHAEL
  121. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  122. POINTEUR FNPG.MCHEVA
  123. POINTEUR DFNPG.MCHEVA
  124. *
  125. INTEGER IMPR,IRET
  126. *
  127. * Fonction Blas (produit scalaire)
  128. *
  129. REAL*8 DDOT
  130. *
  131. INTEGER NBMONO
  132. INTEGER NDIML,NDPG,NBFN
  133. INTEGER INDIML,JNDIML,INDPG,INBFN
  134. *
  135. * Executable statements
  136. *
  137. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ni'
  138. *
  139. * Initialisations
  140. *
  141. SEGACT MYPG
  142. NDIML=MYPG.XCOPG(/1)
  143. NDPG=MYPG.XCOPG(/2)
  144. SEGACT MYLRF
  145. MYBPOL=MYLRF.MBPOLY
  146. SEGDES MYLRF
  147. SEGACT MYBPOL
  148. SEGACT MYBPOL.LIPOLY(*)
  149. NBFN=MYBPOL.LIPOLY(/1)
  150. SEGACT PNM1
  151. JG=NDIML
  152. SEGINI ORDER1
  153. JG=NBFN
  154. SEGINI VECTPI
  155. *
  156. * On calcule les valeurs des fonctions de forme aux points de Gauss
  157. *
  158. NBLIG=1
  159. NBCOL=NBFN
  160. N2LIG=1
  161. N2COL=1
  162. NBPOI=NDPG
  163. NBELM=1
  164. SEGINI FNPG
  165. DO 1 INDIML=1,NDIML
  166. ORDER1.LECT(INDIML)=0
  167. 1 CONTINUE
  168. DO 3 INDPG=1,NDPG
  169. * Calcul de < P (pg) > = < P1(pg) ... Pnbfn(pg) > où pg est le
  170. * INDPGieme point de Gauss
  171. DO 32 INBFN=1,NBFN
  172. MYPOLY=MYBPOL.LIPOLY(INBFN)
  173. NBMONO=MYPOLY.EXPMON(/2)
  174. CALL VALPOL(NDIML,NBMONO,
  175. $ MYPG.XCOPG(1,INDPG),
  176. $ MYPOLY.COEMON,MYPOLY.EXPMON,
  177. $ ORDER1.LECT,
  178. $ VECTPI.PROG(INBFN),
  179. $ IMPR,IRET)
  180. IF (IRET.NE.0) GOTO 9999
  181. 32 CONTINUE
  182. * On calcule : < N (pg) > = < P (pg) > [Pn]^{-1}
  183. DO 34 INBFN=1,NBFN
  184. FNPG.VELCHE(1,INBFN,1,1,INDPG,1)=
  185. $ DDOT(NBFN,VECTPI.PROG,1,PNM1.MAT(1,INBFN),1)
  186. 34 CONTINUE
  187. 3 CONTINUE
  188. IF (IMPR.GT.3) THEN
  189. WRITE(IOIMP,*) 'Ordre de dérivation / coordonnée de réf. :'
  190. WRITE(IOIMP,4003) (ORDER1.LECT(INDIML),INDIML=1,NDIML)
  191. DO 5 INDPG=1,NDPG
  192. WRITE(IOIMP,*) 'Noeud de coordonnées :'
  193. WRITE(IOIMP,4004) (MYPG.XCOPG(INDIML,INDPG),
  194. $ INDIML=1,NDIML)
  195. WRITE(IOIMP,*) 'FNPG.VELCHE(nb.fns.forme) :'
  196. WRITE(IOIMP,4004) (FNPG.VELCHE(1,INBFN,1,1,INDPG,1),
  197. $ INBFN=1,NBFN)
  198. 5 CONTINUE
  199. ENDIF
  200. SEGDES FNPG
  201. *
  202. * On calcule les valeurs des dérivées premières des fonctions
  203. * de forme aux points de Gauss
  204. *
  205. NBLIG=1
  206. NBCOL=NBFN
  207. N2LIG=1
  208. N2COL=NDIML
  209. NBPOI=NDPG
  210. NBELM=1
  211. SEGINI DFNPG
  212. IF (IRET.NE.0) GOTO 9999
  213. DO 7 INDIML=1,NDIML
  214. DO 72 JNDIML=1,NDIML
  215. IF (JNDIML.EQ.INDIML) THEN
  216. ORDER1.LECT(JNDIML)=1
  217. ELSE
  218. ORDER1.LECT(JNDIML)=0
  219. ENDIF
  220. 72 CONTINUE
  221. DO 74 INDPG=1,NDPG
  222. DO 742 INBFN=1,NBFN
  223. * Calcul de < dP/dksi_indiml (pg) > où pg est le
  224. * INDPGieme point de Gauss
  225. MYPOLY=MYBPOL.LIPOLY(INBFN)
  226. NBMONO=MYPOLY.EXPMON(/2)
  227. CALL VALPOL(NDIML,NBMONO,
  228. $ MYPG.XCOPG(1,INDPG),
  229. $ MYPOLY.COEMON,MYPOLY.EXPMON,
  230. $ ORDER1.LECT,
  231. $ VECTPI.PROG(INBFN),
  232. $ IMPR,IRET)
  233. IF (IRET.NE.0) GOTO 9999
  234. 742 CONTINUE
  235. * On calcule : < dN/dksi_indiml (pg) > = < dP/dksi_indiml (pg) > [Pn]^{-1}
  236. DO 744 INBFN=1,NBFN
  237. DFNPG.VELCHE(1,INBFN,1,INDIML,INDPG,1)=
  238. $ DDOT(NBFN,VECTPI.PROG,1,PNM1.MAT(1,INBFN),1)
  239. 744 CONTINUE
  240. 74 CONTINUE
  241. IF (IMPR.GT.3) THEN
  242. WRITE(IOIMP,*)
  243. $ 'Ordre de dérivation / coordonnée de réf. :'
  244. WRITE(IOIMP,4003) (ORDER1.LECT(JNDIML),JNDIML=1,NDIML)
  245. DO 76 INDPG=1,NDPG
  246. WRITE(IOIMP,*) 'Noeud de coordonnées :'
  247. WRITE(IOIMP,4004) (MYPG.XCOPG(JNDIML,INDPG),
  248. $ JNDIML=1,NDIML)
  249. WRITE(IOIMP,*) 'DFNPG.VELCHE(nb.fns.forme) :'
  250. WRITE(IOIMP,4004)
  251. $ (DFNPG.VELCHE(1,INBFN,1,INDIML,INDPG,1),
  252. $ INBFN=1,NBFN)
  253. 76 CONTINUE
  254. ENDIF
  255. 7 CONTINUE
  256. SEGDES DFNPG
  257. SEGSUP VECTPI
  258. SEGSUP ORDER1
  259. SEGDES PNM1
  260. SEGDES MYBPOL.LIPOLY(*)
  261. SEGDES MYBPOL
  262. SEGDES MYPG
  263. *
  264. * Normal termination
  265. *
  266. IRET=0
  267. RETURN
  268. *
  269. * Format handling
  270. *
  271. 4003 FORMAT (2X,6(1X,I3))
  272. 4004 FORMAT (2X,6(1X,1PE13.5))
  273. *
  274. * Error handling
  275. *
  276. 9999 CONTINUE
  277. IRET=1
  278. WRITE(IOIMP,*) 'An error was detected in subroutine ni'
  279. RETURN
  280. *
  281. * End of subroutine NI
  282. *
  283. END
  284.  
  285.  
  286.  
  287.  
  288.  

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