Télécharger ni.eso

Retour à la liste

Numérotation des lignes :

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

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