Télécharger depmac.eso

Retour à la liste

Numérotation des lignes :

  1. C DEPMAC SOURCE KK2000 01/01/29 21:15:01 4087 GF238795
  2. C CET INTERESSANT SOUS-PROGRAMME S'EFFORCE DE CENTRALISER LES
  3. C FONCTIONS DEPENDANTES DU MATERIEL UTILISE
  4. C VOICI LA VERSION POUR LINUX
  5. C
  6. SUBROUTINE DEPMAC
  7. implicit integer(i-n)
  8. external extint,long
  9. CHARACTER*8 USRNAM,cgibnam
  10. CHARACTER*500 cvarenv
  11. equivalence (cvarenv,ivarenv)
  12. logical ex
  13. DIMENSION EXTR(1),CBRACT(1),CARACT(1),ITTIME(4)
  14. -INC CCOPTIO
  15. character*(*) chacha
  16. REAL*8 XKT
  17. COMMON /CLGI/L6C
  18. CHARACTER*64 L6C
  19. SAVE KPREC
  20. DATA ICONT/1/
  21. C
  22. C**************************************************************************
  23. C
  24. C INITIALISATION DU TIMER
  25. CALL TIMESPV(ITTIME)
  26. KPREC=(ITTIME(1)+ITTIME(2))/10
  27. C graphiques X
  28. iogra=2
  29. C lecture de fichier automatique
  30. iolec=3
  31. C INITIALISATION NB DE ZERO CONSECUTIFS ( 48 POUR IBM RS/6000)
  32. IZROSF=48
  33.  
  34. C OUVERTURE DES FICHIERS ERREURS,NOTICE,PROCEDURE
  35. C GIBI.ERREUR en local
  36. INQUIRE(FILE='GIBI.ERREUR',EXIST=EX)
  37. if (ex) then
  38. cvarenv='GIBI.ERREUR'
  39. l=long(cvarenv)
  40. else
  41. cvarenv='CASTEM_ERREUR'//char(0)
  42. l=500
  43. call ooozen(ivarenv,l)
  44. if (l.eq.0) then
  45. cvarenv='/u/castem/GIBI.ERREUR'
  46. l=long(cvarenv)
  47. endif
  48. endif
  49. OPEN (UNIT=35,FILE=CVARENV(1:L),STATUS='OLD',IOSTAT=IOSTAT,
  50. 1FORM='FORMATTED')
  51. IF (IOSTAT.NE.0) THEN
  52. WRITE (6,FMT=
  53. 1 '('' ERREUR OUVERTURE DU FICHIER DE MESSAGES D''''ERREUR'')')
  54. ENDIF
  55.  
  56. cvarenv='CASTEM_NOTICE'//char(0)
  57. l=500
  58. call ooozen(ivarenv,l)
  59. if (l.eq.0) then
  60. cvarenv='/u/castem/GIBI.MASTER'
  61. l=long(cvarenv)
  62. endif
  63. OPEN(UNIT=33,FILE=cvarenv(1:l),ACCESS='DIRECT',
  64. 1FORM='FORMATTED',RECL=80,STATUS='OLD' ,IOSTAT=IOSTAT)
  65.  
  66. cvarenv='CASTEM_PROC'//char(0)
  67. l=500
  68. call ooozen(ivarenv,l)
  69. if (l.eq.0) then
  70. cvarenv='/u/castem/GIBI.PROC'
  71. l=long(cvarenv)
  72. endif
  73. OPEN(UNIT=34,FILE=cvarenv(1:l),ACCESS='DIRECT',
  74. 1FORM='FORMATTED',RECL=80,STATUS='OLD' ,IOSTAT=IOSTAT)
  75. OPEN(UNIT=36,FILE='UTILPROC' ,ACCESS='DIRECT',
  76. 1FORM='FORMATTED',RECL=80,STATUS='UNKNOWN',IOSTAT=IOSTAT)
  77. OPEN(UNIT=37,FILE='UTILNOTI' ,ACCESS='DIRECT',
  78. 1FORM='FORMATTED',RECL=80,STATUS='UNKNOWN',IOSTAT=IOSTAT)
  79. C
  80. C si la variable d'environnement CASTEM_PROJET est definie, ouverture unites 3 24 et 98
  81. cvarenv='CASTEM_PROJET'//char(0)
  82. l=500
  83. call ooozen(ivarenv,l)
  84. if (cvarenv(l-5:l).eq.'.dgibi') then
  85. l=l-6
  86. elseif (cvarenv(l-5:l).eq.'.DGIBI') then
  87. l=l-6
  88. endif
  89. if (l.gt.0) then
  90. open (unit=3,file=cvarenv(1:l)//'.dgibi',iostat=iostat)
  91. open (unit=98,file=cvarenv(1:l)//'.trace',iostat=iostat)
  92. open (unit=24,file=cvarenv(1:l)//'.ps',iostat=iostat)
  93. endif
  94. C
  95. C INITIALISATION TABLES DE TRANSCODAGE POUR LE LGI
  96. L6C=':ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-*/()$= ,.'
  97. L6C(49:49)='#'
  98. L6C(50:50)=''
  99. L6C(51:51)='!'
  100. L6C(52:52)='%'
  101. L6C(53:53)='"'
  102. L6C(54:54)='_'
  103. L6C(55:55)='|'
  104. L6C(56:56)='&'
  105. L6C(57:57)=''''
  106. L6C(58:58)='?'
  107. L6C(59:59)='<'
  108. L6C(60:60)='>'
  109. L6C(61:61)='@'
  110. L6C(62:62)=CHAR(92)
  111. L6C(63:63)=CHAR(94)
  112. L6C(64:64)=CHAR(59)
  113. C initialisation du gestionnaire d'interruption (^C)
  114. call inthan
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134. RETURN
  135. C
  136. C**************************************************************************
  137. C
  138. ENTRY GIBTEM(XKT)
  139. C TEMPS DEPUIS LE DERNIER APPEL EN CENTIEMES DE SECONDE
  140. CALL TIMESPV(ITTIME)
  141. KTOT=(ITTIME(1)+ITTIME(2))/10
  142. KT=KTOT-KPREC
  143. XKT=KT
  144. KPREC=KTOT
  145. RETURN
  146. ENTRY GIBTRB
  147. C TRACE BACK
  148. RETURN
  149. C
  150. C**************************************************************************
  151. C
  152. ENTRY GIBDAT(JOUR,MOIS,IANNEE)
  153. C DATE (EN ENTIERS)
  154. CALL OOOZZ1(ITTIME)
  155. JOUR=ITTIME(1)
  156. MOIS=ITTIME(2)
  157. IANNEE=ITTIME(3)
  158. RETURN
  159. ENTRY GIBECO(IECO)
  160. C TEST ENVIRONNEMENT (BATCH OU INTERACTIF)
  161. IECO=1
  162. RETURN
  163. C
  164. C**************************************************************************
  165. C
  166. C recuperer le nom utilisateur
  167. ENTRY GIBNAM(USRNAM)
  168. usrnam=cgibnam(usrnam)
  169. return
  170. C
  171. C**************************************************************************
  172. C
  173. entry prompt
  174. c prompt (si on peut le faire)
  175. write (ioimp,fmt='('' $ '',$)')
  176. return
  177. C
  178. C**************************************************************************
  179. C
  180. entry xread(chacha,lon)
  181. c pour windows lecture instruction
  182. read (ioter,fmt='(A72)') chacha
  183. lon=long(chacha)
  184. return
  185. C
  186. C**************************************************************************
  187. C
  188. C TRAITEMENT D'ERREUR IBM
  189. C ON MET SUR TOUTE ERREUR D'EXECUTION IERR A 1
  190. C ET ON POURSUIT L'EXECUTION
  191. C ON LAISSE UN MESSAGE D'ERREUR S'IMPRIMER
  192. entry errcor
  193. C points d'entree a supprimer sur RS/6000
  194. entry cp(chacha)
  195. entry cms(chacha)
  196. entry elpdyn
  197. entry elpsta
  198. C GDDM
  199. entry asdfld
  200. entry asfcol
  201. entry asftrn
  202. entry asftra
  203. entry asqmax
  204. entry fsrnit
  205. entry ascput
  206. entry asread
  207. entry asqcur
  208. entry ascget
  209. entry fsinit
  210. entry fsinn
  211. entry dsopen
  212. entry dsuse
  213. entry fsqury
  214. entry gslss
  215. entry fspcrt
  216. entry gsfld
  217. entry gsqps
  218. entry gswin
  219. entry gssati
  220. entry gsseg
  221. entry gstag
  222. entry gscm
  223. entry gscol
  224. entry gschar
  225. entry gsqcb
  226. entry gscb
  227. entry gsscls
  228. entry gsview
  229. entry gsclp
  230. entry gsuwin
  231. entry gsmix
  232. entry gsmove
  233. entry gsplne
  234. entry gsenab
  235. entry gsiloc
  236. entry gsread
  237. entry gsqcho
  238. entry gsqloc
  239. entry gspat
  240. entry gsarea
  241. entry gsenda
  242. entry gsqwin
  243. entry gsqlid
  244. entry gsidvf
  245. entry gsstfm
  246. entry gssdel
  247. entry gsqaga
  248. entry gssats
  249. entry gssave
  250. entry gscopy
  251. entry fscopy
  252. entry fscls
  253. entry gsclr
  254. entry fsfrce
  255. entry asfcur
  256. CPHIGS
  257. entry pads
  258. entry parst
  259. entry patr
  260. entry pcelst
  261. entry pclst
  262. entry pdst
  263. entry pemst
  264. entry pevmm
  265. entry pexst
  266. entry pfa
  267. entry poparf
  268. entry popph
  269. entry popst
  270. entry popwk
  271. entry ppl
  272. entry ppost
  273. entry pqdsp
  274. entry pqopst
  275. entry pqopwk
  276. entry prqlc
  277. entry prqpk
  278. entry prqst
  279. entry psans
  280. entry psatch
  281. entry pschsp
  282. entry pscr
  283. entry psdus
  284. entry psici
  285. entry psis
  286. entry psivft
  287. entry pslcm
  288. entry pspkft
  289. entry pspkid
  290. entry pspkm
  291. entry psplci
  292. entry pspmci
  293. entry psstm
  294. entry pstxci
  295. entry pstxfn
  296. entry pstxpr
  297. C entry psvis
  298. entry psvtip
  299. entry psvwi
  300. entry psvwr
  301. entry pswkv
  302. entry pswkw
  303. entry pupast
  304. entry puwk
  305. C GKS
  306.  
  307. entry gacwk
  308. entry gasgwk
  309. entry gclsg
  310. entry gclwk
  311. entry gcrsg
  312. entry gdawk
  313. entry gdsg
  314. entry gfa
  315. entry ginlc
  316. entry ginsg
  317. entry gmsg
  318. entry gopks
  319. entry gopwk
  320. entry gpl
  321. entry gqchh
  322. entry gqchxp
  323. entry gqdsp
  324. entry gqops
  325. entry gqopsg
  326. entry gqopwk
  327. entry gqsga
  328. entry gqsgus
  329. entry gqwks
  330. entry grensg
  331. entry grqlc
  332. entry grqpk
  333. entry grqst
  334. entry gsasf
  335. entry gschh
  336. entry gschsp
  337. entry gschxp
  338. entry gscr
  339. entry gsds
  340. entry gsdtec
  341. entry gselnt
  342. entry gsfaci
  343. entry gsfais
  344. entry gslcm
  345. entry gspkm
  346. entry gsplci
  347. entry gspmci
  348. entry gssgt
  349. entry gsstm
  350. entry gstxci
  351. entry gstxfp
  352. entry gsvis
  353. entry gsvp
  354. entry gswkvp
  355. entry gswkwn
  356. entry gswn
  357. entry gtx
  358. entry guwk
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  
  381.  
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  
  390. END
  391. C
  392. C**************************************************************************
  393. C
  394. C gestionnaire d'interruption (^C)
  395. subroutine extint
  396. implicit integer(i-n)
  397. -INC CCOPTIO
  398. C regenerer le signal puis positionner une erreur
  399. call inthan
  400. ierr=623
  401. end
  402. C
  403. C
  404. C**************************************************************************
  405. C
  406. C mise en place gestionnaire d'interruption (^C)
  407. subroutine inthan
  408. implicit integer(i-n)
  409. external extint
  410. call signal(2,extint)
  411. end
  412. C
  413. C**************************************************************************
  414. C
  415. C reouverture du terminal apres une interruption clavier (si necessaire)
  416. subroutine opterm(iun)
  417. implicit integer(i-n)
  418. close (unit=iun)
  419. open (unit=iun,file='/dev/tty')
  420. end
  421.  
  422.  

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