Télécharger calpn.eso

Retour à la liste

Numérotation des lignes :

calpn
  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.  
  50. -INC PPARAM
  51. -INC CCOPTIO
  52. CBEGININCLUDE SELREF
  53. SEGMENT ELREF
  54. CHARACTER*(LNNOM) NOMLRF
  55. CHARACTER*(LNFORM) FORME
  56. CHARACTER*(LNTYPL) TYPEL
  57. CHARACTER*(LNESP) ESPACE
  58. INTEGER DEGRE
  59. REAL*8 XCONOD(NDIMEL,NBNOD)
  60. INTEGER NPQUAF(NBDDL)
  61. INTEGER NUMCMP(NBDDL)
  62. INTEGER QUENOD(NBDDL)
  63. INTEGER ORDDER(NDIMEL,NBDDL)
  64. POINTEUR MBPOLY.POLYNS
  65. ENDSEGMENT
  66. SEGMENT ELREFS
  67. POINTEUR LISEL(0).ELREF
  68. ENDSEGMENT
  69. CENDINCLUDE SELREF
  70. POINTEUR MYLRF.ELREF
  71. CBEGININCLUDE SPOLYNO
  72. SEGMENT POLYNO
  73. REAL*8 COEMON(NBMON)
  74. INTEGER EXPMON(NDIML,NBMON)
  75. ENDSEGMENT
  76. SEGMENT POLYNS
  77. POINTEUR LIPOLY(NBPOLY).POLYNO
  78. ENDSEGMENT
  79. CENDINCLUDE SPOLYNO
  80. POINTEUR MYBPOL.POLYNS
  81. POINTEUR MYPOLY.POLYNO
  82. CBEGININCLUDE SMMREEL
  83. SEGMENT MMREEL
  84. REAL*8 MAT(JLIG,JCOL)
  85. ENDSEGMENT
  86. CENDINCLUDE SMMREEL
  87. INTEGER JLIG,JCOL
  88. POINTEUR PN.MMREEL
  89. *
  90. INTEGER IMPR,IRET
  91. *
  92. INTEGER INDFN,JNDFN
  93. INTEGER NDIML,NDIML2,NDFN,NBMONO,NPOLY
  94. *
  95. * Executable statements
  96. *
  97. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calpn'
  98. *
  99. * Initialisations
  100. *
  101. SEGACT MYLRF
  102. NDIML=MYLRF.XCONOD(/1)
  103. NDFN =MYLRF.NPQUAF(/1)
  104. MYBPOL=MYLRF.MBPOLY
  105. SEGACT MYBPOL
  106. NPOLY=MYBPOL.LIPOLY(/1)
  107. IF (NPOLY.NE.NDFN) THEN
  108. WRITE(IOIMP,*) 'Element fini mal défini'
  109. GOTO 9999
  110. ENDIF
  111. JLIG=NDFN
  112. JCOL=NDFN
  113. SEGINI PN
  114. *
  115. * On calcule la matrice [PN] colonne par colonne
  116. *
  117. DO 1 JNDFN=1,NDFN
  118. MYPOLY=MYBPOL.LIPOLY(JNDFN)
  119. SEGACT MYPOLY
  120. NDIML2=MYPOLY.EXPMON(/1)
  121. IF (NDIML2.NE.NDIML) THEN
  122. WRITE(IOIMP,*) 'Grosse erreur...(dimensions de segments)'
  123. GOTO 9999
  124. ENDIF
  125. NBMONO=MYPOLY.EXPMON(/2)
  126. DO 12 INDFN=1,NDFN
  127. * Calcul du polynôme JNDFN (ou une de ses dérivées) au point de
  128. * l'élément de référence numéro INDFN
  129. CALL VALPOL(NDIML,NBMONO,
  130. $ MYLRF.XCONOD(1,INDFN),
  131. $ MYPOLY.COEMON,MYPOLY.EXPMON,
  132. $ MYLRF.ORDDER(1,JNDFN),
  133. $ PN.MAT(INDFN,JNDFN),
  134. $ IMPR,IRET)
  135. IF (IRET.NE.0) GOTO 9999
  136. 12 CONTINUE
  137. SEGDES MYPOLY
  138. 1 CONTINUE
  139. IF (IMPR.GT.3) THEN
  140. WRITE(IOIMP,*) 'On a créé [PN] (',NDFN,'x',NDFN,') :'
  141. DO 3 INDFN=1,NDFN
  142. WRITE(IOIMP,4004) (PN.MAT(INDFN,JNDFN),JNDFN=1,NDFN)
  143. 3 CONTINUE
  144. ENDIF
  145. SEGDES PN
  146. SEGDES MYBPOL
  147. SEGDES MYLRF
  148. *
  149. * Normal termination
  150. *
  151. IRET=0
  152. RETURN
  153. *
  154. * Format handling
  155. *
  156. 4004 FORMAT (2X,6(1X,1PE13.5))
  157. *
  158. * Error handling
  159. *
  160. 9999 CONTINUE
  161. IRET=1
  162. WRITE(IOIMP,*) 'An error was detected in subroutine calpn'
  163. RETURN
  164. *
  165. * End of subroutine CALPN
  166. *
  167. END
  168.  
  169.  
  170.  
  171.  
  172.  

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