Télécharger inierr.eso

Retour à la liste

Numérotation des lignes :

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

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