Télécharger depmac.eso

Retour à la liste

Numérotation des lignes :

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

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