Télécharger prchva.eso

Retour à la liste

Numérotation des lignes :

  1. C PRCHVA SOURCE CB215821 18/09/27 21:15:40 9936
  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.  
  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 MYCHVA.MCHEVA
  49. *
  50. INTEGER IMPR,IRET
  51. *
  52. INTEGER MCVETA
  53. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  54. INTEGER ILIG,ICOL,I2LIG,I2COL,IPOI,IELEM
  55. *
  56. * Executable statements
  57. *
  58. * On veut laisser MYCHVA dans le même état (actif, inactif) qu'avant
  59. * l'appel à PRCHVA.
  60. CALL OOOETA(MYCHVA,MCVETA,IMOD)
  61. IF (MCVETA.NE.1) SEGACT MYCHVA
  62. WRITE(IOIMP,*) 'Segment MCHEVA de pointeur',MYCHVA
  63. IF (IMPR.GT.1) THEN
  64. NBELM=MYCHVA.VELCHE(/6)
  65. NBPOI=MYCHVA.VELCHE(/5)
  66. N2COL=MYCHVA.VELCHE(/4)
  67. N2LIG=MYCHVA.VELCHE(/3)
  68. NBCOL=MYCHVA.VELCHE(/2)
  69. NBLIG=MYCHVA.VELCHE(/1)
  70. WRITE(IOIMP,*) 'Nombre d''éléments, points, ',
  71. $ 'comp. colonnes, comp. lignes, colonnes, lignes :',
  72. $ NBELM,NBPOI,N2COL,N2LIG,NBCOL,NBLIG
  73. IF (IMPR.GT.3) THEN
  74. WRITE(IOIMP,*) 'Valeurs du champ par éléments'
  75. DO 3 IELEM=1,NBELM
  76. DO 32 IPOI=1,NBPOI
  77. DO 322 I2LIG=1,N2LIG
  78. DO 3222 I2COL=1,N2COL
  79. WRITE (IOIMP,*)
  80. $ 'Elément',IELEM,' Point',IPOI,
  81. $ 'Comp. lig.',I2LIG,'Comp. col',I2COL
  82. DO 32222 ILIG=1,NBLIG
  83. WRITE(IOIMP,4002)
  84. $ ILIG,
  85. $ (MYCHVA.VELCHE(ILIG,ICOL,I2LIG,I2COL,
  86. $ IPOI,IELEM),
  87. $ ICOL=1,NBCOL)
  88. 32222 CONTINUE
  89. 3222 CONTINUE
  90. 322 CONTINUE
  91. 32 CONTINUE
  92. 3 CONTINUE
  93. ENDIF
  94. ENDIF
  95. IF (MCVETA.NE.1) SEGDES MYCHVA
  96. *
  97. * Normal termination
  98. *
  99. IRET=0
  100. RETURN
  101. *
  102. * Format handling
  103. *
  104. 4000 FORMAT (2X,'Ligne :',6(1X,A8))
  105. 4001 FORMAT (2X,'Colonne :',6(1X,A8))
  106. 4002 FORMAT (2X,'Ligne ',I6,' :',4(1X,1PE16.8))
  107. *
  108. * Error handling
  109. *
  110. 9999 CONTINUE
  111. IRET=1
  112. WRITE(IOIMP,*) 'An error was detected in subroutine prchva'
  113. RETURN
  114. *
  115. * End of subroutine prchva
  116. *
  117. END
  118.  
  119.  
  120.  
  121.  

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