Télécharger la plaquette Cast3M


fr en

Télécharger ecmors.eso

Retour à la liste

Numérotation des lignes : 

ecmors

  1. C ECMORS    SOURCE    PV        20/09/26    21:16:35     10724          
  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.  
  49. -INC PPARAM
  50. -INC CCOPTIO
  52. * Variable d'état des segments PMORS et IZA
  53.       INTEGER PMOETA,IZAETA
  54. *
  55. * Executable statements
  56. *
  57.       IF (PMORS.EQ.0) THEN
  58.          WRITE(IOIMP,*) 'Nil PMORS pointer transmitted to ecmors'
  59.          GOTO 9999
  60.       ENDIF
  61.       CALL OOOETA(PMORS,PMOETA,IMOD)
  62.       IF (PMOETA.NE.1) SEGACT PMORS
  63. *
  64.       NTT=IA(/1)-1
  65.       NJA=JA(/1)
  66.       WRITE(IOIMP,4001) 'NTT =',NTT,'Nb total de DDL'
  67.       WRITE(IOIMP,4001) 'NJA =',NJA,'Nb tot. val. <> 0'
  68.       IF (NIVIMP.GT.2) THEN
  69.          IF (IZA.EQ.0) THEN
  70.             WRITE(IOIMP,*) 'Nil IZA pointer transmitted to ecmors'
  71. *            GOTO 9999
  72.          ENDIF
  73.          IF (IZA.NE.0) THEN
  74.             CALL OOOETA(IZA,IZAETA,IMOD)
  75.             IF (IZAETA.NE.1) SEGACT IZA
  76.          ENDIF
  77. *
  78.          WRITE(IOIMP,2001) 'Segment PMORS de pointeur ',PMORS
  79.          WRITE(IOIMP,2001) 'Segment IZA de pointeur ',IZA
  80.          DO 1 I=1,NTT
  81.             WRITE(IOIMP,4002) I
  82.             NB=IA(I+1)-IA(I)
  83.             LOFSET=IA(I)
  84.             WRITE(IOIMP,4003) (JA(LOFSET+J),J=0,NB-1)
  85.             IF (IZA.NE.0) THEN
  86.                IF (NIVIMP.GT.3) THEN
  87.                   WRITE(IOIMP,4005) ( A(LOFSET+J),J=0,NB-1)
  88.                ELSE
  89.                   WRITE(IOIMP,4004) ( A(LOFSET+J),J=0,NB-1)
  90.                ENDIF
  91.             ENDIF
  92.  1          CONTINUE
  93.             IF (IZA.NE.0) THEN
  94.                IF (IZAETA.NE.1) SEGDES IZA
  95.             ENDIF
  96.       ENDIF
  97.       IF (PMOETA.NE.1) SEGDES PMORS
  98. *
  99. * Normal termination
  100. *
  101.       RETURN
  102. *
  103. * Format handling
  104. *
  105.  2001 FORMAT (A,1X,I6)
  106.  4001 FORMAT (A,I6,2X,A)
  107.  4002 FORMAT ('LIGNE :',1X,I6)
  108.  4003 FORMAT (2X,'Colonne :',6(1X,I6,4X))
  109.  4004 FORMAT (2X,'Valeur  :',6(1X,1PE10.2))
  110.  4005 FORMAT (2X,'Valeur  :',6(1X,1PE24.16))
  111. *
  112. * Error handling
  113. *
  114.  9999 CONTINUE
  115.       WRITE(IOIMP,*) 'An error was detected in subroutine ecmors'
  116.       RETURN
  117. *
  118. * End of subroutine ECMORS
  119. *
  120.       END
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  

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