1 : C PRCAEL SOURCE GOUNAND 05/12/21 21:34:54 5281 2 : SUBROUTINE PRCAEL(MYCAEL, 3 : $ IMPR,IRET) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : IMPLICIT INTEGER (I-N) 6 : C*********************************************************************** 7 : C NOM : PRCAEL 8 : C PROJET : Noyau linéaire NLIN 9 : C DESCRIPTION : Imprime un champ par élément (type MCHAEL) 10 : C LANGAGE : ESOPE 11 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 12 : C mél : gounand@semt2.smts.cea.fr 13 : C*********************************************************************** 14 : C APPELES : OOOETA (état d'un segment) 15 : C PRCHVA (impression d'un segment MCHEVA) 16 : C APPELES (E/S) : ECROBJ, PRLIST (écriture, impression) 17 : C APPELE PAR : MKCOOR 18 : C*********************************************************************** 19 : C ENTREES : * MYCAEL (type MCHAEL) : le champ par éléments à 20 : C imprimer. 21 : C SORTIES : - 22 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 23 : C*********************************************************************** 24 : C VERSION : v1, 03/09/99, version initiale 25 : C HISTORIQUE : v1, 03/09/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 MYCAEL.MCHAEL 47 : POINTEUR MYCHVA.MCHEVA 48 : -INC SMELEME 49 : POINTEUR MYMACH.MELEME 50 : * 51 : INTEGER IMPR,IRET 52 : * 53 : INTEGER ISOUS 54 : INTEGER NSOUS 55 : INTEGER MCAETA,MACETA 56 : * 57 : * Executable statements 58 : * 59 : * On veut laisser MYCAEL dans le même état (actif, inactif) qu'avant 60 : * l'appel à PRCAEL. 60 : CALL OOOETA(MYCAEL,MCAETA) 61 : IF (MCAETA.NE.1) SEGACT MYCAEL 62 : WRITE(IOIMP,*) 'Segment MCHAEL de pointeur',MYCAEL 63 : IF (IMPR.GT.1) THEN 64 : NSOUS=MYCAEL.ICHEVA(/1) 65 : WRITE(IOIMP,*) 'Nombre de partitions :',NSOUS 66 : IF (IMPR.GT.2) THEN 67 : DO 1 ISOUS=1,NSOUS 68 : MYMACH=MYCAEL.IMACHE(ISOUS) 69 : MYCHVA=MYCAEL.ICHEVA(ISOUS) 70 : WRITE(IOIMP,*) 'Sous-champ ',ISOUS,' : supp. géo. ', 71 : $ MYMACH,' MCHEVA=',MYCHVA 72 : IF (IMPR.GT.3) THEN 73 : IF (IMPR.GT.5) THEN 74 : IF (MYMACH.NE.0) THEN 74 : CALL OOOETA(MYMACH,MACETA) 75 : WRITE(IOIMP,*) 'Support géométrique' 75 : CALL ECROBJ('MAILLAGE',MYMACH) 75 : CALL PRLIST 76 : IF (MACETA.NE.1) THEN 77 : SEGDES MYMACH 78 : ELSE 79 : SEGACT MYMACH 80 : ENDIF 81 : ENDIF 82 : ENDIF 83 : WRITE(IOIMP,*) 'Valeurs du champ par éléments' 83 : CALL PRCHVA(MYCHVA,IMPR,IRET) 84 : IF (IRET.NE.0) GOTO 9999 85 : ENDIF 86 : 1 CONTINUE 87 : ENDIF 88 : ENDIF 89 : IF (MCAETA.NE.1) SEGDES MYCAEL 90 : * 91 : * Normal termination 92 : * 93 : IRET=0 94 : RETURN 95 : * 96 : * Format handling 97 : * 98 : * 99 : * Error handling 100 : * 101 : 9999 CONTINUE 102 : IRET=1 103 : WRITE(IOIMP,*) 'An error was detected in subroutine prcael' 104 : RETURN 105 : * 106 : * End of subroutine prcael 107 : * 108 : END 109 : 110 :
© Cast3M 2003 - All rights reserved.
Disclaimer