Télécharger ecmors.eso

Retour à la liste

Numérotation des lignes :

  1. C ECMORS SOURCE PV 16/11/17 21:59:15 9180
  2. SUBROUTINE ECMORS(PMORS,IZA,NIVIMP)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM : ECMORS
  7. C DESCRIPTION : Impression d'un objet de type matrice stockée
  8. C en morse.
  9. C PMORS est son profil et IZA sont ses valeurs.
  10. C cf. include SMMATRIK
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES : -
  17. C***********************************************************************
  18. C ENTREES : PMORS, IZA, NIVIMP
  19. C ENTREES/SORTIES : -
  20. C SORTIES : -
  21. C CODE RETOUR (IRET) : -
  22. C PMORS : segment de type PMORS (include SMMATRIK)
  23. C profil de la matrice stockée en morse.
  24. C IZA : segment de type IZA (include SMMATRIK)
  25. C valeurs des coefficients de la matrice morse.
  26. C Normalement, ils sont tous non nulles...
  27. C NIVIMP : niveau d'impression. Suivant sa valeur, on obtient :
  28. C Convention (probablement non totalement respectée) :
  29. C ---------- 0 : presque rien (numéro de pointeur)
  30. C 1 : affichage du chapeau MINC
  31. C 2 : affichage des données concernant les objets
  32. C pointés par MINC (s'il y en a)
  33. C 3 : affichage du contenu des objets vectoriels
  34. C 4 : affichage du contenu des objets matriciels
  35. C On ne change pas l'état (actif ou inactif) des segments PMORSC et IZA.
  36. C***********************************************************************
  37. C VERSION : v1, 01/04/98, version initiale
  38. C HISTORIQUE : v1, 01/04/98, création
  39. C HISTORIQUE : 29/10/98, modif. l'état du segment reste inchangé
  40. C en sortie
  41. C HISTORIQUE :
  42. C HISTORIQUE :
  43. C***********************************************************************
  44. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  45. C en cas de modification de ce sous-programme afin de faciliter
  46. C la maintenance !
  47. C***********************************************************************
  48. -INC CCOPTIO
  49. * Variable d'état des segments PMORS et IZA
  50. INTEGER PMOETA,IZAETA
  51. *
  52. * Executable statements
  53. *
  54. IF (PMORS.EQ.0) THEN
  55. WRITE(IOIMP,*) 'Nil PMORS pointer transmitted to ecmors'
  56. GOTO 9999
  57. ENDIF
  58. CALL OOOETA(PMORS,PMOETA)
  59. IF (PMOETA.NE.1) SEGACT PMORS
  60. *
  61. NTT=IA(/1)-1
  62. NJA=JA(/1)
  63. WRITE(IOIMP,4001) 'NTT =',NTT,'Nb total de DDL'
  64. WRITE(IOIMP,4001) 'NJA =',NJA,'Nb tot. val. <> 0'
  65. IF (NIVIMP.GT.2) THEN
  66. IF (IZA.EQ.0) THEN
  67. WRITE(IOIMP,*) 'Nil IZA pointer transmitted to ecmors'
  68. * GOTO 9999
  69. ENDIF
  70. IF (IZA.NE.0) THEN
  71. CALL OOOETA(IZA,IZAETA)
  72. IF (IZAETA.NE.1) SEGACT IZA
  73. ENDIF
  74. *
  75. WRITE(IOIMP,2001) 'Segment PMORS de pointeur ',PMORS
  76. WRITE(IOIMP,2001) 'Segment IZA de pointeur ',IZA
  77. DO 1 I=1,NTT
  78. WRITE(IOIMP,4002) I
  79. NB=IA(I+1)-IA(I)
  80. LOFSET=IA(I)
  81. WRITE(IOIMP,4003) (JA(LOFSET+J),J=0,NB-1)
  82. IF (IZA.NE.0) THEN
  83. IF (NIVIMP.GT.3) THEN
  84. WRITE(IOIMP,4005) ( A(LOFSET+J),J=0,NB-1)
  85. ELSE
  86. WRITE(IOIMP,4004) ( A(LOFSET+J),J=0,NB-1)
  87. ENDIF
  88. ENDIF
  89. 1 CONTINUE
  90. IF (IZA.NE.0) THEN
  91. IF (IZAETA.NE.1) SEGDES IZA
  92. ENDIF
  93. ENDIF
  94. IF (PMOETA.NE.1) SEGDES PMORS
  95. *
  96. * Normal termination
  97. *
  98. RETURN
  99. *
  100. * Format handling
  101. *
  102. 2001 FORMAT (A,1X,I6)
  103. 4001 FORMAT (A,I6,2X,A)
  104. 4002 FORMAT ('LIGNE :',1X,I6)
  105. 4003 FORMAT (2X,'Colonne :',6(1X,I6,4X))
  106. 4004 FORMAT (2X,'Valeur :',6(1X,1PE10.2))
  107. 4005 FORMAT (2X,'Valeur :',6(1X,1PE24.16))
  108. *
  109. * Error handling
  110. *
  111. 9999 CONTINUE
  112. WRITE(IOIMP,*) 'An error was detected in subroutine ecmors'
  113. RETURN
  114. *
  115. * End of subroutine ECMORS
  116. *
  117. END
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  

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