Télécharger prfal.eso

Retour à la liste

Numérotation des lignes :

  1. C PRFAL SOURCE BP208322 16/11/18 21:20:08 9177
  2. SUBROUTINE PRFAL(FACOUR,
  3. $ IMPR,IRET)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM : PRFAL
  8. C PROJET : Noyau linéaire NLIN
  9. C DESCRIPTION : Imprime un segment décrivant une famille d'éléments
  10. C de référence.
  11. C LANGAGE : ESOPE
  12. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  13. C mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES : OOOETA (état d'un segment)
  16. C APPELE PAR : INFALS
  17. C***********************************************************************
  18. C ENTREES : FACOUR (type FALRF) : famille d'éléments de
  19. C référence.
  20. C ENTREES/SORTIES : -
  21. C SORTIES : -
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION : v1, 17/08/99, version initiale
  25. C HISTORIQUE : v1, 17/08/99, création
  26. C HISTORIQUE :
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33. -INC CCOPTIO
  34. -INC CCGEOME
  35. CBEGININCLUDE SELREF
  36. SEGMENT ELREF
  37. CHARACTER*(LNNOM) NOMLRF
  38. CHARACTER*(LNFORM) FORME
  39. CHARACTER*(LNTYPL) TYPEL
  40. CHARACTER*(LNESP) ESPACE
  41. INTEGER DEGRE
  42. REAL*8 XCONOD(NDIMEL,NBNOD)
  43. INTEGER NPQUAF(NBDDL)
  44. INTEGER NUMCMP(NBDDL)
  45. INTEGER QUENOD(NBDDL)
  46. INTEGER ORDDER(NDIMEL,NBDDL)
  47. POINTEUR MBPOLY.POLYNS
  48. ENDSEGMENT
  49. SEGMENT ELREFS
  50. POINTEUR LISEL(0).ELREF
  51. ENDSEGMENT
  52. CENDINCLUDE SELREF
  53. POINTEUR ELCOUR.ELREF
  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 FACOUR.FALRF
  65. *
  66. INTEGER IMPR,IRET
  67. *
  68. INTEGER IBLRF,NBLRF
  69. INTEGER FALETA
  70. *
  71. * Executable statements
  72. *
  73. * On veut laisser FACOUR dans le même état (actif, inactif) qu'avant
  74. * l'appel à PRFAL.
  75. CALL OOOETA(FACOUR,FALETA)
  76. IF (FALETA.NE.1) SEGACT FACOUR
  77. WRITE(IOIMP,*) 'Segment FALRF de pointeur',FACOUR
  78. IF (IMPR.GT.1) THEN
  79. WRITE(IOIMP,*) 'Nom : ',FACOUR.NOMFA
  80. IF (IMPR.GT.2) THEN
  81. NBLRF=FACOUR.NUQUAF(/1)
  82. SEGACT FACOUR.ELEMF(*)
  83. WRITE(IOIMP,4005) 'QUAF','Elément fini'
  84. DO 1 IBLRF=1,NBLRF
  85. ELCOUR=FACOUR.ELEMF(IBLRF)
  86. WRITE(IOIMP,4005) NOMS(FACOUR.NUQUAF(IBLRF)),
  87. $ ELCOUR.NOMLRF
  88. 1 CONTINUE
  89. SEGDES FACOUR.ELEMF(*)
  90. ENDIF
  91. ENDIF
  92. IF (FALETA.NE.1) SEGDES FACOUR
  93. C NBLRF=FACOUR.NUQUAF(/1)
  94. C SEGACT FACOUR.ELEMF(*)
  95. C DO 1 IBLRF=1,NBLRF
  96. C ELCOUR=FACOUR.ELEMF(IBLRF)
  97. C WRITE(IOIMP,4004) FACOUR.NOMFA,
  98. C $ NOMS(FACOUR.NUQUAF(IBLRF)),
  99. C $ ELCOUR.NOMLRF
  100. C 1 CONTINUE
  101. C SEGDES FACOUR.ELEMF(*)
  102. *
  103. * Normal termination
  104. *
  105. IRET=0
  106. RETURN
  107. *
  108. * Format handling
  109. *
  110. 4004 FORMAT (A15,' ',A15,' ',A15)
  111. 4005 FORMAT (A14,' <-> ',A14)
  112. *
  113. * Error handling
  114. *
  115. 9999 CONTINUE
  116. IRET=1
  117. WRITE(IOIMP,*) 'An error was detected in subroutine prfal'
  118. RETURN
  119. *
  120. * End of subroutine prfal
  121. *
  122. END
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  

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