Esope source files

   1 : C NOMINC    SOURCE    CHAT      05/01/13    01:58:48     5004           
   2 :       SUBROUTINE NOMINC(NBCMP,INCO,
   3 :      $        NOMCIN,
   4 :      $        IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : NOMINC
   9 : C PROJET      : Noyau linéaire NLIN
  10 : C DESCRIPTION : On a un nom d'inconnue et un nombre de composantes.
  11 : C               On construit le LISTMOTS des noms des composantes.
  12 : C               Par exemple : NBCMP=1 ; INCO='UN      '
  13 : C                       =>    NOMCIN='1UN     '
  14 : C
  15 : C LANGAGE     : FORTRAN 77 (sauf E/S)
  16 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17 : C               mél : gounand@semt2.smts.cea.fr
  18 : C***********************************************************************
  19 : C APPELES          : -
  20 : C APPELE PAR       : NI
  21 : C***********************************************************************
  22 : C ENTREES            : NBCMP, INCO
  23 : C ENTREES/SORTIES    : -
  24 : C SORTIES            : NOMCIN
  25 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26 : C***********************************************************************
  27 : C VERSION    : v1, 03/09/99, version initiale
  28 : C HISTORIQUE : v1, 03/09/99, création
  29 : C HISTORIQUE :
  30 : C HISTORIQUE :
  31 : C***********************************************************************
  32 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33 : C en cas de modification de ce sous-programme afin de faciliter
  34 : C la maintenance !
  35 : C***********************************************************************
  36 : -INC CCOPTIO
  37 : *
  38 :       INTEGER IMPR,IRET
  39 : *
  40 :       INTEGER NBCMP,INBCMP
  41 :       INTEGER LINCO
  42 :       CHARACTER*(*) INCO
  43 :       CHARACTER*8 INCO8,SPACE8
  44 :       CHARACTER*8 NOMCIN(NBCMP)
  45 : *      
  46 : *     
  47 : * Executable statements
  48 : *
  49 :       IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans nominc'
  50 : *
  51 : * On impose le nom de l'inconnue à 8 lettres
  52 : *
  53 :       SPACE8='        '
  54 :       LINCO=LEN(INCO)
  55 :       IF (LINCO.GE.8) THEN
  56 :          INCO8=INCO(1:8)
  57 :       ELSEIF (LINCO.GE.0.AND.LINCO.LT.8) THEN
  58 :          INCO8=INCO(1:LINCO)//SPACE8(LINCO+1:8)
  59 :       ELSE
  60 :          WRITE(IOIMP,*) 'Erreur : LINCO.LT.0'
  61 :          GOTO 9999
  62 :       ENDIF
  63 :       IF (NBCMP.LE.0) THEN
  64 :          WRITE(IOIMP,*) 'Nombre de composantes : ',NBCMP,
  65 :      $        ' inférieur à 0'
  66 :          GOTO 9999
  67 :       ELSEIF (NBCMP.LE.1) THEN
  68 :          NOMCIN(1)=INCO8
  69 :       ELSEIF (NBCMP.LE.9) THEN
  70 :          DO 1 INBCMP=1,NBCMP
  71 :             WRITE(NOMCIN(INBCMP),FMT='(I1,A7)') INBCMP,INCO8(1:7)
  72 :  1       CONTINUE
  73 :       ELSEIF (NBCMP.LE.99) THEN
  74 :          DO 2 INBCMP=1,NBCMP
  75 :             WRITE(NOMCIN(INBCMP),FMT='(I2,A6)') INBCMP,INCO8(1:6)
  76 :  2       CONTINUE
  77 :       ELSEIF (NBCMP.LE.999) THEN
  78 :          DO 3 INBCMP=1,NBCMP
  79 :             WRITE(NOMCIN(INBCMP),FMT='(I3,A5)') INBCMP,INCO8(1:5)
  80 :  3       CONTINUE
  81 :       ELSEIF (NBCMP.LE.9999) THEN
  82 :          DO 4 INBCMP=1,NBCMP
  83 :             WRITE(NOMCIN(INBCMP),FMT='(I4,A4)') INBCMP,INCO8(1:4)
  84 :  4       CONTINUE
  85 :       ELSEIF (NBCMP.LE.99999) THEN
  86 :          DO 5 INBCMP=1,NBCMP
  87 :             WRITE(NOMCIN(INBCMP),FMT='(I5,A3)') INBCMP,INCO8(1:3)
  88 :  5       CONTINUE
  89 :       ELSE
  90 :          WRITE(IOIMP,*) 'Nombre de composantes : ',NBCMP,
  91 :      $        ' trop grand...'
  92 :          GOTO 9999
  93 :       ENDIF
  94 : *
  95 : * Normal termination
  96 : *
  97 :       IRET=0
  98 :       RETURN
  99 : *
 100 : * Format handling
 101 : *
 102 : *
 103 : * Error handling
 104 : *
 105 :  9999 CONTINUE
 106 :       IRET=1
 107 :       WRITE(IOIMP,*) 'An error was detected in subroutine nominc'
 108 :       RETURN
 109 : *
 110 : * End of subroutine NOMINC
 111 : *
 112 :       END
 113 : 
 114 :  
 115 :