Télécharger liproc.eso

Retour à la liste

Numérotation des lignes :

  1. C LIPROC SOURCE CB215821 19/11/15 21:15:28 10378
  2. ************************************************************************
  3. * NOM : LIPROC
  4. * DESCRIPTION : Lit une procedure GIBIANE depuis un fichier externe
  5. ************************************************************************
  6. * HISTORIQUE : 19/12/2013 : JCARDO : création de la subroutine
  7. * HISTORIQUE : 30/01/2013 : JCARDO : remplissage de la subroutine
  8. * HISTORIQUE : 31/01/2013 : JCARDO : corr. bug appel depuis procedure
  9. * HISTORIQUE : 26/03/2014 : PV : SREDLE non affecte remplace par IREDLE
  10. * HISTORIQUE : 05/05/2015 : JCARDO : ajout de SREDLE=IREDLE
  11. * HISTORIQUE :
  12. ************************************************************************
  13. * Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
  14. * en cas de modification de ce sous-programme afin de faciliter
  15. * la maintenance !
  16. ************************************************************************
  17. * APPELÉ PAR : lirefi.eso
  18. ************************************************************************
  19. * ENTRÉES :: aucune
  20. * SORTIES :: aucune
  21. ************************************************************************
  22. * SYNTAXE (GIBIANE) :
  23. *
  24. * LIRE 'PROC' NOMFIC1 (MOT1) ;
  25. *
  26. ************************************************************************
  27. SUBROUTINE LIPROC
  28.  
  29. IMPLICIT INTEGER(I-N)
  30. IMPLICIT REAL*8(A-H,O-Z)
  31.  
  32. -INC PPARAM
  33. -INC CCNOYAU
  34. -INC CCOPTIO
  35. -INC SMBLOC
  36. -INC CCREDLE
  37.  
  38. C LOCHAI dans CCNOYAU.INC
  39. CHARACTER*(LOCHAI) NOMSRC,CHBUFF
  40. CHARACTER*(LONOM) NOMPR1,NOMPR2,NOMPR3
  41. CHARACTER*8 CHA8
  42.  
  43. CHARACTER*4 MDEBP(1)
  44. DATA MDEBP/'DEBP'/
  45.  
  46. PARAMETER(IOTMP=70)
  47. PARAMETER(LTMP=10)
  48. CHARACTER*(LTMP) FITMP
  49. DATA FITMP/'LIPROC.TMP'/
  50.  
  51. SEGMENT ITITE3
  52. INTEGER ITITEN(NIS),IOU(NIS)
  53. CHARACTER*(8) ITITEM(NIS)
  54. ENDSEGMENT
  55.  
  56.  
  57.  
  58. * +---------------------------------+
  59. * | |
  60. * | LECTURE DES PARAMETRES D'ENTREE |
  61. * | |
  62. * +---------------------------------+
  63.  
  64. * LECTURE DU NOM DU FICHIER SOURCE
  65. CALL LIRCHA(NOMSRC,1,LSRC)
  66. IF (IERR.NE.0) RETURN
  67.  
  68. * LECTURE EVENTUELLE ET VERIFICATION DU NOM DE LA PROCEDURE
  69. CALL LIRCHA(NOMPR1,0,LPR1)
  70. IF (LPR1.GT.0) THEN
  71. CALL VERNAM(NOMPR1(1:LPR1),IRET)
  72. IF (IRET.EQ.0) THEN
  73. MOTERR(1:8)=NOMPR1(1:LPR1)
  74. IF (LPR1.GT.8) MOTERR(6:8)='...'
  75. CALL ERREUR(1029)
  76. RETURN
  77. ENDIF
  78. ENDIF
  79.  
  80.  
  81.  
  82. * +-----------------------------+
  83. * | |
  84. * | SAUVETAGE DE L'ETAT COURANT |
  85. * | |
  86. * +-----------------------------+
  87.  
  88. * SAUVETAGE DU TYPE DES OBJETS TEMPORAIRES
  89. SREDLE=IREDLE
  90. ITITE=0
  91. IF (IPTEM.NE.0) THEN
  92. ITITE=1
  93. MOT(1:LONOM)='#'
  94. IRE=3
  95. NIS=IPTEM
  96. SEGINI,ITITE3
  97. DO I=1,IPTEM
  98. IF (I.LT.10) THEN
  99. WRITE(MOT(2:2),FMT='(I1)') I
  100. NCAR=2
  101. ELSE
  102. WRITE(MOT(2:3),FMT='(I2)') I
  103. NCAR=3
  104. ENDIF
  105. IAVA=0
  106. CALL PRENOM(IPLAMO,IAVA,SREDLE)
  107. ITITEN(I)=IPLAMO
  108. ITITEM(I)=INOOB2(IPLAMO)
  109. IOU(I)=IOUEP2(IPLAMO)
  110. ENDDO
  111. ENDIF
  112.  
  113. * SAUVETAGE DE CCNOYAU ET CCREDLE
  114. CALL PROCSA
  115. MBFONC=1
  116.  
  117.  
  118.  
  119. * +-----------------------------+
  120. * | |
  121. * | OUVERTURE DU FICHIER SOURCE |
  122. * | |
  123. * +-----------------------------+
  124.  
  125. OPEN(UNIT=IOCAR,
  126. & ACCESS='SEQUENTIAL',
  127. & STATUS='OLD',
  128. & FILE=NOMSRC(1:LSRC),
  129. & FORM='FORMATTED',
  130. & IOSTAT=IOS)
  131.  
  132. IF (IOS.NE.0) THEN
  133. INTERR(1)=IOS
  134. MOTERR=NOMSRC(1:LSRC)
  135. CALL ERREUR(424)
  136. RETURN
  137. ENDIF
  138.  
  139.  
  140. * POSITIONNEMENT DE LA LECTURE GIBI SUR LE FICHIER SOURCE
  141. JOLEC=IOLEC
  142. IOLEC=IOCAR
  143.  
  144.  
  145.  
  146. * +---------------------------+
  147. * | |
  148. * | CHARGEMENT DES PROCEDURES |
  149. * | |
  150. * +---------------------------+
  151.  
  152. * ON DECREMENTE LE NIVEAU D'ECRITURE
  153. IECHA=IECHO
  154. IECHO=MAX(0,IECHO-1)
  155.  
  156. * NBPROC = nombre de procedures importees avec succes
  157. * NDELIM = nombre de delimiteurs $$$$ lus
  158. NBPROC=0
  159. NDELIM=0
  160.  
  161. 1 READ(UNIT=IOCAR,FMT=FMCHAI,END=1000) CHBUFF
  162.  
  163. IF (CHBUFF.EQ.' ') GOTO 1
  164.  
  165.  
  166. * ==================================================================
  167. * LE FICHIER CONTIENT UNE OU PLUSIEURS PROCEDURES SEPAREES PAR LES
  168. * DELIMITEURS $$$$ (FORMAT STANDARD, COMPATIBLE AVEC UTIL 'PROC')
  169. * ==================================================================
  170. IF (CHBUFF(1:4).EQ.'$$$$') THEN
  171.  
  172. NDELIM=NDELIM+1
  173.  
  174.  
  175. * MESSAGE INDIQUANT QUE LE FICHIER EST AU FORMAT STANDARD
  176. IF ((NDELIM.EQ.1).AND.(IIMPI.GE.10)) CALL ERREUR(-348)
  177.  
  178.  
  179. * LECTURE DU NOM DERRIERE LE DELIMITEUR $$$$
  180. * ------------------------------------------
  181. NOMPR2=CHBUFF(6:LOCHAI)
  182. CALL LENCHA(NOMPR2,LPR2)
  183. IF (LPR2.EQ.0) GOTO 1
  184.  
  185.  
  186. * LECTURE DU NOM DERRIERE L'INSTRUCTION DEBP
  187. * ------------------------------------------
  188. CALL NOUTRU
  189. CALL LIRMOT(MDEBP,1,IRET,1)
  190. CHA8=' '
  191. CALL LIROBJ(CHA8,IOBJ1,1,IRET)
  192. CALL QUENOM(NOMPR3)
  193. CALL LENCHA(NOMPR3,LPR3)
  194.  
  195.  
  196. * VERIFICATION QUE LES DEUX NOMS CONCORDENT ET SONT VALIDES
  197. * ---------------------------------------------------------
  198. CALL MINMAJ(NOMPR2(1:LPR2))
  199. CALL MINMAJ(NOMPR3(1:LPR3))
  200.  
  201. CALL VERNAM(NOMPR2(1:LPR2),IRET)
  202. IF (IRET.EQ.0) THEN
  203. MOTERR(1:8)=NOMPR2(1:LPR2)
  204. IF (LPR2.GT.8) MOTERR(6:8)='...'
  205. CALL ERREUR(1029)
  206. GOTO 1002
  207. ELSEIF (NOMPR2(1:LPR2).NE.NOMPR3(1:LPR3)) THEN
  208. MOTERR(1:8)=NOMPR2(1:LPR2)
  209. MOTERR(9:16)=NOMPR3(1:LPR3)
  210. CALL ERREUR(1031)
  211. GOTO 1002
  212. ENDIF
  213.  
  214.  
  215. * SI UN NOM DE PROCEDURE A ETE FOURNI EN ENTREE, ON IGNORE
  216. * TOUTES LES PROCEDURES LUES QUI NE PORTENT PAS CE NOM
  217. * --------------------------------------------------------
  218. IF ((LPR1.NE.0).AND.(NOMPR1(1:LPR1).NE.NOMPR2(1:LPR2))) THEN
  219. IF (IIMPI.GE.10) THEN
  220. MOTERR(1:8)=NOMPR2(1:LPR2)
  221. CALL ERREUR(-351)
  222. ENDIF
  223. GOTO 1
  224. ENDIF
  225.  
  226.  
  227. * CREATION ET CHARGEMENT DU CONTENU DE L'OBJET PROCEDUR
  228. * -----------------------------------------------------
  229. CALL REFUS
  230. CALL MAPR(1)
  231. IF (IERR.NE.0) RETURN
  232.  
  233.  
  234. * MESSAGE INDIQUANT UNE ERREUR OU LA REUSSITE DE L'IMPORTATION
  235. * ------------------------------------------------------------
  236. MOTERR(1:8)=NOMPR2(1:LPR2)
  237. IF (IERR.NE.0) THEN
  238. IERR=0
  239. CALL ERREUR(1030)
  240. GOTO 1002
  241. ELSEIF (IIMPI.GE.10) THEN
  242. CALL ERREUR(-350)
  243. NBPROC=NBPROC+1
  244. ENDIF
  245.  
  246.  
  247. GOTO 1
  248.  
  249.  
  250. * ==================================================================
  251. * LE FICHIER INDIQUE CONTIENT UNE SUITE D'INSTRUCTIONS BRUTES, SANS
  252. * LE DELIMITEUR $$$$ NI LES INSTRUCTIONS DEBP/FINP
  253. * ==================================================================
  254. ELSEIF (NDELIM.EQ.0) THEN
  255.  
  256. * MESSAGE INDIQUANT QUE L'ON A PAS TROUVE DE DELIMITEURS
  257. IF ((LPR1.EQ.0).OR.(IIMPI.GE.10)) CALL ERREUR(-349)
  258.  
  259. * DANS CE CAS DE FIGURE, IL EST OBLIGATOIRE DE FOURNIR LE NOM
  260. * DE LA PROCEDURE QUE L'ON VA CREER
  261. IF (LPR1.EQ.0) THEN
  262. IOLEC=JOLEC
  263. MOTERR(1:8)='PROCEDUR'
  264. CALL ERREUR(1028)
  265. GOTO 1002
  266. ENDIF
  267.  
  268.  
  269. * CREATION D'UN FICHIER TEMPORAIRE
  270. * --------------------------------
  271. OPEN(UNIT=IOTMP,
  272. & ACCESS='SEQUENTIAL',
  273. & STATUS='UNKNOWN',
  274. & FILE=FITMP(1:LTMP),
  275. & FORM='FORMATTED',
  276. & IOSTAT=IOS)
  277.  
  278. IF (IOS.NE.0) THEN
  279. INTERR(1)=IOS
  280. MOTERR=FITMP(1:LTMP)
  281. CALL ERREUR(424)
  282. GOTO 1002
  283. ENDIF
  284.  
  285.  
  286. * ECRITURE DU NOM DE LA PROCEDURE (REQUIS PAR MAPR)
  287. * -------------------------------------------------
  288. WRITE(IOTMP,'(A)') NOMPR1(1:LPR1)//' ;'
  289.  
  290.  
  291. * COPIE DES INSTRUCTIONS CONTENUES DANS LE FICHIER SOURCE
  292. * -------------------------------------------------------
  293. BACKSPACE(UNIT=IOCAR)
  294. 2 READ (UNIT=IOCAR,FMT=FMCHAI,END=3) CHBUFF
  295. WRITE(UNIT=IOTMP,FMT=FMCHAI ) CHBUFF
  296. GOTO 2
  297. 3 CONTINUE
  298.  
  299.  
  300. * AJOUT DE L'INSTRUCTION FINP (REQUIS PAR MAPR)
  301. * => NE POSE PAS DE PROBLEME SI ELLE ETAIT DEJA PRESENTE
  302. * ------------------------------------------------------
  303. WRITE(IOTMP,'(A6)') 'FINP ;'
  304.  
  305.  
  306. * REPOSITIONNEMENT DE LA LECTURE GIBI SUR LE FICHIER TEMPORAIRE
  307. * -------------------------------------------------------------
  308. REWIND(UNIT=IOTMP)
  309. IOLEC=IOTMP
  310. CALL NOUTRU
  311.  
  312.  
  313. * CREATION ET CHARGEMENT DU CONTENU DE L'OBJET PROCEDUR
  314. * -----------------------------------------------------
  315. CALL MAPR(1)
  316. IF (IERR.NE.0) RETURN
  317.  
  318.  
  319. * MESSAGE INDIQUANT UNE ERREUR OU LA REUSSITE DE L'IMPORTATION
  320. * ------------------------------------------------------------
  321. MOTERR(1:8)=NOMPR1(1:LPR1)
  322. IF (IERR.NE.0) THEN
  323. IERR=0
  324. CALL ERREUR(1030)
  325. GOTO 1001
  326. ELSEIF (IIMPI.GE.10) THEN
  327. CALL ERREUR(-350)
  328. NBPROC=NBPROC+1
  329. ENDIF
  330.  
  331.  
  332. GOTO 1000
  333.  
  334. ENDIF
  335.  
  336. GOTO 1
  337.  
  338.  
  339.  
  340. * +-------------------------+
  341. * | |
  342. * | SORTIE DE LA SUBROUTINE |
  343. * | |
  344. * +-------------------------+
  345.  
  346.  
  347. 1000 CONTINUE
  348.  
  349. * MESSAGE INDIQUANT LE NOMBRE DE PROCEDURES CREEES
  350. IF (IIMPI.GE.10) THEN
  351. INTERR(1)=NBPROC
  352. CALL ERREUR(-352)
  353. ENDIF
  354.  
  355.  
  356. 1001 CONTINUE
  357.  
  358. * ON FERME LE FICHIER TEMPORAIRE
  359. CLOSE(UNIT=IOTMP,STATUS='DELETE')
  360.  
  361.  
  362. 1002 CONTINUE
  363.  
  364. * ON FERME LE FICHIER SOURCE
  365. CLOSE(UNIT=IOCAR)
  366.  
  367. * ON RESTAURE LA LECTURE SUR L'ANCIENNE UNITE
  368. * (OU SUR LE TERMINAL S'IL Y A UNE ERREUR)
  369. IF (IERR.NE.0) THEN
  370. IOLEC=IOTER
  371. ELSE
  372. IOLEC=JOLEC
  373. ENDIF
  374.  
  375. * ON RESTAURE LE NIVEAU D'ECRITURE
  376. IECHO=IECHA
  377.  
  378. * ON RESTAURE LES TYPES D'OBJETS TEMPORAIRES, LE NOYAU ET LA LECTURE
  379. IF (ITITE.NE.0) THEN
  380. DO I=1,ITITEN(/1)
  381. IPLAMO=ITITEN(I)
  382. INOOB2(IPLAMO)=ITITEM(I)
  383. IOUEP2(IPLAMO)=IOU(I)
  384. ENDDO
  385. SEGSUP,ITITE3
  386. ENDIF
  387. CALL PROCRE
  388.  
  389.  
  390.  
  391. RETURN
  392.  
  393. END
  394.  
  395.  
  396.  
  397.  
  398.  
  399.  
  400.  

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