Télécharger procpn.eso

Retour à la liste

Numérotation des lignes :

  1. C PROCPN SOURCE CHAT 11/05/04 21:17:53 6963
  2. SUBROUTINE PROCPN(IAREA,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. -INC CCOPTIO
  5. SAVE LINDEX,ISTAT,IULEPR,ISTAT2
  6. CHARACTER*(*) IAREA,IRET
  7. DIMENSION INDEX (6)
  8. DIMENSION NAME(2)
  9. CHARACTER*8 INDIX (6)
  10. SEGMENT MUTIL
  11. CHARACTER*8 MNOM(LLON),MDOUB(LLON)
  12. ENDSEGMENT
  13. MUTIL=0
  14. IJKL=0
  15. IDEJA=0
  16. ISTAT=1
  17. READ(34,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2
  18. if (iostat.ne.0) goto 1000
  19. LLON=(IND2-IND1+1 )*5
  20. SEGINI MUTIL
  21. ISTAT=0
  22. DO 1 I=IND1,IND2
  23. READ(34,REC=I,FMT=101,IOSTAT=IOSTAT)(INDIX(K),INDEX(K),K=1,5)
  24. if (iostat.ne.0) goto 9998
  25. DO 2 K=1,5
  26. IJKL=IJKL+1
  27. MNOM(IJKL)=INDIX(K)
  28. if(indix(k).ne.' ')then
  29. CALL NOMOBJ('PROCEDUR',INDIX(K),-INDEX(K))
  30. * write(6,*) ' nomobj 1 de la procedur ' , indix(k)
  31. endif
  32. 2 CONTINUE
  33. 1 CONTINUE
  34. ISTAT2=1
  35. READ(36,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2
  36. if (iostat.ne.0) goto 9998
  37. ISTAT2=0
  38. DO 3 I=IND1,IND2
  39. READ(36,REC=I,FMT=101,IOSTAT=IOSTAT)(INDIX(K),INDEX(K),K=1,5)
  40. if (iostat.ne.0) goto 9998
  41. DO 4 K=1,5
  42. IF(INDIX(K).EQ.' ' ) GO TO 4
  43. DO 40 LIOP=1,IJKL
  44. IF(MNOM(LIOP).EQ.INDIX(K)) THEN
  45. IDEJA=IDEJA+1
  46. MDOUB(IDEJA)=INDIX(K)
  47. GO TO 41
  48. ENDIF
  49. 40 CONTINUE
  50. 41 CONTINUE
  51. IQQ = -(INDEX(K)+1000000)
  52. if( indix(k).ne.' ') then
  53. * write(6,*) ' nomobj 2 de la procedur ' , indix(k)
  54. CALL NOMOBJ('PROCEDUR',INDIX(K),IQQ)
  55. endif
  56. 4 CONTINUE
  57. 3 CONTINUE
  58. IF(IDEJA.NE.0) THEN
  59. CALL ERREUR (-302)
  60. DO 42 IKL = 1,IDEJA,4
  61. MOTERR=' '
  62. IFI=MIN(IKL+3,IDEJA)-IKL +1
  63. DO 43 ILK=1,IFI
  64. MOTERR((ILK-1)*9+2:ILK*9)=MDOUB(IKL-1+ILK)
  65. 43 CONTINUE
  66. WRITE(IOIMP,*) MOTERR(1:40)
  67. 42 CONTINUE
  68. ENDIF
  69. IRET='9999'
  70. 9998 CONTINUE
  71. IF(MUTIL.NE.0) SEGSUP MUTIL
  72. 1000 RETURN
  73. ENTRY PROCPO(JINDEX,IRET)
  74. IRET='0'
  75. IF (ISTAT*ISTAT2.EQ.1) RETURN
  76. IULEPR=34
  77. LINDEX=JINDEX+1
  78. IF(JINDEX.GT.1000000) THEN
  79. IULEPR=36
  80. LINDEX=JINDEX+1 -1000000
  81. ENDIF
  82. IRET='9999'
  83. RETURN
  84. ENTRY PROCLI(IAREA,IRET)
  85. IRET='9999'
  86. IF (ISTAT*ISTAT2.EQ.1) RETURN
  87. IRET='0'
  88. READ(IULEPR,REC=LINDEX,FMT=102,IOSTAT=IOSTAT)IAREA
  89. if (iostat.ne.0) goto 1000
  90. IF(IAREA(1:4).EQ.'$$$$')IRET='9999'
  91. LINDEX=LINDEX+1
  92. RETURN
  93. ENTRY PROCL2(IAREA,IRET)
  94. IRET='0'
  95. IF(ISTAT2.NE.0) go to 12
  96. READ(36,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2
  97. if (iostat.ne.0) goto 1000
  98. DO 110 I=IND1,IND2
  99. READ(36,REC=I,FMT=101,IOSTAT=IOSTAT)(INDIX(K),INDEX(K),K=1,5)
  100. if (iostat.ne.0) goto 1000
  101. DO 220 K=1,5
  102. IF(INDIX(K).EQ.IAREA(1:8)) THEN
  103. IRET='9998'
  104. LINDEX=INDEX(K)+1
  105. IULEPR=36
  106. GO TO 10
  107. ENDIF
  108. 220 CONTINUE
  109. 110 CONTINUE
  110. 12 CONTINUE
  111. IF (ISTAT.NE.0) return
  112. READ(34,REC=1,FMT=100,IOSTAT=IOSTAT)IND1,IND2
  113. if (iostat.ne.0) goto 1000
  114. DO 11 I=IND1,IND2
  115. READ(34,REC=I,FMT=101,IOSTAT=IOSTAT)(INDIX(K),INDEX(K),K=1,5)
  116. if (iostat.ne.0) goto 1000
  117. DO 22 K=1,5
  118. IF(INDIX(K).EQ.IAREA(1:8)) THEN
  119. IRET='9999'
  120. LINDEX=INDEX(K)+1
  121. IULEPR=34
  122. GO TO 10
  123. ENDIF
  124. 22 CONTINUE
  125. 11 CONTINUE
  126. 10 RETURN
  127. 100 FORMAT (2I6)
  128. 101 FORMAT(5(A8,I6))
  129. 102 FORMAT(A72)
  130. END
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  

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