filrf
C FILRF SOURCE GOUNAND 21/06/02 21:15:57 11022 $ MYLRF, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : FILRF C PROJET : Noyau linéaire NLIN C DESCRIPTION : Cherche un élément de référence dans une liste C d'éléments, connaissant son nom. 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) : OOOETA C APPELE PAR : KALPBG, FILFAL, INELCU, INELPR C*********************************************************************** C ENTREES : NMLRF, MYLRFS C ENTREES/SORTIES : - C SORTIES : MYLRF C*********************************************************************** C VERSION : v1, 22/10/99, version initiale C HISTORIQUE : v1, 22/10/99, création 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 PPARAM -INC CCOPTIO -INC TNLIN *-INC SELREF POINTEUR MYLRFS.ELREFS POINTEUR ELCOUR.ELREF POINTEUR MYLRF.ELREF * INTEGER IMPR,IRET * CHARACTER*(*) NMLRF INTEGER LNMLRF INTEGER MPSETA INTEGER ILRFS,NLRFS LOGICAL LFOUND * * Executable statements * IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans filrf' LFOUND=.FALSE. LNMLRF=LEN(NMLRF) CALL OOOETA(MYLRFS,MPSETA,IMOD) IF (MPSETA.NE.1) SEGACT MYLRFS NLRFS=MYLRFS.LISEL(/1) ILRFS=0 1 CONTINUE ILRFS=ILRFS+1 ELCOUR=MYLRFS.LISEL(ILRFS) SEGACT ELCOUR IF (LEN(ELCOUR.NOMLRF).EQ.LNMLRF) THEN IF (ELCOUR.NOMLRF.EQ.NMLRF) THEN LFOUND=.TRUE. ENDIF ENDIF SEGDES ELCOUR IF (.NOT.LFOUND.AND.ILRFS.LT.NLRFS) GOTO 1 IF (LFOUND) THEN MYLRF=ELCOUR ELSE WRITE(IOIMP,*) 'On n''a pas trouvé ',NMLRF, $ 'dans les éléments finis' GOTO 9999 ENDIF IF (MPSETA.NE.1) SEGDES MYLRFS * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine filrf' RETURN * * End of subroutine filrf * END
© Cast3M 2003 - Tous droits réservés.
Mentions légales