C INQRSE SOURCE CHAT 07/10/29 21:21:03 5940 SUBROUTINE INQRSE(MYQRFS,IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : INQRSE C PROJET : Noyau linéaire NLIN C DESCRIPTION : 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 APPELE PAR : C*********************************************************************** C ENTREES : - C ENTREES/SORTIES : C SORTIES : - 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 -INC CCGEOME 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 NDIMQR,NBNOQR -INC SMELEME POINTEUR MYMEL.MELEME POINTEUR SOUMEL.MELEME INTEGER NBNN,NBELEM,NBSOUS,NBREF * INTEGER IMPR,IRET * REAL*8 ZERO,UN PARAMETER (ZERO=0.D0,UN=1.D0) * INTEGER NUMER * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inqrse' * * Elément QUAF SEG3 * NDIMQR=1 NBNOQR=3 SEGINI QRCOUR * Numéro de l'élément géométrique dans NOMS * NOMS(1:NOMBR) sont les noms des types d'éléments géométriques, * cf. include CCGEOME CALL FICH4('SEG3',NOMS,NOMBR, $ NUMER, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 QRCOUR.NUMQUF=NUMER * * Coordonnées des noeuds du QUAF de référence * QRCOUR.XCONQR(1,1)=-UN QRCOUR.XCONQR(1,2)=ZERO QRCOUR.XCONQR(1,3)=UN * * Numero du centre * QRCOUR.NUCENT=2 * * Faces du SEG3 : 2 POI1 * * Chapeau NBNN=0 NBELEM=0 NBSOUS=1 NBREF=0 SEGINI MYMEL * Faces SEG3 NBNN=3 NBELEM=3 NBSOUS=0 NBREF=0 SEGINI SOUMEL CALL FICH4('POI1',NOMS,NOMBR, $ NUMER, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SOUMEL.ITYPEL=NUMER * Face 1 SOUMEL.NUM(1,1)=1 * Face 2 SOUMEL.NUM(1,2)=3 SEGDES SOUMEL MYMEL.LISOUS(1)=SOUMEL SEGDES MYMEL QRCOUR.LFACE=MYMEL * * Pas de faces pour un segment * SEGDES QRCOUR MYQRFS.LISQRF(**)=QRCOUR * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine inqrse' RETURN * * End of subroutine INQRSE * END