Télécharger ajnume.eso

Retour à la liste

Numérotation des lignes :

  1. C AJNUME SOURCE CHAT 05/01/12 21:19:49 5004
  2. SUBROUTINE AJNUME(STRING,ILONGS,NUMERO)
  3.  
  4. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C
  6. C But : AJouter une représentation NUMÉrique d'un nombre
  7. C entier NUMERO à la chaîne de caractères STRING de
  8. C longueur ILONGS. On en a besoin lors de la lecture
  9. C d'un fichier AVS qui peut contenir des champs vectoriels
  10. C ou tensoriels (plusieurs composantes portent le même
  11. C nom). Sans AJNUME il seraît impossible d'accéder (en
  12. C GIBIANE) aux certaines des composantes du champ lu.
  13. C
  14. C Paramètres :
  15. C
  16. C STRING : la chaîne de caractères à modifier (entrée-sortie)
  17. C ILONGS : la longueur de STRING (entrée)
  18. C NUMERO : le nombre à rajouter à la chaîne STRING (entrée)
  19. C
  20. C Auteur : Michel Bulik
  21. C Octobre 1994
  22. C
  23. C Appelé par : LIRAVS
  24. C
  25. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  26.  
  27. IMPLICIT INTEGER(I-N)
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31.  
  32. CHARACTER STRING(ILONGS)
  33. INTEGER ILONGS,NUMERO
  34.  
  35. CHARACTER*4 STRFOR
  36. CHARACTER*4 TEMPOR
  37.  
  38. C ... INUFIN = longueur réelle de STRING (sans blancs à la fin) ...
  39.  
  40. INUFIN = 0
  41. DO 1000 I=ILONGS,1,-1
  42. IF(STRING(I).NE.' ') THEN
  43. INUFIN=I
  44. GOTO 1001
  45. ENDIF
  46. 1000 CONTINUE
  47. 1001 CONTINUE
  48.  
  49. C ... ILONGN = longueur de la représentation alphanumérique de NUMERO ...
  50.  
  51. IF (NUMERO.GE.1.AND.NUMERO.LE.9) THEN
  52. ILONGN=1
  53. ELSEIF (NUMERO.GE.10.AND.NUMERO.LE.99) THEN
  54. ILONGN=2
  55. ELSEIF (NUMERO.GE.100.AND.NUMERO.LE.999) THEN
  56. ILONGN=3
  57. ELSEIF (NUMERO.GE.1000.AND.NUMERO.LE.9999) THEN
  58. ILONGN=4
  59. ELSE
  60. WRITE(IOIMP,*) 'AJNUME : ERREUR ! Mauvais numéro !'
  61. RETURN
  62. ENDIF
  63.  
  64. C ... IPOSEC = position à laquelle on écrira le numéro ...
  65.  
  66. IF(ILONGN.GT.ILONGS) THEN
  67. WRITE(IOIMP,*) 'AJNUME : ERREUR ! Pas assez de place dans'
  68. & // ' STRING !'
  69. RETURN
  70. ELSE
  71. IPOSEC = ILONGS - ILONGN + 1
  72. IF(IPOSEC.GT.INUFIN+1) THEN
  73. IPOSEC = INUFIN + 1
  74. ENDIF
  75. ENDIF
  76.  
  77. C ... L'écriture elle même ...
  78.  
  79. WRITE(STRFOR,8000) ILONGN
  80. WRITE(TEMPOR,STRFOR) NUMERO
  81. STRING(IPOSEC)(1:ILONGN)=TEMPOR
  82.  
  83. RETURN
  84. 8000 FORMAT('(I',I1,')')
  85. END
  86.  
  87.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales