Télécharger inierr.eso

Retour à la liste

Numérotation des lignes :

  1. C INIERR SOURCE CHAT 06/03/16 21:19:05 5336
  2. *
  3. * INITIALISATION DES SEGMENTS DES ERREURS ET AUTRES MESSAGES
  4. *
  5. SUBROUTINE INIERR
  6. IMPLICIT INTEGER(I-N)
  7. -INC CCNOYAU
  8. -INC CCOPTIO
  9. external long
  10. CHARACTER*4 MLAN
  11. CHARACTER*80 CHTMP1,CHTMP2
  12. LEPETI=1000000
  13. NMESSA=0
  14. iprec=0
  15. 10 CONTINUE
  16. READ (35,FMT='(I4,1X,I1,1X,A4/,A80)',ERR=102,END=900)
  17. $ I,J,MLAN,CHTMP1
  18. 15 CONTINUE
  19. IF(I.EQ.9995) THEN
  20. LANGUE=CHTMP1(1:4)
  21. GO TO 10
  22. ENDIF
  23. IF(I.EQ.9996) GO TO 900
  24. IF(I.EQ.9999) GOTO 10
  25. IF(I.EQ.9998) THEN
  26. NLANG=0
  27. DO 58 MP=1,14
  28. IF(CHTMP1(MP*5-4:MP*5-1).EQ.' ') GO TO 59
  29. NLANG=NLANG+1
  30. 58 CONTINUE
  31. 59 CONTINUE
  32. NMESS=1000
  33. SEGINI MESSER
  34. DO 56 MP=1,NLANG
  35. LANGUA(MP)= CHTMP1(MP*5-4:MP*5-1)
  36. 56 CONTINUE
  37. LANGUE=LANGUA(1)
  38. GO TO 10
  39. ENDIF
  40. IF(I.EQ.9997) THEN
  41. DO 57 MP=1,NLANG
  42. ILAN=MP
  43. IF(CHTMP1(1:4).EQ.LANGUA(MP)) THEN
  44. IF(ILAN.NE.1) THEN
  45. IDEB=1
  46. ENDIF
  47. GO TO 10
  48. ENDIF
  49. 57 CONTINUE
  50. WRITE(IOIMP,54)
  51. 54 FORMAT(' ERREUR DE LANGUE DANS LE FICHIER D''ERREUR')
  52. NMESS=0
  53. SEGADJ MESSER
  54. RETURN
  55. ENDIF
  56. IF(ILAN.EQ.1) THEN
  57. NMESSA=NMESSA+1
  58. IFIN=NMESSA
  59. IF (NMESSA.GT.NMESS) THEN
  60. NMESS=NMESS+1000
  61. SEGADJ MESSER
  62. ENDIF
  63. ELSE
  64. *
  65. * on commence par chercher la position dans le tableau
  66. *
  67. DO 210 IO = IDEB,IFIN
  68. IF(I.EQ.NUMERR(IO) ) THEN
  69. NMESSA=IO
  70. IDEB=IO
  71. GO TO 211
  72. ENDIF
  73. 210 CONTINUE
  74. WRITE (6,*) 'MESSAGE ',I,' NON TROUVE'
  75. GO TO 100
  76. 211 CONTINUE
  77. ENDIF
  78. NUMERR(NMESSA)=I
  79. if (niverr(nmessa).ne.0.and.niverr(nmessa).ne.j) then
  80. write (ioimp,103) i
  81. 103 format(' ######### INCOHERENCE DE NIVEAU POUR LE MESSAGE ',i6)
  82. endif
  83. NIVERR(NMESSA)=J
  84. LCHER1=LONG(CHTMP1)
  85. iprec=i
  86. I=-9999
  87. READ (35,FMT='(I4,1X,I1,1X,A4/,A80)',ERR=102,END=900)
  88. $ I,J,MLAN,CHTMP2
  89. IF (I.NE.NUMERR(NMESSA)) GOTO 20
  90. LCHER2=LONG(CHTMP2)
  91. SEGINI MCHERR
  92. CHERR1=CHTMP1(1:LCHER1)
  93. CHERR2=CHTMP2(1:LCHER2)
  94. * SEGDES MCHERR
  95.  
  96. IPMESS(NMESSA,ILAN)=MCHERR
  97. GO TO 10
  98. 20 CONTINUE
  99. LCHER2=0
  100. SEGINI MCHERR
  101. CHERR1=CHTMP1(1:LCHER1)
  102. * SEGDES MCHERR
  103. IPMESS(NMESSA,ILAN)=MCHERR
  104. CHTMP1=CHTMP2
  105. IF (I.NE.-9999) GOTO 15
  106. 900 CONTINUE
  107. NMESS=IFIN
  108. SEGADJ MESSER
  109. * SEGDES MESSER
  110. * SEGACT MESSER
  111. RETURN
  112. 102 WRITE(IOIMP,*) ' IPREC,I,J ',IPREC,I,J,' ==>'
  113. 100 WRITE(IOIMP,101)
  114. 101 FORMAT(' ERREUR DANS LA LECTURE DU FICHIER ERREUR||| ')
  115. NMESS=IFIN-1
  116. SEGADJ MESSER
  117. RETURN
  118. END
  119.  
  120.  

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