1 : C ECMORS SOURCE GOUNAND 12/08/01 21:39:41 7454 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 : -INC SMMATRIK 50 : * Variable d'état des segments PMORS et IZA 51 : INTEGER PMOETA,IZAETA 52 : * 53 : * Executable statements 54 : * 55 : IF (PMORS.EQ.0) THEN 56 : WRITE(IOIMP,*) 'Nil PMORS pointer transmitted to ecmors' 57 : GOTO 9999 58 : 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 70 : CALL OOOETA(IZA,IZAETA) 71 : IF (IZAETA.NE.1) SEGACT IZA 72 : ENDIF 73 : * 74 : WRITE(IOIMP,2001) 'Segment PMORS de pointeur ',PMORS 75 : WRITE(IOIMP,2001) 'Segment IZA de pointeur ',IZA 76 : DO 1 I=1,NTT 77 : WRITE(IOIMP,4002) I 78 : NB=IA(I+1)-IA(I) 79 : LOFSET=IA(I) 80 : WRITE(IOIMP,4003) (JA(LOFSET+J),J=0,NB-1) 81 : IF (IZA.NE.0) THEN 82 : IF (NIVIMP.GT.3) THEN 83 : WRITE(IOIMP,4005) ( A(LOFSET+J),J=0,NB-1) 84 : ELSE 85 : WRITE(IOIMP,4004) ( A(LOFSET+J),J=0,NB-1) 86 : ENDIF 87 : ENDIF 88 : 1 CONTINUE 89 : IF (IZA.NE.0) THEN 90 : IF (IZAETA.NE.1) SEGDES IZA 91 : ENDIF 92 : ENDIF 93 : IF (PMOETA.NE.1) SEGDES PMORS 94 : * 95 : * Normal termination 96 : * 97 : RETURN 98 : * 99 : * Format handling 100 : * 101 : 2001 FORMAT (A,1X,I6) 102 : 4001 FORMAT (A,I6,2X,A) 103 : 4002 FORMAT ('LIGNE :',1X,I6) 104 : 4003 FORMAT (2X,'Colonne :',6(1X,I6,4X)) 105 : 4004 FORMAT (2X,'Valeur :',6(1X,1PE10.2)) 106 : 4005 FORMAT (2X,'Valeur :',6(1X,1PE24.16)) 107 : * 108 : * Error handling 109 : * 110 : 9999 CONTINUE 111 : WRITE(IOIMP,*) 'An error was detected in subroutine ecmors' 112 : RETURN 113 : * 114 : * End of subroutine ECMORS 115 : * 116 : END 117 : 118 : 119 : 120 : 121 :
© Cast3M 2003 - All rights reserved.
Disclaimer