C INQRFS SOURCE GOUNAND 06/08/04 21:16:17 5520 SUBROUTINE INQRFS(MYQRFS,IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : INQRFS C PROJET : Noyau linéaire NLIN C DESCRIPTION : Initialise le segment contenant les informations sur C les QUAFs de référence. C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : C APPELES (E/S) : PRQRF C APPELE PAR : C*********************************************************************** C ENTREES : - C SORTIES : MYQRFS C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 17/10/02, version initiale C HISTORIQUE : v1, 17/10/02, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC CCOPTIO CBEGININCLUDE SIQUAF SEGMENT IQUAF INTEGER NUMQUF REAL*8 XCONQR(NDIMQR,NBNOQR) INTEGER NUCENT POINTEUR LFACE.MELEME ENDSEGMENT SEGMENT IQUAFS POINTEUR LISQRF(NBQRF).IQUAF ENDSEGMENT CENDINCLUDE SIQUAF POINTEUR MYQRFS.IQUAFS POINTEUR QRCOUR.IQUAF INTEGER NBQRF * INTEGER IMPR,IRET * INTEGER NBDQR,INBDQR * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrfs' * * Initialisation du segment contenant les infos sur les QUAFS * de référence * NBQRF=0 SEGINI MYQRFS * * On initialise les QUAFs de référence de dimension 1 (segments) * CALL INQRSE(MYQRFS,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * On initialise les éléments de référence de dimension 2 * de forme géométrique triangulaire. * CALL INQRTR(MYQRFS,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * On initialise les éléments de référence de dimension 2 * de forme géométrique carrée. * CALL INQRQU(MYQRFS,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * On initialise les éléments de référence de dimension 3 * de forme géométrique tétraèdrique. * CALL INQRTE(MYQRFS,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * On initialise les éléments de référence de dimension 3 * de forme géométrique pyramidale. * CALL INQRPY(MYQRFS,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * On initialise les éléments de référence de dimension 3 * de forme géométrique prismatique à base triangle. * CALL INQRPR(MYQRFS,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * On initialise les éléments de référence de dimension 3 * de forme géométrique cubique. * CALL INQRCU(MYQRFS,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * Impression finale * NBDQR=MYQRFS.LISQRF(/1) IF (IMPR.GT.1) THEN DO 3 INBDQR=1,NBDQR WRITE(IOIMP,*) 'Quaf. de référence ',INBDQR QRCOUR=MYQRFS.LISQRF(INBDQR) CALL PRQRF(QRCOUR,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 3 CONTINUE ENDIF SEGDES MYQRFS * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine inqrfs' RETURN * * End of subroutine INQRFS * END