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

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