Télécharger prcael.eso

Retour à la liste

Numérotation des lignes :

  1. C PRCAEL SOURCE CB215821 18/09/27 21:15:38 9936
  2. SUBROUTINE PRCAEL(MYCAEL,
  3. $ IMPR,IRET)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM : PRCAEL
  8. C PROJET : Noyau linéaire NLIN
  9. C DESCRIPTION : Imprime un champ par élément (type MCHAEL)
  10. C LANGAGE : ESOPE
  11. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  12. C mél : gounand@semt2.smts.cea.fr
  13. C***********************************************************************
  14. C APPELES : OOOETA (état d'un segment)
  15. C PRCHVA (impression d'un segment MCHEVA)
  16. C APPELES (E/S) : ECROBJ, PRLIST (écriture, impression)
  17. C APPELE PAR : MKCOOR
  18. C***********************************************************************
  19. C ENTREES : * MYCAEL (type MCHAEL) : le champ par éléments à
  20. C imprimer.
  21. C SORTIES : -
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION : v1, 03/09/99, version initiale
  25. C HISTORIQUE : v1, 03/09/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. CBEGININCLUDE SMCHAEL
  37. SEGMENT MCHAEL
  38. POINTEUR IMACHE(N1).MELEME
  39. POINTEUR ICHEVA(N1).MCHEVA
  40. ENDSEGMENT
  41. SEGMENT MCHEVA
  42. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  43. ENDSEGMENT
  44. SEGMENT LCHEVA
  45. POINTEUR LISCHE(NBCHE).MCHEVA
  46. ENDSEGMENT
  47. CENDINCLUDE SMCHAEL
  48. POINTEUR MYCAEL.MCHAEL
  49. POINTEUR MYCHVA.MCHEVA
  50. -INC SMELEME
  51. POINTEUR MYMACH.MELEME
  52. *
  53. INTEGER IMPR,IRET
  54. *
  55. INTEGER ISOUS
  56. INTEGER NSOUS
  57. INTEGER MCAETA,MACETA
  58. *
  59. * Executable statements
  60. *
  61. * On veut laisser MYCAEL dans le même état (actif, inactif) qu'avant
  62. * l'appel à PRCAEL.
  63. CALL OOOETA(MYCAEL,MCAETA,IMOD)
  64. IF (MCAETA.NE.1) SEGACT MYCAEL
  65. WRITE(IOIMP,*) 'Segment MCHAEL de pointeur',MYCAEL
  66. IF (IMPR.GT.1) THEN
  67. NSOUS=MYCAEL.ICHEVA(/1)
  68. WRITE(IOIMP,*) 'Nombre de partitions :',NSOUS
  69. IF (IMPR.GT.2) THEN
  70. DO 1 ISOUS=1,NSOUS
  71. MYMACH=MYCAEL.IMACHE(ISOUS)
  72. MYCHVA=MYCAEL.ICHEVA(ISOUS)
  73. WRITE(IOIMP,*) 'Sous-champ ',ISOUS,' : supp. géo. ',
  74. $ MYMACH,' MCHEVA=',MYCHVA
  75. IF (IMPR.GT.3) THEN
  76. IF (IMPR.GT.5) THEN
  77. IF (MYMACH.NE.0) THEN
  78. CALL OOOETA(MYMACH,MACETA,IMOD)
  79. WRITE(IOIMP,*) 'Support géométrique'
  80. CALL ECROBJ('MAILLAGE',MYMACH)
  81. CALL PRLIST
  82. IF (MACETA.NE.1) THEN
  83. SEGDES MYMACH
  84. ELSE
  85. SEGACT MYMACH
  86. ENDIF
  87. ENDIF
  88. ENDIF
  89. WRITE(IOIMP,*) 'Valeurs du champ par éléments'
  90. CALL PRCHVA(MYCHVA,IMPR,IRET)
  91. IF (IRET.NE.0) GOTO 9999
  92. ENDIF
  93. 1 CONTINUE
  94. ENDIF
  95. ENDIF
  96. IF (MCAETA.NE.1) SEGDES MYCAEL
  97. *
  98. * Normal termination
  99. *
  100. IRET=0
  101. RETURN
  102. *
  103. * Format handling
  104. *
  105. *
  106. * Error handling
  107. *
  108. 9999 CONTINUE
  109. IRET=1
  110. WRITE(IOIMP,*) 'An error was detected in subroutine prcael'
  111. RETURN
  112. *
  113. * End of subroutine prcael
  114. *
  115. END
  116.  
  117.  
  118.  
  119.  

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