Télécharger nif.eso

Retour à la liste

Numérotation des lignes :

  1. C NIF SOURCE GOUNAND 06/08/04 21:17:10 5520
  2. SUBROUTINE NIF(LRFVOL,JXCOPG,PNM1,
  3. $ FNPG,DFNPG,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : NIF
  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, NOMINC
  36. C APPELE PAR : KFNREF
  37. C***********************************************************************
  38. C ENTREES : LRFVOL, 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 SELREF
  55. SEGMENT ELREF
  56. CHARACTER*(LNNOM) NOMLRF
  57. CHARACTER*(LNFORM) FORME
  58. CHARACTER*(LNTYPL) TYPEL
  59. CHARACTER*(LNESP) ESPACE
  60. INTEGER DEGRE
  61. REAL*8 XCONOD(NDIMEL,NBNOD)
  62. INTEGER NPQUAF(NBDDL)
  63. INTEGER NUMCMP(NBDDL)
  64. INTEGER QUENOD(NBDDL)
  65. INTEGER ORDDER(NDIMEL,NBDDL)
  66. POINTEUR MBPOLY.POLYNS
  67. ENDSEGMENT
  68. SEGMENT ELREFS
  69. POINTEUR LISEL(0).ELREF
  70. ENDSEGMENT
  71. CENDINCLUDE SELREF
  72. POINTEUR LRFVOL.ELREF
  73. CBEGININCLUDE SPOLYNO
  74. SEGMENT POLYNO
  75. REAL*8 COEMON(NBMON)
  76. INTEGER EXPMON(NDIML,NBMON)
  77. ENDSEGMENT
  78. SEGMENT POLYNS
  79. POINTEUR LIPOLY(NBPOLY).POLYNO
  80. ENDSEGMENT
  81. CENDINCLUDE SPOLYNO
  82. POINTEUR MYBPOL.POLYNS
  83. POINTEUR MYPOLY.POLYNO
  84. CBEGININCLUDE SMMREEL
  85. SEGMENT MMREEL
  86. REAL*8 MAT(JLIG,JCOL)
  87. ENDSEGMENT
  88. CENDINCLUDE SMMREEL
  89. POINTEUR PNM1.MMREEL
  90. -INC SMLENTI
  91. INTEGER JG
  92. POINTEUR ORDER1.MLENTI
  93. -INC SMLREEL
  94. POINTEUR VECTPI.MLREEL
  95. CBEGININCLUDE SMCHAEL
  96. SEGMENT MCHAEL
  97. POINTEUR IMACHE(N1).MELEME
  98. POINTEUR ICHEVA(N1).MCHEVA
  99. ENDSEGMENT
  100. SEGMENT MCHEVA
  101. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  102. ENDSEGMENT
  103. SEGMENT LCHEVA
  104. POINTEUR LISCHE(NBCHE).MCHEVA
  105. ENDSEGMENT
  106. CENDINCLUDE SMCHAEL
  107. POINTEUR JXCOPG.MCHEVA
  108. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  109. POINTEUR FNPG.MCHEVA
  110. POINTEUR DFNPG.MCHEVA
  111. *
  112. INTEGER IMPR,IRET
  113. *
  114. * Fonction Blas (produit scalaire)
  115. *
  116. REAL*8 DDOT
  117. *
  118. INTEGER NBMONO
  119. INTEGER NDIMQR, NPGFAC,NBFN,NBELFV
  120. INTEGER IDIMQR,JDIMQR,IPGFAC,IBFN,IBELFV
  121. *
  122. * Executable statements
  123. *
  124.  
  125. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans nif'
  126. *
  127. * Initialisations
  128. *
  129. * SEGPRT,JXCOPG
  130. * SEGPRT,LRFVOL
  131. * SEGPRT,PNM1
  132. SEGACT PNM1
  133. SEGACT JXCOPG
  134. NDIMQR=JXCOPG.VELCHE(/4)
  135. NPGFAC=JXCOPG.VELCHE(/5)
  136. NBELFV=JXCOPG.VELCHE(/6)
  137. SEGACT LRFVOL
  138. MYBPOL=LRFVOL.MBPOLY
  139. SEGDES LRFVOL
  140. SEGACT MYBPOL
  141. SEGACT MYBPOL.LIPOLY(*)
  142. NBFN=MYBPOL.LIPOLY(/1)
  143. SEGACT PNM1
  144. JG=NDIMQR
  145. SEGINI ORDER1
  146. JG=NBFN
  147. SEGINI VECTPI
  148. *
  149. * On calcule les valeurs des fonctions de forme aux points de Gauss
  150. *
  151. NBLIG=1
  152. NBCOL=NBFN
  153. N2LIG=1
  154. N2COL=1
  155. NBPOI=NPGFAC
  156. NBELM=NBELFV
  157. SEGINI FNPG
  158. DO 1 IDIMQR=1,NDIMQR
  159. ORDER1.LECT(IDIMQR)=0
  160. 1 CONTINUE
  161. DO IBELFV=1,NBELFV
  162. DO 3 IPGFAC=1,NPGFAC
  163. * Calcul de < P (pg) > = < P1(pg) ... Pnbfn(pg) > où pg est le
  164. * IPGFACieme point de Gauss
  165. DO 32 IBFN=1,NBFN
  166. MYPOLY=MYBPOL.LIPOLY(IBFN)
  167. NBMONO=MYPOLY.EXPMON(/2)
  168. CALL VALPOL(NDIMQR,NBMONO,
  169. $ JXCOPG.VELCHE(1,1,1,1,IPGFAC,IBELFV),
  170. $ MYPOLY.COEMON,MYPOLY.EXPMON,
  171. $ ORDER1.LECT,
  172. $ VECTPI.PROG(IBFN),
  173. $ IMPR,IRET)
  174. IF (IRET.NE.0) GOTO 9999
  175. 32 CONTINUE
  176. * On calcule : < N (pg) > = < P (pg) > [Pn]^{-1}
  177. DO 34 IBFN=1,NBFN
  178. FNPG.VELCHE(1,IBFN,1,1,IPGFAC,IBELFV)=
  179. $ DDOT(NBFN,VECTPI.PROG,1,PNM1.MAT(1,IBFN),1)
  180. 34 CONTINUE
  181. 3 CONTINUE
  182. IF (IMPR.GT.3) THEN
  183. WRITE(IOIMP,*) 'Face n° ',IBELFV
  184. WRITE(IOIMP,*) 'Ordre de dérivation / coordonnée de réf. :'
  185. WRITE(IOIMP,4003) (ORDER1.LECT(IDIMQR),IDIMQR=1,NDIMQR)
  186. DO 5 IPGFAC=1,NPGFAC
  187. WRITE(IOIMP,*) 'Noeud de coordonnées :'
  188. WRITE(IOIMP,4004)
  189. $ (JXCOPG.VELCHE(1,1,1,IDIMQR,IPGFAC,IBELFV),IDIMQR=1
  190. $ ,NDIMQR)
  191. WRITE(IOIMP,*) 'FNPG.VELCHE(nb.fns.forme) :'
  192. WRITE(IOIMP,4004)
  193. $ (FNPG.VELCHE(1,IBFN,1,1,IPGFAC,IBELFV),IBFN=1,NBFN
  194. $ )
  195. 5 CONTINUE
  196. ENDIF
  197. ENDDO
  198. SEGDES FNPG
  199. *
  200. * On calcule les valeurs des dérivées premières des fonctions
  201. * de forme aux points de Gauss
  202. *
  203. NBLIG=1
  204. NBCOL=NBFN
  205. N2LIG=1
  206. N2COL=NDIMQR
  207. NBPOI=NPGFAC
  208. NBELM=NBELFV
  209. SEGINI DFNPG
  210. DO 7 IDIMQR=1,NDIMQR
  211. DO 72 JDIMQR=1,NDIMQR
  212. IF (JDIMQR.EQ.IDIMQR) THEN
  213. ORDER1.LECT(JDIMQR)=1
  214. ELSE
  215. ORDER1.LECT(JDIMQR)=0
  216. ENDIF
  217. 72 CONTINUE
  218. DO IBELFV=1,NBELFV
  219. DO 74 IPGFAC=1,NPGFAC
  220. DO 742 IBFN=1,NBFN
  221. * Calcul de < dP/dksi_idimqr (pg) > où pg est le
  222. * IPGFACieme point de Gauss
  223. MYPOLY=MYBPOL.LIPOLY(IBFN)
  224. NBMONO=MYPOLY.EXPMON(/2)
  225. CALL VALPOL(NDIMQR,NBMONO,
  226. $ JXCOPG.VELCHE(1,1,1,1,IPGFAC,IBELFV),
  227. $ MYPOLY.COEMON,MYPOLY.EXPMON,
  228. $ ORDER1.LECT,
  229. $ VECTPI.PROG(IBFN),
  230. $ IMPR,IRET)
  231. IF (IRET.NE.0) GOTO 9999
  232. 742 CONTINUE
  233. * On calcule : < dN/dksi_idimqr (pg) > = < dP/dksi_idimqr (pg) > [Pn]^{-1}
  234. DO 744 IBFN=1,NBFN
  235. DFNPG.VELCHE(1,IBFN,1,IDIMQR,IPGFAC,IBELFV)=
  236. $ DDOT(NBFN,VECTPI.PROG,1,PNM1.MAT(1,IBFN),1)
  237. 744 CONTINUE
  238. 74 CONTINUE
  239. IF (IMPR.GT.3) THEN
  240. WRITE(IOIMP,*)
  241. $ 'Ordre de dérivation / coordonnée de réf. :'
  242. WRITE(IOIMP,4003) (ORDER1.LECT(JDIMQR),JDIMQR=1,NDIMQR)
  243. DO 76 IPGFAC=1,NPGFAC
  244. WRITE(IOIMP,*) 'Face n° ',IBELFV
  245. WRITE(IOIMP,*) 'Noeud de coordonnées :'
  246. WRITE(IOIMP,4004) (JXCOPG.VELCHE(1,1,1,JDIMQR,IPGFAC
  247. $ ,IBELFV),JDIMQR=1,NDIMQR)
  248. WRITE(IOIMP,*) 'DFNPG.VELCHE(nb.fns.forme) :'
  249. WRITE(IOIMP,4004)
  250. $ (DFNPG.VELCHE(1,IBFN,1,IDIMQR,IPGFAC,IBELFV),
  251. $ IBFN=1,NBFN)
  252. 76 CONTINUE
  253. ENDIF
  254. ENDDO
  255. 7 CONTINUE
  256. SEGDES DFNPG
  257. SEGSUP VECTPI
  258. SEGSUP ORDER1
  259. SEGDES PNM1
  260. SEGDES MYBPOL.LIPOLY(*)
  261. SEGDES MYBPOL
  262. SEGDES JXCOPG
  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 nif'
  279. RETURN
  280. *
  281. * End of subroutine NIF
  282. *
  283. END
  284.  
  285.  
  286.  
  287.  

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