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. -INC CCOPTIO
  29.  
  30. CHARACTER STRING(ILONGS)
  31. INTEGER ILONGS,NUMERO
  32.  
  33. CHARACTER*4 STRFOR
  34. CHARACTER*4 TEMPOR
  35.  
  36. C ... INUFIN = longueur réelle de STRING (sans blancs à la fin) ...
  37.  
  38. INUFIN = 0
  39. DO 1000 I=ILONGS,1,-1
  40. IF(STRING(I).NE.' ') THEN
  41. INUFIN=I
  42. GOTO 1001
  43. ENDIF
  44. 1000 CONTINUE
  45. 1001 CONTINUE
  46.  
  47. C ... ILONGN = longueur de la représentation alphanumérique de NUMERO ...
  48.  
  49. IF (NUMERO.GE.1.AND.NUMERO.LE.9) THEN
  50. ILONGN=1
  51. ELSEIF (NUMERO.GE.10.AND.NUMERO.LE.99) THEN
  52. ILONGN=2
  53. ELSEIF (NUMERO.GE.100.AND.NUMERO.LE.999) THEN
  54. ILONGN=3
  55. ELSEIF (NUMERO.GE.1000.AND.NUMERO.LE.9999) THEN
  56. ILONGN=4
  57. ELSE
  58. WRITE(IOIMP,*) 'AJNUME : ERREUR ! Mauvais numéro !'
  59. RETURN
  60. ENDIF
  61.  
  62. C ... IPOSEC = position à laquelle on écrira le numéro ...
  63.  
  64. IF(ILONGN.GT.ILONGS) THEN
  65. WRITE(IOIMP,*) 'AJNUME : ERREUR ! Pas assez de place dans'
  66. & // ' STRING !'
  67. RETURN
  68. ELSE
  69. IPOSEC = ILONGS - ILONGN + 1
  70. IF(IPOSEC.GT.INUFIN+1) THEN
  71. IPOSEC = INUFIN + 1
  72. ENDIF
  73. ENDIF
  74.  
  75. C ... L'écriture elle même ...
  76.  
  77. WRITE(STRFOR,8000) ILONGN
  78. WRITE(TEMPOR,STRFOR) NUMERO
  79. STRING(IPOSEC)(1:ILONGN)=TEMPOR
  80.  
  81. RETURN
  82. 8000 FORMAT('(I',I1,')')
  83. END
  84.  
  85.  

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