Télécharger repete.eso

Retour à la liste

Numérotation des lignes :

  1. C REPETE SOURCE CB215821 19/01/29 21:15:08 10088
  2. C CET OPERATEUR INITIALISE LA FONCTION REPETER DE GIBIANE
  3. C IL DOIT ETRE SUIVI DU NOM D'UN BLOC REPETER
  4. C SI CE BLOC EXISTE LIRNOM EST DEROUTE POUR LE LIRE
  5. C SI CE BLOC N'EXISTE PAS IL LE CREE ET LIRNOM LE REMPLIT
  6. C A LA PREMIERE INTERPRETATION
  7. C LE BLOC FINI PAR FIN "BLOC"
  8. C
  9. SUBROUTINE REPETE
  10. IMPLICIT INTEGER(I-N)
  11. -INC CCNOYAU
  12. -INC SMBLOC
  13. -INC CCOPTIO
  14. CHARACTER*(8) ICHA,INOM,ITCH
  15. c CHARACTER*(9) ICHB
  16. CHARACTER*(LONOM) ICHC,CNOM
  17. *
  18. CHARACTER*8 IJCH
  19. CHARACTER*4 MFIN(1)
  20. DIMENSION IMOTCO(1)
  21. SAVE IMOTCO
  22. DATA IMOTCO(1)/-1/
  23. DATA MFIN/'FIN '/
  24. LOGICAL TSTMBC
  25. MBC=-1
  26. CALL LIROBJ('BLOC ',MBLO1,0,IREBLO)
  27. if( ireblo.ne.0) imablu=jpoob2(imotlu)
  28. IF(IREBLO.EQ.0) THEN
  29. CALL QUETYP(ICHA,1,IRETOU)
  30. IF(IERR.NE.0) RETURN
  31. c IF(ICHA.EQ.'MOT ') THEN
  32. c CALL LIRCHA(ICHB,1,IRETOU)
  33. c IF(ICHB(9:9).NE.' ') THEN
  34. c CALL ERREUR (315)
  35. c RETURN
  36. c ENDIF
  37. c CNOM=ICHB
  38. c ELSE
  39. CALL LIROBJ(ICHA,IRE,1,IRETOU)
  40. CALL QUENOM(CNOM)
  41. IF(CNOM(1:1).EQ.' ') THEN
  42. CALL ERREUR(315)
  43. RETURN
  44. ENDIF
  45. c ENDIF
  46. ENDIF
  47. CALL LIRENT(MBC,0,IRETOU)
  48. IF (IERR.NE.0) RETURN
  49. * TEST QUE L'INSTRUCTION EST EPUISEE - PROBLEME AVEC LA PRECOMPILATION
  50. * CALL QUETYP(ITCH,0,IRETO)
  51. * IF (IRETO.EQ.0) GOTO 20
  52. * MOTERR(1:8)=ITCH
  53. * CALL LIRABJ(ITCH,IRET,1,IRETO)
  54. * CALL QUENOM(ITCH)
  55. * MOTERR(9:16)=ITCH
  56. * CALL ERREUR(551)
  57. * RETURN
  58. * 20 CONTINUE
  59.  
  60. MDEOBT=MDEOBJ
  61. MFIOBT=MFIOBJ
  62. MBLPRT=MBLPRO
  63. MTXBLC=MTXBL
  64. MARM = MARGUM
  65. IF (MBLSUP.NE.0) SEGDES MTXBLC
  66. ISSPOT=ISPOTE
  67. SEGDES ISSPOT
  68. IRETCO=MOBJCO
  69. SEGDES MBLOC
  70. MTEMP=MBLOC
  71. IF (IREBLO.EQ.0) GOTO 10
  72. C
  73. C LE BLOC REPETER EXISTE DEJA
  74. C
  75. segini,mbloc=MBLO1
  76. iouep2(imablu)=mbloc
  77. SEGACT MBLOC*MOD
  78. ISSPOT=ISPOTE
  79. SEGACT ISSPOT*MOD
  80. * write(6,*) 'ispote ipotem(1) ', ispote, ipotem(1)
  81. MOBJCO=IRETCO
  82. mdecip = mdeobt - mdeobj
  83. do iou=1,ipotem(/1)
  84. ipotem(iou)=ipotem(iou)+mdecip
  85. enddo
  86. MDEOBJ=MDEOBT
  87. MFIOBJ=MFIOBT
  88. MBLPRO=MBLPRT
  89. MBLSUP=MTEMP
  90. MARGUM = MARM
  91. MTXBLC=MTXBL
  92. SEGACT MTXBLC
  93. * ILON= MTXBLC(/1)
  94. MBCOUR=0
  95. MBCONT=MBC
  96. MBFONC=0
  97. MBERR =0
  98.  
  99. C Gestion du SOUCI dans le BLOC (ACTUELLEMENT INUTILISE)
  100. MBSOUC=0
  101.  
  102. ICHC=NCONBO
  103. ICONBO=1
  104. IIPROU=ICONBO
  105. * write(6,*)' bloc2 repete mbloc mdeobj lmnnom',mbloc,mdeobj,lmnnom
  106. CALL NOMENT(ICHC,IIPROU)
  107. TSTMBC=(MBC.EQ.0.AND.LECTAB.EQ.0)
  108. GOTO 100
  109.  
  110. 10 CONTINUE
  111. C
  112. C ON EST EN DEFINITION D'UN NOUVEAU BLOC
  113. C
  114. SEGINI,MBLOC
  115. NVQTEM=20
  116. SEGINI ISSPOT
  117. ISPOTE= ISSPOT
  118. NBNOMM=1200
  119. NINST=1200
  120. IPVINN=3000
  121. SEGINI MTXBLC
  122. NINSTV=0
  123. MTXBL=MTXBLC
  124. MBLSUP=MTEMP
  125. MARGUM = MARM
  126. MBCONT=MBC
  127. MBLPRO=0
  128. MBCOUR=0
  129. MBFONC=1
  130. MBERR =0
  131.  
  132. C Gestion du SOUCI dans le BLOC (ACTUELLEMENT INUTILISE)
  133. MBSOUC=0
  134.  
  135. MDEOBJ=MDEOBT
  136. MFIOBJ=MFIOBT
  137. MOBJCO=IRETCO
  138. * write(6,*) 'creation de bloc mblo mde lmnn',mbloc,mdeobj,lmnnom
  139. CALL NOMOBJ('BLOC ',CNOM,MBLOC)
  140. call savseg (mbloc)
  141. call savseg (ISSPOT)
  142. call savseg(MTXBLC)
  143. ICHC(1:1)='&'
  144. ICHC(2:LONOM)=CNOM(1:LONOM-1)
  145. NCONBO=ICHC
  146. ICONBO=1
  147. IIPROU=ICONBO
  148. CALL NOMENT(ICHC,IIPROU)
  149. TSTMBC=(MBC.EQ.0.AND.MDEOBJ.EQ.1.AND.LECTAB.EQ.0)
  150. *
  151. * CODE QUI PERMET DE NE PAS EXECUTER LE CONTENU DU BLOC REPETER
  152. * SI LA VALEUR INITIALE DU COMPTEUR VAUT ZERO (MBC = 0)
  153. * ATTENTION : CE CODE NE DOIT PAS ETRE EXECUTE SI L'ON EST DANS
  154. * UNE PHASE DE LECTURE GIBIANE SANS INTERPRETATION,
  155. * COMME PAR EXEMPLE LORS DU PREMIER APPEL D'UNE
  156. * PROCEDURE OU LORS DU PASSAGE DANS LA BRANCHE FAUX
  157. * D'UN BLOC SI/SINON/FINS (CELA POUR NE PAS PERTURBER
  158. * LES VERIFICATIONS SUR L'IMBRICATION DES BLOCS DEBP,
  159. * SI ET REPE FAITES DANS LES SUBROUTINES mapr, si ET
  160. * sinon)
  161. 100 CONTINUE
  162. IF (TSTMBC) THEN
  163. MBCONT=1
  164. 101 CONTINUE
  165. CALL NOUTRU
  166. LECTAB=1
  167. CALL LIRMO3(MFIN,1,IRET,0,IMOTCO)
  168. IF (IERR.NE.0) RETURN
  169. IF (IRET.EQ.0) GOTO 101
  170. CALL QUETYP(IJCH,0,IRETOU)
  171. IF (IRETOU.EQ.0) GOTO 101
  172. IF (IJCH.NE.'BLOC') GOTO 101
  173. CALL LIROBJ('BLOC',IRET,1,IRETOU)
  174. IF (MBLOC.NE.IRET) GOTO 101
  175. LECTAB=0
  176. CALL REFUS
  177. CALL FIN
  178. RETURN
  179. ENDIF
  180. *
  181. RETURN
  182. END
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  

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