Télécharger inierr.eso

Retour à la liste

Numérotation des lignes :

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

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