C FICOMP SOURCE GOUNAND 21/06/02 21:15:53 11022 SUBROUTINE FICOMP(CNOM,MYCOMS, $ MYCOM, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : FICOMP C PROJET : Noyau linéaire NLIN C DESCRIPTION : Cherche les infos sur une loi de comportement par son C 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 : OOOETA (état d'un segment) C APPELE PAR : C*********************************************************************** C ENTREES : C C SORTIES : C*********************************************************************** C VERSION : v1, 10/05/04, version initiale C HISTORIQUE : v1, 10/05/04, 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 SLCOMP POINTEUR MYCOMS.COMPS POINTEUR COCOUR.COMP POINTEUR MYCOM.COMP * INTEGER IMPR,IRET * CHARACTER*(*) CNOM INTEGER LCNOM INTEGER MCSETA INTEGER ICOMPS,NCOMPS LOGICAL LFOUND * * Executable statements * IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans ficomp' LFOUND=.FALSE. LCNOM=LEN(CNOM) * On veut laisser MYCOMS dans le même état (actif, inactif) qu'avant * l'appel à FICOMP. CALL OOOETA(MYCOMS,MCSETA,IMOD) IF (MCSETA.NE.1) SEGACT MYCOMS NCOMPS=MYCOMS.LISCOM(/1) ICOMPS=0 * Boucle 1 : repeat...until 1 CONTINUE ICOMPS=ICOMPS+1 COCOUR=MYCOMS.LISCOM(ICOMPS) SEGACT COCOUR IF (COCOUR.NOMCOM(/1).EQ.LCNOM) THEN IF (COCOUR.NOMCOM.EQ.CNOM) THEN LFOUND=.TRUE. ENDIF ENDIF SEGDES COCOUR IF (.NOT.LFOUND.AND.ICOMPS.LT.NCOMPS) GOTO 1 IF (LFOUND) THEN MYCOM=COCOUR ELSE WRITE(IOIMP,*) 'On n''a pas trouvé ',CNOM, $ 'dans les lois de comportement' GOTO 9999 ENDIF IF (MCSETA.NE.1) SEGDES MYCOMS * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine ficomp' RETURN * * End of subroutine ficomp * END