Télécharger la plaquette Cast3M


fr en

Télécharger prfal.eso

Retour à la liste

Numérotation des lignes : 

prfal

  1. C PRFAL     SOURCE    GOUNAND   21/06/02    21:17:22     11022          
  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.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC CCGEOME
  37. -INC TNLIN      
  38. *-INC SELREF
  39.       POINTEUR ELCOUR.ELREF
  40. *-INC SFALRF
  41.       POINTEUR FACOUR.FALRF
  42. *
  43.       INTEGER IMPR,IRET
  44. *
  45.       INTEGER IBLRF,NBLRF
  46.       INTEGER FALETA
  47. *
  48. * Executable statements
  49. *
  50. * On veut laisser FACOUR dans le même état (actif, inactif) qu'avant
  51. * l'appel à PRFAL.
  52.       CALL OOOETA(FACOUR,FALETA,IMOD)
  53.       IF (FALETA.NE.1) SEGACT FACOUR
  54.       WRITE(IOIMP,*) 'Segment FALRF de pointeur',FACOUR
  55.       IF (IMPR.GT.1) THEN
  56.          WRITE(IOIMP,*) 'Nom : ',FACOUR.NOMFA
  57.          IF (IMPR.GT.2) THEN
  58.             NBLRF=FACOUR.NUQUAF(/1)
  59.             SEGACT FACOUR.ELEMF(*)
  60.             WRITE(IOIMP,4005) 'QUAF','Elément fini'
  61.             DO 1 IBLRF=1,NBLRF
  62.                ELCOUR=FACOUR.ELEMF(IBLRF)
  63.                WRITE(IOIMP,4005) NOMS(FACOUR.NUQUAF(IBLRF)),
  64.      $              ELCOUR.NOMLRF
  65.  1          CONTINUE
  66.             SEGDES FACOUR.ELEMF(*)
  67.          ENDIF
  68.       ENDIF
  69.       IF (FALETA.NE.1) SEGDES FACOUR
  70. C            NBLRF=FACOUR.NUQUAF(/1)
  71. C            SEGACT FACOUR.ELEMF(*)
  72. C            DO 1 IBLRF=1,NBLRF
  73. C               ELCOUR=FACOUR.ELEMF(IBLRF)
  74. C               WRITE(IOIMP,4004) FACOUR.NOMFA,
  75. C     $              NOMS(FACOUR.NUQUAF(IBLRF)),
  76. C     $              ELCOUR.NOMLRF
  77. C 1          CONTINUE
  78. C            SEGDES FACOUR.ELEMF(*)
  79. *
  80. * Normal termination
  81. *
  82.       IRET=0
  83.       RETURN
  84. *
  85. * Format handling
  86. *
  87.  4004 FORMAT (A15,' ',A15,' ',A15)
  88.  4005 FORMAT (A14,' <-> ',A14)
  89. *
  90. * Error handling
  91. *
  92.  9999 CONTINUE
  93.       IRET=1
  94.       WRITE(IOIMP,*) 'An error was detected in subroutine prfal'
  95.       RETURN
  96. *
  97. * End of subroutine prfal
  98. *
  99.       END
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  

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