Télécharger calpn.eso

Retour à la liste

Numérotation des lignes :

  1. C CALPN SOURCE GOUNAND 05/12/21 21:15:33 5281
  2. SUBROUTINE CALPN(MYLRF,
  3. $ PN,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : CALPN
  9. C PROJET : Noyau linéaire NLIN
  10. C DESCRIPTION : Calcul de la matrice nodale [PN].
  11. C Si {Un} sont les degrés de liberté nodaux
  12. C sur l'élément de référence et
  13. C {a} les coefficients dans la base polynômiale
  14. C alors {Un} = [PN] {a}.
  15. C Explicitement :
  16. C [PN] = ( P1(ksi1) ..... Pn(ksi1))
  17. C ( ... ..... ... )
  18. C ( P1(ksin) ..... Pn(ksin))
  19. C n = nb. ddl sur l'élément (NDFN)
  20. C ksii = coords. du ieme noeud d'approximation
  21. C dans l'espace de référence (de dimension
  22. C NDIML)
  23. C Pi = ieme polynome d'interpolation sur
  24. C l'élément de référence.
  25. C
  26. C
  27. C LANGAGE : Esope
  28. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  29. C mél : gounand@semt2.smts.cea.fr
  30. C***********************************************************************
  31. C APPELES : VALPOL
  32. C APPELE PAR : KFNREF
  33. C***********************************************************************
  34. C ENTREES : MYLRF
  35. C ENTREES/SORTIES : -
  36. C SORTIES : PN
  37. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  38. C***********************************************************************
  39. C VERSION : v1, 16/09/99, version initiale
  40. C HISTORIQUE : v1, 16/09/99, création
  41. C HISTORIQUE : v2, 10/05/00, modif. du segment ELREF
  42. C HISTORIQUE :
  43. C HISTORIQUE :
  44. C***********************************************************************
  45. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  46. C en cas de modification de ce sous-programme afin de faciliter
  47. C la maintenance !
  48. C***********************************************************************
  49. -INC CCOPTIO
  50. CBEGININCLUDE SELREF
  51. SEGMENT ELREF
  52. CHARACTER*(LNNOM) NOMLRF
  53. CHARACTER*(LNFORM) FORME
  54. CHARACTER*(LNTYPL) TYPEL
  55. CHARACTER*(LNESP) ESPACE
  56. INTEGER DEGRE
  57. REAL*8 XCONOD(NDIMEL,NBNOD)
  58. INTEGER NPQUAF(NBDDL)
  59. INTEGER NUMCMP(NBDDL)
  60. INTEGER QUENOD(NBDDL)
  61. INTEGER ORDDER(NDIMEL,NBDDL)
  62. POINTEUR MBPOLY.POLYNS
  63. ENDSEGMENT
  64. SEGMENT ELREFS
  65. POINTEUR LISEL(0).ELREF
  66. ENDSEGMENT
  67. CENDINCLUDE SELREF
  68. POINTEUR MYLRF.ELREF
  69. CBEGININCLUDE SPOLYNO
  70. SEGMENT POLYNO
  71. REAL*8 COEMON(NBMON)
  72. INTEGER EXPMON(NDIML,NBMON)
  73. ENDSEGMENT
  74. SEGMENT POLYNS
  75. POINTEUR LIPOLY(NBPOLY).POLYNO
  76. ENDSEGMENT
  77. CENDINCLUDE SPOLYNO
  78. POINTEUR MYBPOL.POLYNS
  79. POINTEUR MYPOLY.POLYNO
  80. CBEGININCLUDE SMMREEL
  81. SEGMENT MMREEL
  82. REAL*8 MAT(JLIG,JCOL)
  83. ENDSEGMENT
  84. CENDINCLUDE SMMREEL
  85. INTEGER JLIG,JCOL
  86. POINTEUR PN.MMREEL
  87. *
  88. INTEGER IMPR,IRET
  89. *
  90. INTEGER INDFN,JNDFN
  91. INTEGER NDIML,NDIML2,NDFN,NBMONO,NPOLY
  92. *
  93. * Executable statements
  94. *
  95. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calpn'
  96. *
  97. * Initialisations
  98. *
  99. SEGACT MYLRF
  100. NDIML=MYLRF.XCONOD(/1)
  101. NDFN =MYLRF.NPQUAF(/1)
  102. MYBPOL=MYLRF.MBPOLY
  103. SEGACT MYBPOL
  104. NPOLY=MYBPOL.LIPOLY(/1)
  105. IF (NPOLY.NE.NDFN) THEN
  106. WRITE(IOIMP,*) 'Element fini mal défini'
  107. GOTO 9999
  108. ENDIF
  109. JLIG=NDFN
  110. JCOL=NDFN
  111. SEGINI PN
  112. *
  113. * On calcule la matrice [PN] colonne par colonne
  114. *
  115. DO 1 JNDFN=1,NDFN
  116. MYPOLY=MYBPOL.LIPOLY(JNDFN)
  117. SEGACT MYPOLY
  118. NDIML2=MYPOLY.EXPMON(/1)
  119. IF (NDIML2.NE.NDIML) THEN
  120. WRITE(IOIMP,*) 'Grosse erreur...(dimensions de segments)'
  121. GOTO 9999
  122. ENDIF
  123. NBMONO=MYPOLY.EXPMON(/2)
  124. DO 12 INDFN=1,NDFN
  125. * Calcul du polynôme JNDFN (ou une de ses dérivées) au point de
  126. * l'élément de référence numéro INDFN
  127. CALL VALPOL(NDIML,NBMONO,
  128. $ MYLRF.XCONOD(1,INDFN),
  129. $ MYPOLY.COEMON,MYPOLY.EXPMON,
  130. $ MYLRF.ORDDER(1,JNDFN),
  131. $ PN.MAT(INDFN,JNDFN),
  132. $ IMPR,IRET)
  133. IF (IRET.NE.0) GOTO 9999
  134. 12 CONTINUE
  135. SEGDES MYPOLY
  136. 1 CONTINUE
  137. IF (IMPR.GT.3) THEN
  138. WRITE(IOIMP,*) 'On a créé [PN] (',NDFN,'x',NDFN,') :'
  139. DO 3 INDFN=1,NDFN
  140. WRITE(IOIMP,4004) (PN.MAT(INDFN,JNDFN),JNDFN=1,NDFN)
  141. 3 CONTINUE
  142. ENDIF
  143. SEGDES PN
  144. SEGDES MYBPOL
  145. SEGDES MYLRF
  146. *
  147. * Normal termination
  148. *
  149. IRET=0
  150. RETURN
  151. *
  152. * Format handling
  153. *
  154. 4004 FORMAT (2X,6(1X,1PE13.5))
  155. *
  156. * Error handling
  157. *
  158. 9999 CONTINUE
  159. IRET=1
  160. WRITE(IOIMP,*) 'An error was detected in subroutine calpn'
  161. RETURN
  162. *
  163. * End of subroutine CALPN
  164. *
  165. END
  166.  
  167.  
  168.  
  169.  
  170.  

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