C NOMINC SOURCE CHAT 05/01/13 01:58:48 5004 SUBROUTINE NOMINC(NBCMP,INCO, $ NOMCIN, $ IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : NOMINC C PROJET : Noyau linéaire NLIN C DESCRIPTION : On a un nom d'inconnue et un nombre de composantes. C On construit le LISTMOTS des noms des composantes. C Par exemple : NBCMP=1 ; INCO='UN ' C => NOMCIN='1UN ' C C LANGAGE : FORTRAN 77 (sauf E/S) C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : - C APPELE PAR : NI C*********************************************************************** C ENTREES : NBCMP, INCO C ENTREES/SORTIES : - C SORTIES : NOMCIN C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 03/09/99, version initiale C HISTORIQUE : v1, 03/09/99, 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 * INTEGER IMPR,IRET * INTEGER NBCMP,INBCMP INTEGER LINCO CHARACTER*(*) INCO CHARACTER*8 INCO8,SPACE8 CHARACTER*8 NOMCIN(NBCMP) * * * Executable statements * IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans nominc' * * On impose le nom de l'inconnue à 8 lettres * SPACE8=' ' LINCO=LEN(INCO) IF (LINCO.GE.8) THEN INCO8=INCO(1:8) ELSEIF (LINCO.GE.0.AND.LINCO.LT.8) THEN INCO8=INCO(1:LINCO)//SPACE8(LINCO+1:8) ELSE WRITE(IOIMP,*) 'Erreur : LINCO.LT.0' GOTO 9999 ENDIF IF (NBCMP.LE.0) THEN WRITE(IOIMP,*) 'Nombre de composantes : ',NBCMP, $ ' inférieur à 0' GOTO 9999 ELSEIF (NBCMP.LE.1) THEN NOMCIN(1)=INCO8 ELSEIF (NBCMP.LE.9) THEN DO 1 INBCMP=1,NBCMP WRITE(NOMCIN(INBCMP),FMT='(I1,A7)') INBCMP,INCO8(1:7) 1 CONTINUE ELSEIF (NBCMP.LE.99) THEN DO 2 INBCMP=1,NBCMP WRITE(NOMCIN(INBCMP),FMT='(I2,A6)') INBCMP,INCO8(1:6) 2 CONTINUE ELSEIF (NBCMP.LE.999) THEN DO 3 INBCMP=1,NBCMP WRITE(NOMCIN(INBCMP),FMT='(I3,A5)') INBCMP,INCO8(1:5) 3 CONTINUE ELSEIF (NBCMP.LE.9999) THEN DO 4 INBCMP=1,NBCMP WRITE(NOMCIN(INBCMP),FMT='(I4,A4)') INBCMP,INCO8(1:4) 4 CONTINUE ELSEIF (NBCMP.LE.99999) THEN DO 5 INBCMP=1,NBCMP WRITE(NOMCIN(INBCMP),FMT='(I5,A3)') INBCMP,INCO8(1:3) 5 CONTINUE ELSE WRITE(IOIMP,*) 'Nombre de composantes : ',NBCMP, $ ' trop grand...' GOTO 9999 ENDIF * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine nominc' RETURN * * End of subroutine NOMINC * END