sufpgs
C SUFPGS SOURCE GOUNAND 21/06/02 21:17:46 11022 IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : SUFPGS C PROJET : Noyau linéaire NLIN C DESCRIPTION : Supprimme le segment contenant les informations sur C l'ensemble des familles de méthodes d'intégration 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 APPELE PAR : C*********************************************************************** C ENTREES : C ENTREES/SORTIES : - C SORTIES : C TRAVAIL : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 19/12/02, version initiale C HISTORIQUE : v1, 19/12/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 PPARAM -INC CCOPTIO -INC TNLIN *-INC SFAPG POINTEUR MYFPGS.FAPGS POINTEUR MYFPG.FAPG * INTEGER IMPR,IRET * INTEGER NBFAPG,IBFAPG * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans sufpgs' SEGACT MYFPGS*MOD NBFAPG=MYFPGS.LISFPG(/1) DO IBFAPG=1,NBFAPG MYFPG=MYFPGS.LISFPG(IBFAPG) IF (MYFPG.NE.0) THEN * SEGACT MYFPG*MOD SEGSUP MYFPG ENDIF ENDDO SEGSUP MYFPGS * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine sufpgs' RETURN * * End of subroutine SUFPGS * END
© Cast3M 2003 - Tous droits réservés.
Mentions légales