fipg
C FIPG SOURCE GOUNAND 21/06/02 21:15:58 11022 $ MYPG, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : FIPG C PROJET : Noyau linéaire NLIN C DESCRIPTION : Cherche une méthode d'intégration dans une liste de C méthodes d'intégration, 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, INGATR, INGATE, INGAPR C*********************************************************************** C ENTREES : NMPG, MYPGS C ENTREES/SORTIES : - C SORTIES : MYPG 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 SPOGAU POINTEUR MYPGS.POGAUS POINTEUR PGCOUR.POGAU POINTEUR MYPG.POGAU * INTEGER IMPR,IRET * CHARACTER*(*) NMPG INTEGER LNMPG INTEGER MPSETA INTEGER IMETH,NMETH LOGICAL LFOUND * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans fipg' LFOUND=.FALSE. LNMPG=LEN(NMPG) CALL OOOETA(MYPGS,MPSETA,IMOD) IF (MPSETA.NE.1) SEGACT MYPGS NMETH=MYPGS.LISPG(/1) IMETH=0 1 CONTINUE IMETH=IMETH+1 PGCOUR=MYPGS.LISPG(IMETH) SEGACT PGCOUR IF (LEN(PGCOUR.NOMPG).EQ.LNMPG) THEN IF (PGCOUR.NOMPG.EQ.NMPG) THEN LFOUND=.TRUE. ENDIF ENDIF c SEGDES PGCOUR IF (.NOT.LFOUND.AND.IMETH.LT.NMETH) GOTO 1 IF (LFOUND) THEN MYPG=PGCOUR ELSE WRITE(IOIMP,*) 'On n''a pas trouvé ',NMPG, $ 'dans les méthodes d''intégration' GOTO 9999 ENDIF c IF (MPSETA.NE.1) SEGDES MYPGS * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine fipg' RETURN * * End of subroutine fipg * END
© Cast3M 2003 - Tous droits réservés.
Mentions légales