Télécharger keef.eso

Retour à la liste

Numérotation des lignes :

  1. C KEEF SOURCE BP208322 16/11/18 21:18:07 9177
  2. SUBROUTINE KEEF(ITYPL,NMFAL,
  3. $ MYFALS,
  4. $ MYLRF,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : KEEF
  10. C PROJET : Noyau linéaire NLIN
  11. C DESCRIPTION : On donne un numéro de type d'élément géométrique (un
  12. C QUAF, donc), un nom de famille d'éléments finis.
  13. C En sortie, on a le pointeur sur l'élément fini (type
  14. C ELREF)
  15. C
  16. C MYFALS et MYLRFS sont des données de type COMMON
  17. C décrivant toutes les familles d'éléments finis et tous
  18. C les éléments finis...
  19. C
  20. C LANGAGE : ESOPE
  21. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  22. C mél : gounand@semt2.smts.cea.fr
  23. C***********************************************************************
  24. C APPELES : FIFAL, FIENTI (recherche dans une liste)
  25. C APPELE PAR : VERFAM, MKCOOR, KECOMP
  26. C***********************************************************************
  27. C ENTREES : * ITYPL (type entier) : numéro d'élément
  28. C géométrique (cf. tableau NOMS dans l'include
  29. C CCOPTIO).
  30. C * NMFAL (type CH*(*)) : nom de famille
  31. C d'éléments finis (cf. NOMFA dans l'include
  32. C SFALRF).
  33. C * MYFALS (type FALRFS) : segment de description
  34. C des familles d'éléments de références.
  35. C SORTIES : * MYLRF (type ELREF) : pointeur sur l'élément
  36. C fini correspondant à l'élément géométrique de
  37. C numéro ITYPL dans la famille de nom NMFAL
  38. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  39. C***********************************************************************
  40. C VERSION : v1, 13/09/99, version initiale
  41. C HISTORIQUE : v1, 13/09/99, création
  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. -INC CCGEOME
  51. *
  52. * Includes perso
  53. *
  54. CBEGININCLUDE SFALRF
  55. SEGMENT FALRF
  56. CHARACTER*(LNNFA) NOMFA
  57. INTEGER NUQUAF(NBLRF)
  58. POINTEUR ELEMF(NBLRF).ELREF
  59. ENDSEGMENT
  60. SEGMENT FALRFS
  61. POINTEUR LISFA(0).FALRF
  62. ENDSEGMENT
  63. CENDINCLUDE SFALRF
  64. POINTEUR MYFALS.FALRFS
  65. POINTEUR MYFAL.FALRF
  66. CBEGININCLUDE SELREF
  67. SEGMENT ELREF
  68. CHARACTER*(LNNOM) NOMLRF
  69. CHARACTER*(LNFORM) FORME
  70. CHARACTER*(LNTYPL) TYPEL
  71. CHARACTER*(LNESP) ESPACE
  72. INTEGER DEGRE
  73. REAL*8 XCONOD(NDIMEL,NBNOD)
  74. INTEGER NPQUAF(NBDDL)
  75. INTEGER NUMCMP(NBDDL)
  76. INTEGER QUENOD(NBDDL)
  77. INTEGER ORDDER(NDIMEL,NBDDL)
  78. POINTEUR MBPOLY.POLYNS
  79. ENDSEGMENT
  80. SEGMENT ELREFS
  81. POINTEUR LISEL(0).ELREF
  82. ENDSEGMENT
  83. CENDINCLUDE SELREF
  84. POINTEUR MYLRF.ELREF
  85. *
  86. INTEGER ITYPL
  87. CHARACTER*(*) NMFAL
  88. INTEGER IBLRF,NBLRF
  89. INTEGER IMPR,IRET
  90. *
  91. * Executable statements
  92. *
  93. IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans keef'
  94. CALL FIFAL(NMFAL,MYFALS,
  95. $ MYFAL,
  96. $ IMPR,IRET)
  97. IF (IRET.NE.0) GOTO 9999
  98. SEGACT MYFAL
  99. NBLRF=MYFAL.NUQUAF(/1)
  100. CALL FIENTI(ITYPL,MYFAL.NUQUAF,NBLRF,
  101. $ IBLRF,
  102. $ IMPR,IRET)
  103. IF (IRET.NE.0) THEN
  104. WRITE(IOIMP,*) 'On n''a pas trouvé ',NOMS(ITYPL),
  105. $ ' dans la famille d''éléments finis ',MYFAL.NOMFA
  106. GOTO 9999
  107. ENDIF
  108. MYLRF=MYFAL.ELEMF(IBLRF)
  109. SEGDES MYFAL
  110. *
  111. * Normal termination
  112. *
  113. IRET=0
  114. RETURN
  115. *
  116. * Format handling
  117. *
  118. *
  119. * Error handling
  120. *
  121. 9999 CONTINUE
  122. IRET=1
  123. WRITE(IOIMP,*) 'An error was detected in subroutine keef'
  124. RETURN
  125. *
  126. * End of subroutine KEEF
  127. *
  128. END
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  

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