C FILFPG SOURCE CHAT 07/10/29 21:19:46 5940 SUBROUTINE FILFPG(FAL,MYPGS,CQUAF,CPG,IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : FILFPG C PROJET : Noyau linéaire NLIN C DESCRIPTION : Remplit l'indice d'un segment décrivant une famille C 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 : FICH4, FIPG (recherche dans une liste) C APPELE PAR : INFPGS C*********************************************************************** C ENTREES : * MYPGS (type POGAUS) : segment de description C des éléments de références. C * CQUAF (type CH*(*)) :nom d'un élément QUAF. C * CPG (type CH*(*)) :nom d'une méthode C d'intégration C (cf. NOMPG dans SPOGAU.INC) C ENTREES/SORTIES : * FAL (type FALRF) : famille courante. C SORTIES : - C TRAVAIL : * MYPG (type ELREF) : élément fini courant. C * NUMER (type ENTIER) : numéro correspondant à C CQUAF dans le tableau NOMS (cf. include C CCOPTIO) C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 16/07/02, version initiale C HISTORIQUE : v1, 16/07/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 SPOGAU SEGMENT POGAU CHARACTER*(LNNPG) NOMPG CHARACTER*(LNTPG) TYPMPG CHARACTER*(LNFPG) FORLPG INTEGER NORDPG REAL*8 XCOPG(NDLPG,NBPG) REAL*8 XPOPG(NBPG) ENDSEGMENT SEGMENT POGAUS POINTEUR LISPG(0).POGAU ENDSEGMENT CENDINCLUDE SPOGAU POINTEUR MYPGS.POGAUS POINTEUR MYPG.POGAU CBEGININCLUDE SFAPG SEGMENT FAPG CHARACTER*(LNNFAP) NOMFAP INTEGER NBQUAF(NBMPG) POINTEUR MPOGAU(NBMPG).POGAU ENDSEGMENT SEGMENT FAPGS POINTEUR LISFPG(0).FAPG ENDSEGMENT CENDINCLUDE SFAPG INTEGER LNNFAP,NBMPG POINTEUR FAL.FAPG * CHARACTER*(*) CQUAF,CPG * INTEGER IMPR,IRET * INTEGER NUMER * * Executable statements * IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans filfpg' * On ajuste la dimension du segment pour rajouter une paire * d'éléments LNNFAP=FAL.NOMFAP(/1) NBMPG=FAL.NBQUAF(/1)+1 SEGADJ,FAL * 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(CQUAF,NOMS,NOMBR, $ NUMER, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 FAL.NBQUAF(NBMPG)=NUMER * Numéro de l'élément fini dans le segment POGAUS CALL FIPG(CPG,MYPGS, $ MYPG, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 FAL.MPOGAU(NBMPG)=MYPG * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine filfpg' RETURN * * End of subroutine filfpg * END