C SULRFS SOURCE GOUNAND 05/12/21 21:36:39 5281 SUBROUTINE SULRFS(MYLRFS,IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : SULRFS C PROJET : Noyau linéaire NLIN C DESCRIPTION : Supprimme le segment contenant les informations sur C l'ensemble des éléments de référence. 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) : C APPELE PAR : C*********************************************************************** C ENTREES : - C SORTIES : 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 CCOPTIO CBEGININCLUDE SELREF SEGMENT ELREF CHARACTER*(LNNOM) NOMLRF CHARACTER*(LNFORM) FORME CHARACTER*(LNTYPL) TYPEL CHARACTER*(LNESP) ESPACE INTEGER DEGRE REAL*8 XCONOD(NDIMEL,NBNOD) INTEGER NPQUAF(NBDDL) INTEGER NUMCMP(NBDDL) INTEGER QUENOD(NBDDL) INTEGER ORDDER(NDIMEL,NBDDL) POINTEUR MBPOLY.POLYNS ENDSEGMENT SEGMENT ELREFS POINTEUR LISEL(0).ELREF ENDSEGMENT CENDINCLUDE SELREF POINTEUR MYLRFS.ELREFS POINTEUR MYLRF.ELREF CBEGININCLUDE SPOLYNO SEGMENT POLYNO REAL*8 COEMON(NBMON) INTEGER EXPMON(NDIML,NBMON) ENDSEGMENT SEGMENT POLYNS POINTEUR LIPOLY(NBPOLY).POLYNO ENDSEGMENT CENDINCLUDE SPOLYNO POINTEUR MYPOLS.POLYNS POINTEUR MYPOL.POLYNO * INTEGER IMPR,IRET * INTEGER NBELRF,NBPOLY INTEGER IBELRF,IBPOLY * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans sulrfs' SEGACT MYLRFS*MOD NBELRF=MYLRFS.LISEL(/1) DO IBELRF=1,NBELRF MYLRF=MYLRFS.LISEL(IBELRF) IF (MYLRF.NE.0) THEN SEGACT MYLRF*MOD MYPOLS=MYLRF.MBPOLY IF (MYPOLS.NE.0) THEN SEGACT MYPOLS*MOD NBPOLY=MYPOLS.LIPOLY(/1) DO IBPOLY=1,NBPOLY MYPOL=MYPOLS.LIPOLY(IBPOLY) * SEGACT MYPOL*MOD IF (MYPOL.NE.0) THEN SEGSUP MYPOL ENDIF ENDDO SEGSUP MYPOLS ENDIF SEGSUP MYLRF ENDIF ENDDO SEGSUP MYLRFS * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine sulrfs' RETURN * * End of subroutine SULRFS * END