Télécharger prchva.eso

Retour à la liste

Numérotation des lignes :

  1. C PRCHVA SOURCE GOUNAND 05/12/21 21:34:58 5281
  2. SUBROUTINE PRCHVA(MYCHVA,
  3. $ IMPR,IRET)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM : PRCHVA
  8. C PROJET : Noyau linéaire NLIN
  9. C DESCRIPTION : Imprime un segment contenant les valeurs d'un champ par
  10. C élément élémentaire (un seul type d'élément)
  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 : PRCAEL, GEOLIN
  17. C***********************************************************************
  18. C ENTREES : * MYCHVA (type MCHEVA) : le champ par éléments
  19. C élémentaire à imprimer.
  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, 12/08/99, version initiale
  25. C HISTORIQUE : v1, 12/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. CBEGININCLUDE SMCHAEL
  35. SEGMENT MCHAEL
  36. POINTEUR IMACHE(N1).MELEME
  37. POINTEUR ICHEVA(N1).MCHEVA
  38. ENDSEGMENT
  39. SEGMENT MCHEVA
  40. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  41. ENDSEGMENT
  42. SEGMENT LCHEVA
  43. POINTEUR LISCHE(NBCHE).MCHEVA
  44. ENDSEGMENT
  45. CENDINCLUDE SMCHAEL
  46. POINTEUR MYCHVA.MCHEVA
  47. *
  48. INTEGER IMPR,IRET
  49. *
  50. INTEGER MCVETA
  51. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  52. INTEGER ILIG,ICOL,I2LIG,I2COL,IPOI,IELEM
  53. *
  54. * Executable statements
  55. *
  56. * On veut laisser MYCHVA dans le même état (actif, inactif) qu'avant
  57. * l'appel à PRCHVA.
  58. CALL OOOETA(MYCHVA,MCVETA)
  59. IF (MCVETA.NE.1) SEGACT MYCHVA
  60. WRITE(IOIMP,*) 'Segment MCHEVA de pointeur',MYCHVA
  61. IF (IMPR.GT.1) THEN
  62. NBELM=MYCHVA.VELCHE(/6)
  63. NBPOI=MYCHVA.VELCHE(/5)
  64. N2COL=MYCHVA.VELCHE(/4)
  65. N2LIG=MYCHVA.VELCHE(/3)
  66. NBCOL=MYCHVA.VELCHE(/2)
  67. NBLIG=MYCHVA.VELCHE(/1)
  68. WRITE(IOIMP,*) 'Nombre d''éléments, points, ',
  69. $ 'comp. colonnes, comp. lignes, colonnes, lignes :',
  70. $ NBELM,NBPOI,N2COL,N2LIG,NBCOL,NBLIG
  71. IF (IMPR.GT.3) THEN
  72. WRITE(IOIMP,*) 'Valeurs du champ par éléments'
  73. DO 3 IELEM=1,NBELM
  74. DO 32 IPOI=1,NBPOI
  75. DO 322 I2LIG=1,N2LIG
  76. DO 3222 I2COL=1,N2COL
  77. WRITE (IOIMP,*)
  78. $ 'Elément',IELEM,' Point',IPOI,
  79. $ 'Comp. lig.',I2LIG,'Comp. col',I2COL
  80. DO 32222 ILIG=1,NBLIG
  81. WRITE(IOIMP,4002)
  82. $ ILIG,
  83. $ (MYCHVA.VELCHE(ILIG,ICOL,I2LIG,I2COL,
  84. $ IPOI,IELEM),
  85. $ ICOL=1,NBCOL)
  86. 32222 CONTINUE
  87. 3222 CONTINUE
  88. 322 CONTINUE
  89. 32 CONTINUE
  90. 3 CONTINUE
  91. ENDIF
  92. ENDIF
  93. IF (MCVETA.NE.1) SEGDES MYCHVA
  94. *
  95. * Normal termination
  96. *
  97. IRET=0
  98. RETURN
  99. *
  100. * Format handling
  101. *
  102. 4000 FORMAT (2X,'Ligne :',6(1X,A8))
  103. 4001 FORMAT (2X,'Colonne :',6(1X,A8))
  104. 4002 FORMAT (2X,'Ligne ',I6,' :',4(1X,1PE16.8))
  105. *
  106. * Error handling
  107. *
  108. 9999 CONTINUE
  109. IRET=1
  110. WRITE(IOIMP,*) 'An error was detected in subroutine prchva'
  111. RETURN
  112. *
  113. * End of subroutine prchva
  114. *
  115. END
  116.  
  117.  
  118.  

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