1 : C PRQRF SOURCE CHAT 07/10/29 21:26:30 5940 2 : SUBROUTINE PRQRF(QRF, 3 : $ IMPR,IRET) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : IMPLICIT INTEGER (I-N) 6 : C*********************************************************************** 7 : C NOM : PRQRF 8 : C PROJET : Noyau linéaire NLIN 9 : C DESCRIPTION : 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 : 15 : C APPELES (E/S) : OOOETA 16 : C APPELE PAR : INQRFS 17 : C*********************************************************************** 18 : C ENTREES : QRF 19 : C ENTREES/SORTIES : - 20 : C SORTIES : - 21 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 22 : C*********************************************************************** 23 : C VERSION : v1, 17/10/02, version initiale 24 : C HISTORIQUE : v1, 17/10/02, création 25 : C HISTORIQUE : 26 : C HISTORIQUE : 27 : C*********************************************************************** 28 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 29 : C en cas de modification de ce sous-programme afin de faciliter 30 : C la maintenance ! 31 : C*********************************************************************** 32 : -INC CCOPTIO 33 : -INC CCGEOME 34 : CBEGININCLUDE SIQUAF 35 : SEGMENT IQUAF 36 : INTEGER NUMQUF 37 : REAL*8 XCONQR(NDIMQR,NBNOQR) 38 : INTEGER NUCENT 39 : POINTEUR LFACE.MELEME 40 : ENDSEGMENT 41 : SEGMENT IQUAFS 42 : POINTEUR LISQRF(NBQRF).IQUAF 43 : ENDSEGMENT 44 : CENDINCLUDE SIQUAF 45 : POINTEUR QRF.IQUAF 46 : INTEGER NDIMQR,NBNOQR 47 : * 48 : INTEGER IMPR,IRET 49 : * 50 : INTEGER IDIMQR,IBNOQR 51 : INTEGER NUMER 52 : INTEGER QRFETA 53 : * 54 : * Executable statements 55 : * 56 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prqrf' 57 : * 57 : CALL OOOETA(QRF,QRFETA) 58 : IF (QRFETA.NE.1) SEGACT QRF 59 : WRITE(IOIMP,*) 'Segment IQUAF de pointeur',QRF 60 : NUMER=QRF.NUMQUF 61 : WRITE(IOIMP,*) 'Nom : ',NOMS(NUMER) 62 : WRITE(IOIMP,*) 'Coordonnées des noeuds du QUAF:' 63 : NDIMQR=QRF.XCONQR(/1) 64 : NBNOQR=QRF.XCONQR(/2) 65 : DO 1 IBNOQR=1,NBNOQR 66 : WRITE(IOIMP,4005) 67 : $ IBNOQR,(QRF.XCONQR(IDIMQR,IBNOQR),IDIMQR=1,NDIMQR) 68 : 1 CONTINUE 69 : WRITE(IOIMP,*) 'Numéro du centre : ',QRF.NUCENT 70 : WRITE(IOIMP,*) 'Maillage des faces : ' 71 : MYMEL=QRF.LFACE 72 : IF (MYMEL.NE.0) THEN 72 : CALL ECROBJ('MAILLAGE',MYMEL) 72 : CALL PRLIST 73 : ELSE 74 : WRITE(IOIMP,*) 'Pas de maillage des faces' 75 : ENDIF 76 : IF (QRFETA.NE.1) SEGDES QRF 77 : * 78 : * Normal termination 79 : * 80 : IRET=0 81 : RETURN 82 : * 83 : * Format handling 84 : * 85 : 4005 FORMAT (2X,'Point ',I6,' :',6(1X,1PE24.16)) 86 : * 87 : * Error handling 88 : * 89 : 9999 CONTINUE 90 : IRET=1 91 : WRITE(IOIMP,*) 'An error was detected in subroutine prqrf' 92 : RETURN 93 : * 94 : * End of subroutine PRQRF 95 : * 96 : END 97 : 98 : 99 : 100 :
© Cast3M 2003 - All rights reserved.
Disclaimer