Télécharger ptrini.eso

Retour à la liste

Numérotation des lignes :

  1. C PTRINI SOURCE PV 05/09/22 21:25:59 5181
  2. CSSP TRINIT VERSION 04/08/89 MODIFIEE POUR DRIVER PHIGS
  3. C------------------------------------------------------
  4. SUBROUTINE PTRINI(NOL,AXAX,AYAY,TITRE,HAUTT,VALEU,NCOUMA)
  5. *****
  6. ***** definitions standards de PHIGS
  7. *****
  8. IMPLICIT INTEGER(I-N)
  9. external long
  10. PARAMETER (PUNCON = 1 )
  11. PARAMETER (PLDLN = 2 )
  12. C archive state
  13. PARAMETER (PARCL = 0 )
  14. PARAMETER (PAROP = 1 )
  15. C attribute identifier
  16. PARAMETER (PLN = 0 )
  17. PARAMETER (PLWSC = 1 )
  18. PARAMETER (PPLCI = 2 )
  19. PARAMETER (PMK = 3 )
  20. PARAMETER (PMKSC = 4 )
  21. PARAMETER (PPMCI = 5 )
  22. PARAMETER (PTXFN = 6 )
  23. PARAMETER (PTXPR = 7 )
  24. PARAMETER (PCHXP = 8 )
  25. PARAMETER (PCHSP = 9 )
  26. PARAMETER (PTXCI = 10 )
  27. PARAMETER (PIS = 11 )
  28. PARAMETER (PISI = 12 )
  29. PARAMETER (PICI = 13 )
  30. PARAMETER (PEDFG = 14 )
  31. PARAMETER (PEDT = 15 )
  32. PARAMETER (PEWSC = 16 )
  33. PARAMETER (PEDCI = 17 )
  34. PARAMETER (PPSHM = 18 )
  35. PARAMETER (PISHM = 19 )
  36. PARAMETER (PIRPR = 20 )
  37. PARAMETER (PIREQ = 21 )
  38. PARAMETER (PBIS = 22 )
  39. PARAMETER (PBISI = 23 )
  40. PARAMETER (PBIC = 24 )
  41. PARAMETER (PBISHM = 25 )
  42. PARAMETER (PBIRPR = 26 )
  43. PARAMETER (PBIREQ = 27 )
  44. PARAMETER (PCAPCR = 28 )
  45. PARAMETER (PSAPCR = 29 )
  46. C aspect source
  47. PARAMETER (PBUNDL = 0 )
  48. PARAMETER (PINDIV = 1 )
  49. C clipping indicator
  50. PARAMETER (PNCLIP = 0 )
  51. PARAMETER (PCLIP = 1 )
  52. C colour available
  53. PARAMETER (PMONOC = 0 )
  54. PARAMETER (PCOLOR = 1 )
  55. C colour model
  56. PARAMETER (PINDCT = 0 )
  57. PARAMETER (PRGB = 1 )
  58. PARAMETER (PCIE = 2 )
  59. PARAMETER (PHSV = 3 )
  60. PARAMETER (PHLS = 4 )
  61. C composition type
  62. PARAMETER (PCPRE = 0 )
  63. PARAMETER (PCPOST = 1 )
  64. PARAMETER (PCREPL = 2 )
  65. C conflict resolution
  66. PARAMETER (PCRMNT = 0 )
  67. PARAMETER (PCRABA = 1 )
  68. PARAMETER (PCRUPD = 2 )
  69. C control flag
  70. PARAMETER (PCONDI = 0 )
  71. PARAMETER (PALWAY = 1 )
  72. C deferral mode
  73. PARAMETER (PASAP = 0 )
  74. PARAMETER (PBNIG = 1 )
  75. PARAMETER (PBNIL = 2 )
  76. PARAMETER (PASTI = 3 )
  77. PARAMETER (PWAITD = 4 )
  78. C device coordinate units
  79. PARAMETER (PMETRE = 0 )
  80. PARAMETER (POTHU = 1 )
  81. C display surface empty
  82. PARAMETER (PNEMPT = 0 )
  83. PARAMETER (PEMPTY = 1 )
  84. C dynamic modification
  85. PARAMETER (PIRG = 0 )
  86. PARAMETER (PIMM = 1 )
  87. PARAMETER (PCBS = 2 )
  88. C echo switch
  89. PARAMETER (PNECHO = 0 )
  90. PARAMETER (PECHO = 1 )
  91. C edit mode
  92. PARAMETER (PINSRT = 0 )
  93. PARAMETER (PREPLC = 1 )
  94. C element type
  95. PARAMETER ( PEALL = 0 )
  96. PARAMETER ( PENIL = 1 )
  97. PARAMETER ( PEPL3 = 2 )
  98. PARAMETER ( PEPL = 3 )
  99. PARAMETER ( PEPM3 = 4 )
  100. PARAMETER ( PEPM = 5 )
  101. PARAMETER ( PETX3 = 6 )
  102. PARAMETER ( PETX = 7 )
  103. PARAMETER ( PEATR3 = 8 )
  104. PARAMETER ( PEATR = 9 )
  105. PARAMETER ( PEFA3 = 10 )
  106. PARAMETER ( PEFA = 11 )
  107. PARAMETER ( PEFAS3 = 12 )
  108. PARAMETER ( PEFAS = 13 )
  109. PARAMETER ( PECA3 = 14 )
  110. PARAMETER ( PECA = 15 )
  111. PARAMETER ( PEGDP3 = 16 )
  112. PARAMETER ( PEGDP = 17 )
  113. PARAMETER ( PEPLI = 18 )
  114. PARAMETER ( PEPMI = 19 )
  115. PARAMETER ( PETXI = 20 )
  116. PARAMETER ( PEII = 21 )
  117. PARAMETER ( PEEDI = 22 )
  118. PARAMETER ( PELN = 23 )
  119. PARAMETER ( PELWSC = 24 )
  120. PARAMETER ( PEPLCI = 25 )
  121. PARAMETER ( PEMK = 26 )
  122. PARAMETER ( PEMKSC = 27 )
  123. PARAMETER ( PEPMCI = 28 )
  124. PARAMETER ( PETXFN = 29 )
  125. PARAMETER ( PETXPR = 30 )
  126. PARAMETER ( PECHXP = 31 )
  127. PARAMETER ( PECHSP = 32 )
  128. PARAMETER ( PETXCI = 33 )
  129. PARAMETER ( PECHH = 34 )
  130. PARAMETER ( PECHUP = 35 )
  131. PARAMETER ( PETXP = 36 )
  132. PARAMETER ( PETXAL = 37 )
  133. PARAMETER ( PEATCH = 38 )
  134. PARAMETER ( PEATCU = 39 )
  135. PARAMETER ( PEATP = 40 )
  136. PARAMETER ( PEATAL = 41 )
  137. PARAMETER ( PEANST = 42 )
  138. PARAMETER ( PEIS = 43 )
  139. PARAMETER ( PEISI = 44 )
  140. PARAMETER ( PEICI = 45 )
  141. PARAMETER ( PEEDFG = 46 )
  142. PARAMETER ( PEEDT = 47 )
  143. PARAMETER ( PEEWSC = 48 )
  144. PARAMETER ( PEEDCI = 49 )
  145. PARAMETER ( PEPA = 50 )
  146. PARAMETER ( PEPRPV = 51 )
  147. PARAMETER ( PEPARF = 52 )
  148. PARAMETER ( PEADS = 53 )
  149. PARAMETER ( PERES = 54 )
  150. PARAMETER ( PEIASF = 55 )
  151. PARAMETER ( PEHRID = 56 )
  152. PARAMETER ( PELMT3 = 57 )
  153. PARAMETER ( PELMT = 58 )
  154. PARAMETER ( PEGMT3 = 59 )
  155. PARAMETER ( PEGMT = 60 )
  156. PARAMETER ( PEMCV3 = 61 )
  157. PARAMETER ( PEMCV = 62 )
  158. PARAMETER ( PEMCLI = 63 )
  159. PARAMETER ( PERMCV = 64 )
  160. PARAMETER ( PEVWI = 65 )
  161. PARAMETER ( PEEXST = 66 )
  162. PARAMETER ( PELB = 67 )
  163. PARAMETER ( PEAP = 68 )
  164. PARAMETER ( PEGSE = 69 )
  165. PARAMETER ( PEPKID = 70 )
  166. C element type PHIGS+
  167. PARAMETER ( PEPLS3 = 71 )
  168. PARAMETER ( PEFSD3 = 72 )
  169. PARAMETER ( PETRS3 = 73 )
  170. PARAMETER ( PEQMD3 = 74 )
  171. PARAMETER ( PESFS3 = 75 )
  172. PARAMETER ( PENBSC = 76 )
  173. PARAMETER ( PENBSS = 77 )
  174. PARAMETER ( PECAP3 = 78 )
  175. PARAMETER ( PETXCL = 79 )
  176. PARAMETER ( PEPMCL = 80 )
  177. PARAMETER ( PEEDCL = 81 )
  178. PARAMETER ( PEPLCL = 82 )
  179. PARAMETER ( PECAPC = 83 )
  180. PARAMETER ( PEPLSM = 84 )
  181. PARAMETER ( PEICL = 85 )
  182. PARAMETER ( PEBICL = 86 )
  183. PARAMETER ( PEBISY = 87 )
  184. PARAMETER ( PEBISI = 88 )
  185. PARAMETER ( PERFP = 89 )
  186. PARAMETER ( PEBRFP = 90 )
  187. PARAMETER ( PEISM = 91 )
  188. PARAMETER ( PEBISM = 92 )
  189. PARAMETER ( PEIRFE = 93 )
  190. PARAMETER ( PEBIRE = 94 )
  191. PARAMETER ( PESAPC = 95 )
  192. PARAMETER ( PEPSCH = 96 )
  193. PARAMETER ( PEFDGM = 97 )
  194. PARAMETER ( PEFCUM = 98 )
  195. PARAMETER ( PELSST = 99 )
  196. PARAMETER ( PEDPCI = 100 )
  197. PARAMETER ( PECMI = 101 )
  198. PARAMETER ( PERCLM = 102 )
  199. C GDP attributes
  200. PARAMETER (PPLATT = 0 )
  201. PARAMETER (PPMATT = 1 )
  202. PARAMETER (PTXATT = 2 )
  203. PARAMETER (PINATT = 3 )
  204. PARAMETER (PEDATT = 4 )
  205. C input class
  206. PARAMETER (PNCLAS = 0 )
  207. PARAMETER (PLOCAT = 1 )
  208. PARAMETER (PSTROK = 2 )
  209. PARAMETER (PVALUA = 3 )
  210. PARAMETER (PCHOIC = 4 )
  211. PARAMETER (PPICK = 5 )
  212. PARAMETER (PSTRIN = 6 )
  213. C input device status
  214. PARAMETER (PNONE = 0 )
  215. PARAMETER (POK = 1 )
  216. PARAMETER (PNPICK = 2 )
  217. PARAMETER (PNCHOI = 2 )
  218. C interior style
  219. PARAMETER (PHOLLO = 0 )
  220. PARAMETER (PSOLID = 1 )
  221. PARAMETER (PPATTR = 2 )
  222. PARAMETER (PHATCH = 3 )
  223. PARAMETER (PISEMP = 4 )
  224. C linetype
  225. PARAMETER (PLSOLI = 1 )
  226. PARAMETER (PLDASH = 2 )
  227. PARAMETER (PLDOT = 3 )
  228. PARAMETER (PLDASD = 4 )
  229. C makertype
  230. PARAMETER (PPOINT = 1 )
  231. PARAMETER (PPLUS = 2 )
  232. PARAMETER (PAST = 3 )
  233. PARAMETER (POMARK = 4 )
  234. PARAMETER (PXMARK = 5 )
  235. C modellin clipping operater
  236. PARAMETER (PMCREP = 1 )
  237. PARAMETER (PMCINT = 2 )
  238. C modification mode
  239. PARAMETER (PNIVE = 0 )
  240. PARAMETER (PUWOR = 1 )
  241. PARAMETER (PUQUM = 2 )
  242. C more simultaneous events
  243. PARAMETER (PNMORE = 0 )
  244. PARAMETER (PMORE = 1 )
  245. C off/on switch for edge flag and error handling mode
  246. PARAMETER (POFF = 0 )
  247. PARAMETER (PON = 1 )
  248. C open-structure status
  249. PARAMETER (PNONST = 0 )
  250. PARAMETER (POPNST = 1 )
  251. C operating mode
  252. PARAMETER (PREQU = 0 )
  253. PARAMETER (PSAMPL = 1 )
  254. PARAMETER (PEVENT = 2 )
  255. C path order
  256. PARAMETER (PPOTOP = 0 )
  257. PARAMETER (PPOBOT = 1 )
  258. C polyline/fill area control flag
  259. PARAMETER (PPLINE = 0 )
  260. PARAMETER (PFILLA = 1 )
  261. PARAMETER (PFILAS = 2 )
  262. C presence of invalid values
  263. PARAMETER (PABSNT = 0 )
  264. PARAMETER (PPRSNT = 1 )
  265. C reference handling flag
  266. PARAMETER (PDELE = 0 )
  267. PARAMETER (PKEEP = 1 )
  268. C regeneration flag
  269. PARAMETER (PPOSTP = 0 )
  270. PARAMETER (PPERFO = 1 )
  271. C / relative input priority
  272. PARAMETER (PHIGHR = 0 )
  273. PARAMETER (PLOWER = 1 )
  274. C search direction
  275. PARAMETER (PBWD = 0 )
  276. PARAMETER (PFWD = 1 )
  277. C search success indicator
  278. PARAMETER (PFAIL = 0 )
  279. PARAMETER (PSUCC = 1 )
  280. C state of visual representation
  281. PARAMETER (PVROK = 0 )
  282. PARAMETER (PVRDFR = 1 )
  283. PARAMETER (PVRSIM = 2 )
  284. C structure network source
  285. PARAMETER (PCSS = 0 )
  286. PARAMETER (PARCHV = 1 )
  287. C structure state value
  288. PARAMETER (PSTCL = 0 )
  289. PARAMETER (PSTOP = 1 )
  290. C structure status indicator
  291. PARAMETER (PSNOEX = 0 )
  292. PARAMETER (PSEMPT = 1 )
  293. PARAMETER (PSNEMP = 2 )
  294. C system state value
  295. PARAMETER (PPHCL = 0 )
  296. PARAMETER (PPHOP = 1 )
  297. C text alignment horizontal
  298. PARAMETER (PAHNOR = 0 )
  299. PARAMETER (PALEFT = 1 )
  300. PARAMETER (PACENT = 2 )
  301. PARAMETER (PARITE = 3 )
  302. C text alignment vartical
  303. PARAMETER (PAVNOR = 0 )
  304. PARAMETER (PATOP = 1 )
  305. PARAMETER (PACAP = 2 )
  306. PARAMETER (PAHALF = 3 )
  307. PARAMETER (PABASE = 4 )
  308. PARAMETER (PABOTT = 5 )
  309. C text path
  310. PARAMETER (PRIGHT = 0 )
  311. PARAMETER (PLEFT = 1 )
  312. PARAMETER (PUP = 2 )
  313. PARAMETER (PDOWN = 3 )
  314. C text precision
  315. PARAMETER (PSTRP = 0 )
  316. PARAMETER (PCHARP = 1 )
  317. PARAMETER (PSTRKP = 2 )
  318. C type of returned values
  319. PARAMETER (PSET = 0 )
  320. PARAMETER (PREALI = 1 )
  321. C update state
  322. PARAMETER (PNPEND = 0 )
  323. PARAMETER (PPEND = 1 )
  324. C vector/raster/other type
  325. PARAMETER (PVECTR = 0 )
  326. PARAMETER (PRASTR = 1 )
  327. PARAMETER (POTHWK = 2 )
  328. C viewtype
  329. PARAMETER (PPARL = 0 )
  330. PARAMETER (PPERS = 1 )
  331. C workstation category
  332. PARAMETER (POUTPT = 0 )
  333. PARAMETER (PINPUT = 1 )
  334. PARAMETER (POUTIN = 2 )
  335. PARAMETER (PMO = 3 )
  336. PARAMETER (PMI = 4 )
  337. C workstation dependence indicator
  338. PARAMETER (PWKI = 0 )
  339. PARAMETER (PWKD = 1 )
  340. C workstation state value
  341. PARAMETER (PWSCL = 0 )
  342. PARAMETER (PWSOP = 1 )
  343. C current(and requested values
  344. PARAMETER (PCURVL = 0 )
  345. PARAMETER (PRQSVL = 1 )
  346. C error handling
  347. PARAMETER (EOPPH = 0 )
  348. PARAMETER (ECLPH = 1 )
  349. PARAMETER (EOPWK = 2 )
  350. PARAMETER (ECLWK = 3 )
  351. PARAMETER (ERST = 4 )
  352. PARAMETER (EUWK = 5 )
  353. PARAMETER (ESDUS = 6 )
  354. PARAMETER (EMSG = 7 )
  355. PARAMETER (EPL3 = 8 )
  356. PARAMETER (EPL = 9 )
  357. PARAMETER (EPM3 = 10 )
  358. PARAMETER (EPM = 11 )
  359. PARAMETER (ETX3 = 12 )
  360. PARAMETER (ETX = 13 )
  361. PARAMETER (EATR3 = 14 )
  362. PARAMETER (EATR = 15 )
  363. PARAMETER (EFA3 = 16 )
  364. PARAMETER (EFA = 17 )
  365. PARAMETER (EFAS3 = 18 )
  366. PARAMETER (EFAS = 19 )
  367. PARAMETER (ECA3 = 20 )
  368. PARAMETER (ECA = 21 )
  369. PARAMETER (EGDP3 = 22 )
  370. PARAMETER (EGDP = 23 )
  371. PARAMETER (ESPLI = 24 )
  372. PARAMETER (ESPMI = 25 )
  373. PARAMETER (ESTXI = 26 )
  374. PARAMETER (ESII = 27 )
  375. PARAMETER (ESEDI = 28 )
  376. PARAMETER (ESLN = 29 )
  377. PARAMETER (ESLWSC = 30 )
  378. PARAMETER (ESPLCI = 31 )
  379. PARAMETER (ESMK = 32 )
  380. PARAMETER (ESMKSC = 33 )
  381. PARAMETER (ESPMCI = 34 )
  382. PARAMETER (ESTXFN = 35 )
  383. PARAMETER (ESTXPR = 36 )
  384. PARAMETER (ESCHXP = 37 )
  385. PARAMETER (ESCHSP = 38 )
  386. PARAMETER (ESTXCI = 39 )
  387. PARAMETER (ESCHH = 40 )
  388. PARAMETER (ESCHUP = 41 )
  389. PARAMETER (ESTXP = 42 )
  390. PARAMETER (ESTXAL = 43 )
  391. PARAMETER (ESATCH = 44 )
  392. PARAMETER (ESATCU = 45 )
  393. PARAMETER (ESATP = 46 )
  394. PARAMETER (ESATAL = 47 )
  395. PARAMETER (ESANS = 48 )
  396. PARAMETER (ESIS = 49 )
  397. PARAMETER (ESISI = 50 )
  398. PARAMETER (ESICI = 51 )
  399. PARAMETER (ESEDFG = 52 )
  400. PARAMETER (ESEDT = 53 )
  401. PARAMETER (ESEWSC = 54 )
  402. PARAMETER (ESEDCI = 55 )
  403. PARAMETER (ESPA = 56 )
  404. PARAMETER (ESPRPV = 57 )
  405. PARAMETER (ESPARF = 58 )
  406. PARAMETER (EADS = 59 )
  407. PARAMETER (ERES = 60 )
  408. PARAMETER (ESIASF = 61 )
  409. PARAMETER (ESPLR = 62 )
  410. PARAMETER (ESPMR = 63 )
  411. PARAMETER (ESTXR = 64 )
  412. PARAMETER (ESIR = 65 )
  413. PARAMETER (ESEDR = 66 )
  414. PARAMETER (ESPAR = 67 )
  415. PARAMETER (ESCR = 68 )
  416. PARAMETER (ESHLFT = 69 )
  417. PARAMETER (ESIVFT = 70 )
  418. PARAMETER (ESCMD = 71 )
  419. PARAMETER (ESHRID = 72 )
  420. PARAMETER (ESHRM = 73 )
  421. PARAMETER (ESLMT3 = 74 )
  422. PARAMETER (ESLMT = 75 )
  423. PARAMETER (ESGMT3 = 76 )
  424. PARAMETER (ESGMT = 77 )
  425. PARAMETER (ESMCV3 = 78 )
  426. PARAMETER (ESMCV = 79 )
  427. PARAMETER (ESMCLI = 80 )
  428. PARAMETER (ERMCV = 81 )
  429. PARAMETER (ESVWI = 82 )
  430. PARAMETER (ESVWR3 = 83 )
  431. PARAMETER (ESVWR = 84 )
  432. PARAMETER (ESVTIP = 85 )
  433. PARAMETER (ESWKW3 = 86 )
  434. PARAMETER (ESWKW = 87 )
  435. PARAMETER (ESWKV3 = 88 )
  436. PARAMETER (ESWKV = 89 )
  437. PARAMETER (EOPST = 90 )
  438. PARAMETER (ECLST = 91 )
  439. PARAMETER (EEXST = 92 )
  440. PARAMETER (ELB = 93 )
  441. PARAMETER (EAP = 94 )
  442. PARAMETER (EGSE = 95 )
  443. PARAMETER (ESEDM = 96 )
  444. PARAMETER (ECELST = 97 )
  445. PARAMETER (ESEP = 98 )
  446. PARAMETER (EOSEP = 99 )
  447. PARAMETER (ESEPLB = 100)
  448. PARAMETER (EDEL = 101)
  449. PARAMETER (EDELRA = 102)
  450. PARAMETER (EDELLB = 103)
  451. PARAMETER (EEMST = 104)
  452. PARAMETER (EDST = 105)
  453. PARAMETER (EDSN = 106)
  454. PARAMETER (EDSA = 107)
  455. PARAMETER (ECSTID = 108)
  456. PARAMETER (ECSTRF = 109)
  457. PARAMETER (ECSTIR = 110)
  458. PARAMETER (EPOST = 111)
  459. PARAMETER (EUPOST = 112)
  460. PARAMETER (EUPAST = 113)
  461. PARAMETER (EOPARF = 114)
  462. PARAMETER (ECLARF = 115)
  463. PARAMETER (EARST = 116)
  464. PARAMETER (EARSN = 117)
  465. PARAMETER (EARAST = 118)
  466. PARAMETER (ESCNRS = 119)
  467. PARAMETER (ERSID = 120)
  468. PARAMETER (EREST = 121)
  469. PARAMETER (ERESN = 122)
  470. PARAMETER (ERAST = 123)
  471. PARAMETER (EREPAN = 124)
  472. PARAMETER (EREPED = 125)
  473. PARAMETER (EDSTAR = 126)
  474. PARAMETER (EDSNAR = 127)
  475. PARAMETER (EDASAR = 128)
  476. PARAMETER (ESPKID = 129)
  477. PARAMETER (ESPKFT = 130)
  478. PARAMETER (EINLC3 = 131)
  479. PARAMETER (EINLC = 132)
  480. PARAMETER (EINSK3 = 133)
  481. PARAMETER (EINSK = 134)
  482. PARAMETER (EINVL3 = 135)
  483. PARAMETER (EINVL = 136)
  484. PARAMETER (EINCH3 = 137)
  485. PARAMETER (EINCH = 138)
  486. PARAMETER (EINPK3 = 139)
  487. PARAMETER (EINPK = 140)
  488. PARAMETER (EINST3 = 141)
  489. PARAMETER (EINST = 142)
  490. PARAMETER (ESLCM = 143)
  491. PARAMETER (ESSKM = 144)
  492. PARAMETER (ESVLM = 145)
  493. PARAMETER (ESCHM = 146)
  494. PARAMETER (ESPKM = 147)
  495. PARAMETER (ESSTM = 148)
  496. PARAMETER (ERQLC3 = 149)
  497. PARAMETER (ERQLC = 150)
  498. PARAMETER (ERQSK3 = 151)
  499. PARAMETER (ERQSK = 152)
  500. PARAMETER (ERQVL = 153)
  501. PARAMETER (ERQCH = 154)
  502. PARAMETER (ERQPK = 155)
  503. PARAMETER (ERQST = 156)
  504. PARAMETER (ESMLC3 = 157)
  505. PARAMETER (ESMLC = 158)
  506. PARAMETER (ESMSK3 = 159)
  507. PARAMETER (ESMSK = 160)
  508. PARAMETER (ESMVL = 161)
  509. PARAMETER (ESMCH = 162)
  510. PARAMETER (ESMPK = 163)
  511. PARAMETER (ESMST = 164)
  512. PARAMETER (EWAIT = 165)
  513. PARAMETER (EFLUSH = 166)
  514. PARAMETER (EGTLC3 = 167)
  515. PARAMETER (EGTLC = 168)
  516. PARAMETER (EGTSK3 = 169)
  517. PARAMETER (EGTSK = 170)
  518. PARAMETER (EGTVL = 171)
  519. PARAMETER (EGTCH = 172)
  520. PARAMETER (EGTPK = 173)
  521. PARAMETER (EGTST = 174)
  522. PARAMETER (EWITM = 175)
  523. PARAMETER (EGTITM = 176)
  524. PARAMETER (ERDITM = 177)
  525. PARAMETER (EIITM = 178)
  526. PARAMETER (ESERHM = 179)
  527. PARAMETER (EESC = 180)
  528. PARAMETER (EPREC = 181)
  529. PARAMETER (EUREC = 182)
  530. C error handling PHIGS+
  531. PARAMETER (EPLSD3 = 301)
  532. PARAMETER (EFASD3 = 302)
  533. PARAMETER (ECAP3 = 303)
  534. PARAMETER (ESOFA3 = 304)
  535. PARAMETER (ETSD3 = 305)
  536. PARAMETER (EQMD3 = 306)
  537. PARAMETER (ENUBSC = 307)
  538. PARAMETER (ENUBSS = 308)
  539. PARAMETER (ESBII = 309)
  540. PARAMETER (ESPLC = 310)
  541. PARAMETER (ESPLSM = 311)
  542. PARAMETER (ESPMC = 312)
  543. PARAMETER (ESTXC = 313)
  544. PARAMETER (ESFDM = 314)
  545. PARAMETER (ESFCM = 315)
  546. PARAMETER (ESIC = 316)
  547. PARAMETER (ESISM = 317)
  548. PARAMETER (ESRFP = 318)
  549. PARAMETER (ESRFE = 319)
  550. PARAMETER (ESBIS = 320)
  551. PARAMETER (ESBISI = 321)
  552. PARAMETER (ESBIC = 322)
  553. PARAMETER (ESBISM = 323)
  554. PARAMETER (ESBRFP = 324)
  555. PARAMETER (ESBRFE = 325)
  556. PARAMETER (ESLSS = 326)
  557. PARAMETER (ESEDC = 327)
  558. PARAMETER (ESCAC = 328)
  559. PARAMETER (ESSAC = 329)
  560. PARAMETER (ESPCH = 330)
  561. PARAMETER (ESRCM = 331)
  562. PARAMETER (ESDCI = 332)
  563. PARAMETER (ESCMI = 333)
  564. PARAMETER (ESPLRP = 334)
  565. PARAMETER (ESPMRP = 335)
  566. PARAMETER (ESTXRP = 336)
  567. PARAMETER (ESIRP = 337)
  568. PARAMETER (ESEDRP = 338)
  569. PARAMETER (ESPARP = 339)
  570. PARAMETER (ESLSR = 340)
  571. PARAMETER (ESDCR = 341)
  572. PARAMETER (ESCMR = 342)
  573. C error handling PEX
  574. PARAMETER (EWTCRE = -1 )
  575. PARAMETER (EWTSET = -2 )
  576. PARAMETER (EWTGET = -3 )
  577. PARAMETER (EWTDES = -4 )
  578. PARAMETER (EOPPEX = -5 )
  579. C culling mode
  580. PARAMETER (PNCUL = 0 )
  581. PARAMETER (PBFAC = 1 )
  582. PARAMETER (PFFAC = 2 )
  583. C disting mode
  584. PARAMETER (PDSNO = 0 )
  585. PARAMETER (PDSYES = 1 )
  586. C depth cue mode
  587. PARAMETER (PSUPPR = 0 )
  588. PARAMETER (PALLOW = 1 )
  589. C facet flag
  590. PARAMETER (PNOF = 0 )
  591. PARAMETER (PFCOLR = 1 )
  592. PARAMETER (PFNORM = 2 )
  593. PARAMETER (PFCONO = 3 )
  594. C rationality
  595. PARAMETER (PRATIO = 0 )
  596. PARAMETER (PNONRA = 1 )
  597. C vertex flag
  598. PARAMETER (PCOORD = 0 )
  599. PARAMETER (PCCOLR = 1 )
  600. PARAMETER (PCNORM = 2 )
  601. PARAMETER (PCCONO = 3 )
  602. C edge flag
  603. PARAMETER (PNOE = 0 )
  604. PARAMETER (PEVIS = 1 )
  605. C HLHSR identifier
  606. PARAMETER (PHIOFF = 0 )
  607. PARAMETER (PHION = 1 )
  608. C HLHSR mode
  609. PARAMETER (PHMNON = 0 )
  610. PARAMETER (PHMZBF = 1 )
  611. C ESCAPE error synchronization mode
  612. PARAMETER (PESOFF = 0 )
  613. PARAMETER (PESON = 1 )
  614. C ESCAPE local input transformation type
  615. PARAMETER (PLCMOD = 0 )
  616. PARAMETER (PLCVIW = 1 )
  617. C ESCAPE local input transformation matrix create type
  618. PARAMETER (PLCACC = 0 )
  619. PARAMETER (PLCGEN = 1 )
  620. C ESCAPE local input conflation type
  621. PARAMETER (PLCABU = 0 )
  622. PARAMETER (PLCPRC = 1 )
  623. PARAMETER (PLCPRU = 2 )
  624. C ESCAPE local input local input rotate axis
  625. PARAMETER (PLCFIR = 0 )
  626. PARAMETER (PLCSEC = 1 )
  627. PARAMETER (PLCTHI = 2 )
  628. C ESCAPE view transformation effect mode
  629. PARAMETER (PNPC = 0 )
  630. PARAMETER (PVPC = 1 )
  631. C ESCAPE input value reference mode
  632. PARAMETER (PINVAL = 0 )
  633. C PARAMETER (PVAL = 1 ) En conflit avec l'entry PV
  634. C GDP arc close type
  635. PARAMETER (PACFAN = 0 )
  636. PARAMETER (PACCHD = 1 )
  637. C GSE side point attribute
  638. PARAMETER (PSPCIR = 0 )
  639. PARAMETER (PSPSQU = 1 )
  640. PARAMETER (PSPFLA = 2 )
  641. C PHIGS moniter ON/OFF flag
  642. PARAMETER (PMON = 0 )
  643. PARAMETER (PNOMON = 1 )
  644. C clients side CSS flag
  645. PARAMETER (PSERVR = 0 )
  646. PARAMETER (PCLIET = 1 )
  647. C buffer mode
  648. PARAMETER (PSINGL = 0 )
  649. PARAMETER (PDOUBL = 1 )
  650. ***** fin de declaration pour PHIGS
  651. *****
  652. *****
  653. SAVE IWKIDLI,KMETA,WKTY
  654. SAVE ICCOL,ICOISI,WKID,X1,X2,Y1,Y2,WRATIO,INUSEG
  655. SAVE XINID,YINID,SXMIN,SXXAX,SYMIN,SYYAX,RX,RY,AX,AY
  656. SAVE TEXTX,TEXTY,INCOOR,TEXTE,ICCLE,IACT,IWISS,VALEUR
  657. SAVE NHAUT,HAUT
  658. SAVE IPF
  659. SAVE IPPP,INMP,IDEFOR,IFF
  660. DIMENSION IPF(24)
  661. C
  662. C declaration des variables utilisees par la partie PHIGS
  663. C -------------------------------------------------------
  664. SAVE PGSVWI,PGIVNB,PGIVIN,PGHPNB,PGHPIN,PGFLAG,PGFLZO
  665. SAVE PGX1,PGX2,PGY1,PGY2
  666. SAVE PGRX,PGRY
  667. save tool1
  668. C..... sert dans trtext a ne definir qu'une fois la vue 4
  669. SAVE IFV
  670. integer tool1
  671. REAL PGRX,PGRY,PGRAP
  672. REAL PGX1,PGX2,PGY1,PGY2
  673. INTEGER PGSVWI,PGIVNB,PGHPNB,PGTYPE
  674. INTEGER PGIVEX(1),PGHPEX(1),PGIVIN(4096),PGHPIN(4096),LIST(4096)
  675. INTEGER PGFLAG,PGFLZO
  676. INTEGER PGDEPT,PGPATH(3,2)
  677. REAL VWWNLM(4),PJVPLM(4)
  678. REAL VXMIN,VXMAX
  679. SAVE VXMIN,VXMAX
  680. INTEGER IERR,XYCLIPI,ISEG
  681. REAL VWMPMT(3,3),VWORMT(3,3)
  682. C---> tableaux de correspondance des couleurs
  683. C
  684. C fin modif
  685. C-----------------------------------------------------------------------
  686.  
  687. CHARACTER*(*) TITRE
  688. DIMENSION XTR(*),YTR(*),ZTR(*)
  689. DIMENSION RMAT(9)
  690. DIMENSION IBOIF(8)
  691. CHARACTER*5 NBOIF(8)
  692. CHARACTER*8 NAME
  693. CHARACTER*(*) CARACT
  694. CHARACTER*(*) LEGEND(*)
  695. LOGICAL VALEUR,FENET,VALEU
  696. CHARACTER*20 STRING
  697. DIMENSION PXA(4),PYA(4)
  698. DIMENSION TEXTX(50),TEXTY(50)
  699. CHARACTER*1 CARELE(10)
  700. CHARACTER*6 STR
  701. CHARACTER*4 STR1
  702. CHARACTER*15 TEXTE(50)
  703. INTEGER WKID,WKCON,WKTY
  704. INTEGER STAT
  705. DATA ICCOUN/0/
  706. DATA CARELE /'0','1','2','3','4','5','6','7','8','9'/
  707. DATA STR1 /'META'/
  708. DATA WKID/3/
  709. DATA ICCOL/7/
  710. DATA IACT/0/
  711. DATA IWISS/0/
  712. C-----------------------------------------------------------------------
  713. C data utilisees par la partie PHIGS
  714. C
  715. DATA PGSVWI/0/
  716. DATA PGIVNB/0/
  717. DATA PGHPNB/0/
  718. DATA PGFLAG/0/
  719. DATA PGFLZO/0/
  720. C indices de couleurs
  721. C
  722. C pour le 2 menu :pave correspondant aux isovaleurs
  723. DATA NBOIF/'ZOOM ','INI ','VAL ','ANIM ','IMPR ',' ',
  724. & ' ','FIN '/
  725. DATA IBOIF/10,13,15,11,12,0,0,17/
  726. C-----------------------------------------------------------------------
  727. NCOUMA=16
  728. HAUT=HAUTT
  729. NHAUT=31
  730. VALEUR=VALEU
  731. KSEGN=0
  732. AX=AXAX
  733. AY=AYAY
  734. C DO 1 NBCR=72,2,-1
  735. DO1NBCR=72,2,-1
  736. IF (TITRE(NBCR:NBCR).NE.' ') GOTO 2
  737. 1 CONTINUE
  738. 2 CONTINUE
  739. C
  740. C PTRINIT1
  741. C debut du bloc phigs de TRINIT
  742. C
  743. 60 CONTINUE
  744. C ---------------------------------------------------------------
  745. C : menu fen princ legendes texte :
  746. C : numeros de vues 1 2 3 4 :
  747. C ---------------------------------------------------------------
  748.  
  749. C iff sert a gerer l'effac. des stuct.ass. a du texte
  750. IFF=0
  751. IFV=0
  752. * je ne sais pas a quoi ca sert
  753. IPPP=0
  754. INMP=0
  755. IDEFOR=0
  756. IFF=0
  757. C indicateur de zoom
  758. PGFLZO=0
  759.  
  760. C numero de vue
  761. PGSVWI=0
  762.  
  763. C indicateur d'impresssion pour les fichiers trace
  764. C (mettre inmp=1 si aucun fichier trace n'est desire)
  765. ippp=0
  766. inmp=0
  767. C
  768. X1=0.
  769. X2=0.
  770. Y1=0.
  771. Y2=0.
  772. INCOOR=0
  773. C numeros de structures associes au texte (vue 4)
  774. INUSEG=50+(100*(WKID-1))
  775. IXSEG=0
  776. ICCLE=0
  777. IF(IACT.EQ.1) THEN
  778. C permet de savoir si une structure est ouverte
  779. CALL PQOPST(IIERR,PGTYPE,INUM)
  780. C si oui elle est fermee
  781. IF(PGTYPE.EQ.POPNST) CALL PCLST
  782. NWAC=0
  783. C permet de savoir si Work station est ouverte
  784. C Dans FIGARO il ne peut y avoir qu'une seule Work station
  785. C d'ouverte a la fois
  786. 62 CALL PQOPWK(NWAC,IERR,NTWAC,NWID)
  787. IF(NWID.EQ.WKID)GOTO 61
  788. IF(NWAC.EQ.NTWAC)GOTO 63
  789. NWAC=NWAC+1
  790. GOTO 62
  791. 61 CONTINUE
  792. C si oui les structures associes sont depostees
  793. CALL PUPAST(WKID)
  794. GOTO 65
  795. 63 CONTINUE
  796. GOTO 64
  797. ENDIF
  798. C si phigs n'a pas ete ouvert il est ouvert ici
  799. IF (PGFLAG.EQ.0) THEN
  800. CALL POPPH(6,0)
  801. C on definit les parametres de la fenetre graphique
  802. * CALL PHIGSWSTCREATE(phigswsttool, tool1)
  803. * CALL PHIGSWSTSET(tool1, PHIGSTOOLFGDCLR,120,120,120)
  804. * CALL PHIGSWSTSET(tool1, PHIGSTOOLLABEL,"Graphique CASTEM2000")
  805. * CALL PHIGSWSTSET(tool1, PHIGSTOOLWIDTH, 600)
  806. * CALL PHIGSWSTSET(tool1, PHIGSTOOLHEIGHT, 600)
  807. * CALL PHIGSWSTSET(tool1, PHIGSTOOLX, 542)
  808. * CALL PHIGSWSTSET(tool1, PHIGSTOOLY, 277)
  809. PGFLAG = 1
  810. ENDIF
  811.  
  812. 64 CONTINUE
  813. WKCON=0
  814. C ouverture de la Work station WKID
  815. C***** CALL POPWK(WKID,WKCON,phigswsttool)
  816. tool1=0
  817. CALL POPWK(WKID,WKCON,tool1)
  818. CALL PSDUS(WKID,4,0)
  819. 65 CONTINUE
  820. C WKCON=0
  821. IWKIDLI=3
  822. KMETA=1
  823. WKTY=0
  824. IACT=1
  825. * creation de la structure initiale : 1 PV
  826. CALL POPST(1)
  827. CALL PEMST(1)
  828. ISGNEW=9+(100*(WKID-1))
  829. CALL PEXST(ISGNEW)
  830. CALL PEXST(3)
  831. ISEG=6+(100*(WKID-1))
  832. CALL PEXST(ISEG)
  833. CALL PCLST
  834. CALL POPST(ISGNEW)
  835. CALL PEMST(ISGNEW)
  836. CALL PCLST
  837. CALL POPST(3)
  838. CALL PEMST(3)
  839. CALL PADS(1,3)
  840. CALL PSVWI(PGSVWI)
  841. CALL PCLST
  842. CALL PPOST(WKID,1,1.)
  843. C ouverture de la structure ISEG
  844. CALL POPST(ISEG)
  845. C la structure ISEG est videe
  846. CALL PEMST(ISEG)
  847. C la structure ISEG est postee sur la Work station WKID
  848. C CALL PPOST(WKID,ISEG,1.)
  849. C name set utilse par les filtres d'invisibilite et de detectabili
  850. CALL PADS(1,ISEG)
  851. C la structure ISEG est associee a la vue PGSVWI
  852. CALL PSVWI(PGSVWI)
  853. C mise a jour des filtres d'invisiblite
  854. CALL PSVIS(PGIVNB,PGIVIN,ISEG,0)
  855. CALL PSVIS(PGHPNB,PGHPIN,ISEG,0)
  856. CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
  857. CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
  858. C redefinition des couleurs
  859. * XAllocNamedColor(dp,colors,"white",&xcsd[0],&xced);
  860. * XAllocNamedColor(dp,colors,"blue",&xcsd[1],&xced);
  861. * XAllocNamedColor(dp,colors,"red",&xcsd[2],&xced);
  862. * XAllocNamedColor(dp,colors,"magenta",&xcsd[3],&xced);
  863. * XAllocNamedColor(dp,colors,"green",&xcsd[4],&xced);
  864. * XAllocNamedColor(dp,colors,"MediumTurquoise",&xcsd[5],&xced);
  865. * XAllocNamedColor(dp,colors,"yellow",&xcsd[6],&xced);
  866. * XAllocNamedColor(dp,colors,"white",&xcsd[7],&xced);
  867. * XAllocNamedColor(dp,colors,"black",&xcsd[8],&xced);
  868. * XAllocNamedColor(dp,colors,"DarkSlateBlue",&xcsd[9],&xced);
  869. * XAllocNamedColor(dp,colors,"orange",&xcsd[10],&xced);
  870. * XAllocNamedColor(dp,colors,"VioletRed",&xcsd[11],&xced);
  871. * XAllocNamedColor(dp,colors,"MediumSeaGreen",&xcsd[12],&xced);
  872. * XAllocNamedColor(dp,colors,"DarkTurquoise",&xcsd[13],&xced);
  873. * XAllocNamedColor(dp,colors,"YellowGreen",&xcsd[14],&xced);
  874. * XAllocNamedColor(dp,colors,"LightGrey",&xcsd[15],&xced);
  875. CALL PSCR(WKID,0,3,0.0,0.0,0.0)
  876. CALL PSCR(WKID,1,3,0.0,0.0,1.0)
  877. CALL PSCR(WKID,2,3,1.0,0.0,0.0)
  878. CALL PSCR(WKID,3,3,1.0,0.0,1.0)
  879. CALL PSCR(WKID,4,3,0.0,1.0,0.0)
  880. CALL PSCR(WKID,5,3,72/255.,209/255.,204/255.)
  881. CALL PSCR(WKID,6,3,1.0,1.0,0.0)
  882. CALL PSCR(WKID,7,3,1.0,1.0,1.0)
  883. CALL PSCR(WKID,8,3,0.0,0.0,0.0)
  884. CALL PSCR(WKID,9,3,112/255.,101/255.,179/255.)
  885. CALL PSCR(WKID,10,3,255/255.,165/255.,0.0)
  886. CALL PSCR(WKID,11,3,208/255.,32/255.,144/255.)
  887. CALL PSCR(WKID,12,3,60/255.,179/255.,113/255.)
  888. CALL PSCR(WKID,13,3,0.0,206/255.,209/255.)
  889. CALL PSCR(WKID,14,3,154/255.,205/255.,50/255.)
  890. CALL PSCR(WKID,15,3,211/255.,211/255.,211/255.)
  891. C
  892. C permet de connaitre les dimensions de la fenetre SunPHIGS
  893. C**** CALL PQDSP(phigswsttool,IERR,DC,RX,RY,LX,LY)
  894. CALL PQDSP(tool1,IERR,DC,RX,RY,LX,LY)
  895. WRATIO=RY/RX
  896. R=RY
  897. IF(WRATIO.GT.1)THEN
  898. R=RX
  899. WRATIO=1./WRATIO
  900. ENDIF
  901. C definition de la window et de la viewport en fonction du ratio
  902. CALL PSWKW(WKID,0.,1.,0.,1.)
  903. IF (RX.LE.RY) THEN
  904. VXMIN = 0.
  905. VXMAX = RX
  906. CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
  907. ELSE
  908. VXMIN = 0.
  909. VXMAX = RY
  910. CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
  911. ENDIF
  912. WRATIO=1.
  913. C CALL OSVMP(WKID,1,0.,80.,0.,2.,0.,1.,0.,(WRATIO)*0.1)
  914. VWWNLM(1) = 0.
  915. VWWNLM(2) = 80.
  916. VWWNLM(3) = 0.
  917. VWWNLM(4) = 2.
  918. PJVPLM(1) = 0.
  919. PJVPLM(2) = 1.
  920. PJVPLM(3) = 0.
  921. PJVPLM(4) = (WRATIO)*0.1
  922. CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
  923. VWORMT(1,1) = 1.
  924. VWORMT(2,2) = 1.
  925. VWORMT(3,3) = 1.
  926. VWORMT(1,2) = 0.
  927. VWORMT(1,3) = 0.
  928. VWORMT(2,1) = 0.
  929. VWORMT(2,3) = 0.
  930. VWORMT(3,1) = 0.
  931. VWORMT(3,2) = 0.
  932. XYCLIPI = 1
  933. CALL PSVWR(WKID,1,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
  934. PGSVWI=1
  935. C si une structure est ouverte ,elle est associe a la vue 1
  936. CALL PQOPST(IIERR,PGTYPE,INUM)
  937. IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
  938. C declaration de la taille du text annote
  939. C* CALL PSATCH(0.02)
  940. CALL PSATCH(0.015)
  941. C definition de la couleur du text
  942. CALL PSTXCI(7)
  943. C choix de la police de caracteres
  944. C CALL PSTXFN(-1)
  945. CALL PSTXFN(-5)
  946. C CALL PSHSP(0.2)
  947. C definition de la precision du text
  948. CALL PSTXPR(2)
  949. C ecriture du text annote
  950. CALL PATR(63.,1.3,0.,0.,'CASTEM 2000')
  951. CALL PATR(.6,1.3,0.,0.,TITRE)
  952. CALL PCLST
  953. C CALL PUWK(WKID,1)
  954. RETURN
  955. C***********************************************************************
  956.  
  957. C
  958. C subroutine DFENET
  959. C
  960. ENTRY PDFENE(XMIN,XXAX,YMIN,YYAX,XR1,XR2,YR1,YR2,FENET)
  961. EC1=AX-3.
  962. EC2=AY-3.
  963. C
  964. C PDFENET 2
  965. C debut du bloc phigs de DFENET
  966. C
  967. 160 CONTINUE
  968. C calcule de la fenetre de la vue 2
  969. SXMIN=XMIN
  970. SXXAX=XXAX
  971. SYMIN=YMIN
  972. SYYAX=YYAX
  973. C on se laisse une marge pour le text
  974. XDIFF=(XXAX-XMIN)/2.*1.10
  975. YDIFF=(YYAX-YMIN)/2.*1.10
  976. XMILL=(XXAX+XMIN)/2.
  977. YMILL=(YYAX+YMIN)/2.
  978. IF (FENET) THEN
  979. RAP=(XDIFF/YDIFF)
  980. ELSE
  981. RAP=1.
  982. ENDIF
  983. IF (RAP.GE.1) THEN
  984. X1=XMILL-XDIFF
  985. X2=XMILL+XDIFF
  986. Y1=YMILL-(YDIFF*RAP)
  987. Y2=YMILL+(YDIFF*RAP)
  988. ELSE
  989. X1=XMILL-(XDIFF/RAP)
  990. X2=XMILL+(XDIFF/RAP)
  991. Y1=YMILL-YDIFF
  992. Y2=YMILL+YDIFF
  993. ENDIF
  994. C sauvegarde des valeurs de la fenetre pour le retour a la vue
  995. C initiale
  996. PGX1=X1
  997. PGX2=X2
  998. PGY1=Y1
  999. PGY2=Y2
  1000. C (pour pouvoir faire un req loc)
  1001. C CALL PSVWCS(WKID,2,1,1,1,0,0)
  1002. CALL PSVTIP(WKID,2,0,0)
  1003.  
  1004. C**** CALL PQDSP(phigswsttool,IERR,DC,PGRX,PGRY,LX,LY)
  1005. CALL PQDSP(tool1,IERR,DC,PGRX,PGRY,LX,LY)
  1006. PGRAP=MIN (PGRX/RX,PGRY/RY)
  1007. IF (PGRX .LE. PGRY) THEN
  1008. VXMIN = .5*(PGRX-PGRAP*RX)
  1009. VXMAX = .5*(PGRX+PGRAP*RX)
  1010. CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
  1011. ELSE
  1012. VXMIN = .5*(PGRX-PGRAP*RY)
  1013. VXMAX = .5*(PGRX+PGRAP*RY)
  1014. CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
  1015. ENDIF
  1016.  
  1017. VWWNLM(1) = X1
  1018. VWWNLM(2) = X2
  1019. VWWNLM(3) = Y1
  1020. VWWNLM(4) = Y2
  1021. VWORMT(1,1) = 1.
  1022. VWORMT(2,2) = 1.
  1023. VWORMT(3,3) = 1.
  1024. VWORMT(1,2) = 0.
  1025. VWORMT(1,3) = 0.
  1026. VWORMT(2,1) = 0.
  1027. VWORMT(2,3) = 0.
  1028. VWORMT(3,1) = 0.
  1029. VWORMT(3,2) = 0.
  1030. XYCLIPI = 1
  1031. PJVPLM(1) = 0.
  1032. PJVPLM(3) = (WRATIO)*0.1
  1033. IF(VALEUR) THEN
  1034. C CALL OSVMP(WKID,2,X1,X2,Y1,Y2,0.,0.8,(WRATIO)*0.1,(WRATIO)*0.9)
  1035. PJVPLM(2) = 0.8
  1036.  
  1037. PJVPLM(4) = (WRATIO)*0.9
  1038.  
  1039. CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
  1040. CALL PSVWR(WKID,2,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
  1041. ELSE
  1042. C CALL OSVMP(WKID,2,X1,X2,Y1,Y2,0.,0.9,(WRATIO)*0.1,(WRATIO))
  1043. PJVPLM(2) = 0.9
  1044.  
  1045. PJVPLM(4) = WRATIO
  1046.  
  1047. CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
  1048. CALL PSVWR(WKID,2,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
  1049. ENDIF
  1050.  
  1051. PGSVWI=2
  1052. C si une structure est ouverte ,elle est associe a la vue 2
  1053. CALL PQOPST(IIERR,PGTYPE,INUM)
  1054. IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
  1055. XINID=(X1+X2)/2.
  1056. YINID=(Y1+Y2)/2.
  1057. XR1=XMIN
  1058. XR2=XXAX
  1059. YR1=YMIN
  1060. YR2=YYAX
  1061. C fermeture eventuelle d'une structure ouverte ,elle est aussi vid
  1062. CALL PQOPST(IIERRI,PGTYPE,INUM)
  1063. IF(PGTYPE.EQ.POPNST) THEN
  1064. CALL PCLST
  1065. CALL PEMST(INUM)
  1066. ENDIF
  1067. INUM=8+(100*(WKID-1))
  1068. CALL PEMST(INUM)
  1069. ISEG=1+(100*(WKID-1))
  1070. C............................................
  1071. C reinitialisation du contexte
  1072. C ouverture de la structure ISEG
  1073. CALL POPST(1)
  1074. CALL PEXST(ISEG)
  1075. CALL PCLST
  1076. CALL POPST(ISEG)
  1077. C la structure ISEG est videe
  1078. CALL PEMST(ISEG)
  1079. CALL PADS(1,ISEG)
  1080. C la structure ISEG est associee a la vue PGSVWI
  1081. CALL PSVWI(PGSVWI)
  1082. C la structure est declaree visible et detectable
  1083. CALL PSVIS(PGIVNB,PGIVIN,ISEG,0)
  1084. CALL PSVIS(PGHPNB,PGHPIN,ISEG,0)
  1085. CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
  1086. CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
  1087. IXSEG=1
  1088. C choix de la police de caracteres
  1089. CALL PSTXFN(-4)
  1090. C definition de la precision du text
  1091. CALL PSTXPR(2)
  1092. CHH=(Y2-Y1)/50.0
  1093. C taille des caracteres par defaut ( important pour le trace de
  1094. C courbes
  1095. CALL PSCHSP(0.15)
  1096. C declaration de la taille du text annote
  1097. CALL PSATCH(0.010)
  1098. CHXPO = 1.
  1099. CHXP=(X2-X1)/(Y2-Y1)/RX*RY*CHXPO
  1100. C definition des attributs de couleur en fonction de la couleur
  1101. C courant (ICCOL)
  1102. CALL PSICI(ICCOL)
  1103. CALL PSPLCI(ICCOL)
  1104. CALL PSPMCI(ICCOL)
  1105. CALL PSTXCI(ICCOL)
  1106. ICOISI=-100
  1107. C...... ecriture du fichier trace
  1108. IF (IPPP.EQ.1) THEN
  1109. CALL PQOPST(IERR,ISTYPE,ID)
  1110. C CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
  1111. ENDIF
  1112. RETURN
  1113. C***********************************************************************
  1114. C
  1115. C subroutine TRLABL
  1116. C
  1117. ENTRY PTRLAB(X,Y,CARACT,NCAR,HAUTT)
  1118. HAUT=HAUTT
  1119. C DO 201 ICAR=NCAR,1,-1
  1120. DO201ICAR=NCAR,1,-1
  1121. IF (CARACT(ICAR:ICAR).NE.' ') GOTO 202
  1122. 201 CONTINUE
  1123. RETURN
  1124. 202 CONTINUE
  1125. C
  1126. C PTRLABL 3
  1127. C debut du bloc phigs de TRLABL
  1128. C
  1129. 260 CONTINUE
  1130. CALL PQOPST(IERR,ISTYPE,ID)
  1131. IF (ISTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
  1132. C CALL PSCHSP(0.10)
  1133. CALL PSCHSP(0.20)
  1134. CALL PSTXFN(-2)
  1135. C on retrace le texte
  1136. CALL PATR(X,Y,0.,0.,CARACT)
  1137. RETURN
  1138. C***********************************************************************
  1139.  
  1140. C
  1141. C subroutine TRBOX
  1142. C
  1143. ENTRY PTRBOX (HAUTX,HAUTY)
  1144. C
  1145. C debut du bloc phigs de TRBOX
  1146. C
  1147. 1260 CONTINUE
  1148. CCCC CALL PSTXFN(-1)
  1149. C definition de la precision du texte
  1150.  
  1151. CALL PSTXPR(2)
  1152. CHH = 0.01
  1153. CHXP = 1.
  1154. RETURN
  1155. C***********************************************************************
  1156. C
  1157. C subroutine CHCOUL
  1158. C
  1159. ENTRY PCHCOU(JCOLO)
  1160. C
  1161. C PCHCOUL 5
  1162. C debut du bloc phigs de CHCOUL
  1163. C
  1164. 345 CONTINUE
  1165. C si il n'y a pas eu de zoom
  1166. C definition des attributs de couleur en fonction de la couleur
  1167. C courante (ICCOL)
  1168. C IF (PGFLZO.EQ.0) THEN
  1169. CALL PSICI(JCOLO)
  1170. CALL PSPLCI(JCOLO)
  1171. CALL PSPMCI(JCOLO)
  1172. CALL PSTXCI(JCOLO)
  1173. C ENDIF
  1174. RETURN
  1175. C***********************************************************************
  1176.  
  1177. C
  1178. C subroutine FVALIS
  1179. C
  1180. ENTRY PFVALI(IFENI,IRESU,NH)
  1181. C
  1182. C PFVALIS 6
  1183. C debut du bloc phigs de FVALIS
  1184. C
  1185. 390 CONTINUE
  1186. IF (IPPP.EQ.1) THEN
  1187. CALL PQOPST(IERR,ISTYPE,ID)
  1188. C CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
  1189. ENDIF
  1190. C
  1191. IF (IFENI.EQ.1) THEN
  1192. WRATIO=1
  1193. IRESU=0
  1194. C........................................................
  1195.  
  1196. C.... definition de la vue numero 3
  1197. C**** CALL PQDSP(phigswsttool,IERR,DC,PGRX,PGRY,LX,LY)
  1198. CALL PQDSP(tool1,IERR,DC,PGRX,PGRY,LX,LY)
  1199. PGRAP=MIN (PGRX/RX,PGRY/RY)
  1200. IF (PGRX .LE. PGRY) THEN
  1201. VXMIN = .5*(PGRX-PGRAP*RX)
  1202. VXMAX = .5*(PGRX+PGRAP*RX)
  1203. CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
  1204. ELSE
  1205. VXMIN = .5*(PGRX-PGRAP*RY)
  1206. VXMAX = .5*(PGRX+PGRAP*RY)
  1207. CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
  1208. ENDIF
  1209.  
  1210. C CALL OSVMP(WKID,3,0.,1.,2.,33.,0.81,1.,(WRATIO)*0.1,(WRATIO)*0.9)
  1211. VWWNLM(1) = 0.
  1212. VWWNLM(2) = 1.
  1213. VWWNLM(3) = 2.
  1214. VWWNLM(4) = 33.
  1215. PJVPLM(1) = 0.81
  1216. PJVPLM(2) = 1.
  1217. PJVPLM(3) = (WRATIO)*0.1
  1218. PJVPLM(4) = (WRATIO)*0.9
  1219. CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
  1220. VWORMT(1,1) = 1.
  1221. VWORMT(2,2) = 1.
  1222. VWORMT(3,3) = 1.
  1223. VWORMT(1,2) = 0.
  1224. VWORMT(1,3) = 0.
  1225. VWORMT(2,1) = 0.
  1226. VWORMT(2,3) = 0.
  1227. VWORMT(3,1) = 0.
  1228. VWORMT(3,2) = 0.
  1229. XYCLIPI = 1
  1230. CALL PSVWR(WKID,3,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
  1231. PGSVWI=3
  1232. C......................................................
  1233. C si une structure est ouverte ,elle est associe a la vue 3
  1234. CALL PQOPST(IIERR,PGTYPE,INUM)
  1235. IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
  1236. ELSE
  1237. PGSVWI=2
  1238. C si une structure est ouverte ,elle est associe a la vue 2
  1239. CALL PQOPST(IIERR,PGTYPE,INUM)
  1240. IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
  1241. ENDIF
  1242. NH=31
  1243. IF (IPPP.EQ.1) THEN
  1244. CALL PQOPST(IERR,ISTYPE,ID)
  1245. C CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
  1246. ENDIF
  1247. RETURN
  1248. C***********************************************************************
  1249.  
  1250. C
  1251. C subroutine MENU
  1252. C
  1253. ENTRY PMENU(LEGEND,NCASE,LLONG)
  1254. C
  1255. C debut du bloc phigs de MENU
  1256. C
  1257. DO 805 II=1,24
  1258. IPF(II)=1
  1259. 805 CONTINUE
  1260. 460 CONTINUE
  1261. C remise a 0 du flag de zoom lors de la definition des menus
  1262. PGFLZO = 0
  1263. PGSVWI=1
  1264. C si une structure est ouverte ,on l'associe a la vue 1 et elle
  1265. C est fermee
  1266. CALL PQOPST(IIERR,PGTYPE,INUM)
  1267. IF (PGTYPE.EQ.POPNST) THEN
  1268. CALL PSVWI(PGSVWI)
  1269.  
  1270. CALL PCLST
  1271.  
  1272. ENDIF
  1273. XB=1.
  1274. NCASE1=0
  1275. DO464KBOIT=1,13
  1276. IF(KBOIT.LE.NCASE) THEN
  1277. MLONG=LONG(LEGEND(KBOIT))
  1278. ELSE
  1279. MLONG=1
  1280. ENDIF
  1281. IF (MLONG.NE.1) NCASE1=NCASE1+1
  1282. C on efface les menus pouvant subsister !
  1283. ISEG=KBOIT+9+(100*(WKID-1))
  1284. CALL POPST(ISEG)
  1285. CALL PEMST(ISEG)
  1286. CALL PCLST
  1287. 464 CONTINUE
  1288. DO465KBOIT=1,13
  1289. KKIMP=0
  1290. IF(KBOIT.LE.NCASE) THEN
  1291. MLONG=LONG(LEGEND(KBOIT))
  1292. ELSE
  1293. MLONG=1
  1294. ENDIF
  1295. IF (KBOIT.EQ.12.AND.IPF(2).NE.0.AND.MLONG.EQ.1) KKIMP=1
  1296. IF (KKIMP.EQ.1) MLONG=4
  1297. IF (MLONG.EQ.1) GOTO 447
  1298. C definition d'autant de structures que de paves necessaire au
  1299. C menu
  1300. ISEG=KBOIT+9+(100*(WKID-1))
  1301. CALL POPST(1)
  1302. CALL PEXST(ISEG)
  1303. CALL PCLST
  1304. CALL POPST(ISEG)
  1305. CALL PEMST(ISEG)
  1306. CALL PADS(1,ISEG)
  1307. CALL PSVWI(PGSVWI)
  1308. CALL PSPKID(ISEG)
  1309. C ils sont tous rendus visibles et detectables
  1310. CALL PSVIS(PGIVNB,PGIVIN,ISEG,0)
  1311. CALL PSVIS(PGHPNB,PGHPIN,ISEG,1)
  1312. CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
  1313. CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
  1314. CALL PSIS(1)
  1315. CALL PSICI(2)
  1316. C
  1317. PXA(1)=XB
  1318. PXA(2)=PXA(1)+2.0
  1319. PXA(3)=PXA(2)
  1320. PXA(4)=PXA(1)
  1321. PYA(1)=0.6
  1322. PYA(2)=PYA(1)
  1323. PYA(3)=PYA(1)+0.4
  1324. PYA(4)=PYA(3)
  1325. C definition du pave
  1326. CALL PFA(4,PXA,PYA)
  1327. C textes en rouge sous les paves du menu
  1328. CALL PSTXCI(2)
  1329. C definition de la police de caracteres et de la precision
  1330. CALL PSTXFN(-1)
  1331. CALL PSTXPR(2)
  1332. CALL PSCHSP(0.15)
  1333. C definition de la hauteur du text annote
  1334. CALL PSATCH(0.014)
  1335. C ecriture du text correspondant au pave
  1336. IF (KKIMP.EQ.1) THEN
  1337. CALL PATR(PXA(1),0.1,0.,0.,'Meta')
  1338. ELSE
  1339. IDEBTX=1
  1340. DO 466 IIT=1,MLONG
  1341. IF (LEGEND(KBOIT)(IIT:IIT).NE.' ') GOTO 467
  1342. 466 CONTINUE
  1343. 467 CONTINUE
  1344. CALL PATR(PXA(1),0.1,0.,0.,LEGEND(KBOIT)(IIT:MLONG))
  1345. ENDIF
  1346. CALL PCLST
  1347. XB=XB+80./(NCASE1+1)
  1348. 447 CONTINUE
  1349. 465 CONTINUE
  1350. IF (PGTYPE.EQ.POPNST) CALL POPST(INUM)
  1351. PGSVWI=2
  1352. C si une structure est ouverte elle est associee a la vue 2
  1353. CALL PQOPST(IIERR,PGTYPE,INUM)
  1354. IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
  1355. RETURN
  1356. C***********************************************************************
  1357. C
  1358. C subroutine INSEGT
  1359. C
  1360. ENTRY PINSEG(NBSEGT,IRESS)
  1361. C ce ssp entre en jeu dans l'ecriture des neouds,elements et objets
  1362. C -----------------------------------------------------------------
  1363. C
  1364. C debut du bloc phigs de INSEGT
  1365. C
  1366. 560 CONTINUE
  1367. IF (IPPP.EQ.1) THEN
  1368. CALL PQOPST(IERR,ISTYPE,ID)
  1369. C CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
  1370. ENDIF
  1371. C si un zoom n'a pas ete fait
  1372. IF (PGFLZO.EQ.0) THEN
  1373. IF (IRESS.NE.2) THEN
  1374. IF (IRESS.LT.2.OR.IRESS.GT.5) THEN
  1375. CALL PCLST
  1376. ENDIF
  1377. ELSE
  1378. IRESS=7
  1379. ENDIF
  1380. C si une structure est ouverte elle est fermee
  1381. CALL PQOPST(IIERR,PGTYPE,IOP)
  1382. IF (PGTYPE.EQ.POPNST) CALL PCLST
  1383. ISEG=NBSEGT+(100*(WKID-1))
  1384. CALL POPST(1)
  1385. CALL PEXST(ISEG)
  1386. CALL PCLST
  1387. CALL POPST(ISEG)
  1388. CALL PEMST(ISEG)
  1389. CALL PADS(1,ISEG)
  1390. CALL PSVWI(PGSVWI)
  1391. CALL PSVIS(PGIVNB,PGIVIN,ISEG,0)
  1392. CALL PSVIS(PGHPNB,PGHPIN,ISEG,0)
  1393. CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
  1394. CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
  1395. C definition du style du text annote
  1396. CALL PSANS(2)
  1397. C definition de la hauteur du text annote
  1398. C* CALL PSATCH(0.014)
  1399. CALL PSATCH(0.017)
  1400. ENDIF
  1401. IF (IPPP.EQ.1) THEN
  1402. CALL PQOPST(IERR,ISTYPE,ID)
  1403. C CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
  1404. ENDIF
  1405. RETURN
  1406. C***********************************************************************
  1407.  
  1408. C
  1409. C subroutine POLRL
  1410. C
  1411. ENTRY PPOLRL(NTRSTU,XTR,YTR,ZTR)
  1412. NTR=NTRSTU
  1413. IF (NTR.LE.1) RETURN
  1414. C PPOLRL 9
  1415. C debut du bloc phigs de POLRL
  1416. C
  1417. 660 CONTINUE
  1418. IF (NTR.LE.1) RETURN
  1419. PGSVWI=2
  1420. C la sructure ouverte est associee a la vue 2
  1421. CALL PQOPST(IIERR,PGTYPE,INUM)
  1422. IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
  1423.  
  1424. C definition d'une polyline
  1425. CALL PPL(NTR,XTR(1),YTR(1))
  1426. RETURN
  1427. C***********************************************************************
  1428.  
  1429. C
  1430. C subroutine TRDIG
  1431. C
  1432. ENTRY PTRDIG(X,Y,INCLE)
  1433. INCLE=0
  1434. C debut du bloc phigs de TRDIG
  1435. C
  1436. 860 CONTINUE
  1437. C**** CALL PQDSP(phigswsttool,IERR,DC,NRX,NRY,LX,LY)
  1438. CALL PQDSP(tool1,IERR,DC,PNRX,PNRY,LX,LY)
  1439. NWRATIO=PNRY/PNRX
  1440. IF(NWRATIO.GT.1)THEN
  1441. NWRATIO=1./NWRATIO
  1442. ENDIF
  1443. C updater la structure --- PV
  1444. CALL PUWK(WKID,1)
  1445. C..... locator en mode request
  1446. CALL PSLCM(WKID,1,0,1)
  1447. CALL PRQLC(WKID,1,ISTAT,ITNR,X,Y)
  1448. C..... calcul des coordonnees
  1449. C y=y*nwratio
  1450. y=y*wratio
  1451. C Effacer le message --- PV
  1452. CALL PEMST(2)
  1453. C.....
  1454. IF((X.LT.X1).OR.(X.GT.X2))INCLE=3
  1455. IF((Y.LT.Y1).OR.(Y.GT.Y2))INCLE=3
  1456.  
  1457. C..... reinitialisation des variables de sorties
  1458. XINID=X
  1459. YINID=Y
  1460. RETURN
  1461. C***********************************************************************
  1462. C
  1463. C subroutine TRFACE
  1464. C
  1465. ENTRY PTRFAC(NP,XTR,YTR,ZN,ICOLE,IEFF)
  1466. IEFF=0
  1467. KP=INT(ZN*4./1.58)+1
  1468. C
  1469. C debut du bloc phigs de TRFACE
  1470. C
  1471. 960 CONTINUE
  1472. IEFF=0
  1473. PGSVWI=2
  1474. C la structure ouverte est associe a la vue 2
  1475. CALL PQOPST(IIERR,PGTYPE,INUM)
  1476. IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
  1477. IEFF=1
  1478. IF (KP.NE.4) THEN
  1479. ENDIF
  1480. C definition de la couleur et du style de la facette
  1481. CALL PSICI(ICOLE)
  1482. CALL PSIS(1)
  1483. C definition de la facette
  1484. CALL PFA(NP,XTR,YTR)
  1485. RETURN
  1486. C***********************************************************************
  1487. C
  1488. C subroutine TRAISO
  1489. C
  1490. ENTRY PTRAIS(NP,XTR,YTR,ICOLE)
  1491. C
  1492. C PTRAISO 12
  1493. C debut du bloc phigs de TRAISO
  1494. C
  1495. 1060 CONTINUE
  1496. C pour pallier un petit bug dans le trace de la mire d'isovaleurs
  1497. ICOISI=ICOLE
  1498. C definition de la couleur de la facette
  1499. CALL PSICI(ICOISI)
  1500. CALL PQOPST(IERR,PGTYPE,INUM)
  1501. IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
  1502.  
  1503. CALL PSIS(1)
  1504. CALL PFA(NP,XTR,YTR)
  1505. RETURN
  1506. C***********************************************************************
  1507.  
  1508. C
  1509. C subroutine TREFF
  1510. C
  1511. ENTRY PTREFF
  1512. 1160 CONTINUE
  1513. RETURN
  1514. C***********************************************************************
  1515. C
  1516. C subroutine TRAFF
  1517. C
  1518. ENTRY PTRAFF(ICLE)
  1519. ICLE=0
  1520. C
  1521. C PTRAFF 17
  1522. C debut du bloc phigs de TRAFF
  1523. C
  1524. 1560 CONTINUE
  1525. ICLE=0
  1526. CALL PQOPST(IIERRI,PGTYPE,INUM)
  1527. C
  1528. ISGNEW=9+(100*(WKID-1))
  1529. IF(PGTYPE.EQ.POPNST) CALL PCLST
  1530. CALL POPST(ISGNEW)
  1531. ISEG=0
  1532. CALL PSPKM(WKID,1,0,1)
  1533. CALL PUWK(WKID,1)
  1534. C CALL PRST(WKID,1)
  1535. 1561 CONTINUE
  1536. C
  1537. CALL PRQPK(WKID,1,2,ISTAT,PGDEPT ,PGPATH)
  1538. ICHNR=PGPATH(1,2)
  1539. PCID=PGPATH(2,2)
  1540. ISEG=ICHNR-(100*(WKID-1))
  1541. IF (ISTAT.NE.1.OR.ICHNR.EQ.0) THEN
  1542. CALL PSDUS(WKID,3,0)
  1543. CALL PSDUS(WKID,4,0)
  1544. GOTO 1561
  1545. ENDIF
  1546. C effacer message dialogue
  1547. CALL PEMST(2)
  1548. IF(ISEG.GE.50) THEN
  1549. CALL PSSTM(WKID,1,0,1)
  1550. CALL PRQST(WKID,1,ISTAT,IL,STRING)
  1551. CALL PEMST(ICHNR)
  1552. CALL POPST(1)
  1553. CALL PEXST(ICHNR)
  1554. CALL PCLST
  1555. CALL POPST(ICHNR)
  1556. C CALL PPOST(WKID,ICHNR,1.)
  1557. CALL PADS(1,ICHNR)
  1558. CALL PSVWI(PGSVWI)
  1559. CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
  1560. CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
  1561. XX=TEXTX(ISEG-50+1)
  1562. YY=TEXTY(ISEG-50+1)
  1563. CALL PATR(XX,YY,0.,0.,STRING)
  1564. CALL PCLST
  1565. CALL PSVIS(PGHPNB,PGHPIN,ICHNR,1)
  1566. CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
  1567. TEXTE(ISEG-50+1)(1:15)=STRING(1:15)
  1568. ENDIF
  1569. ICLE=ISEG
  1570. ICLE=ICLE-10
  1571. write (6,*) ' icle ',icle
  1572. if (icle.ne.0.and.ipf(icle).eq.0) goto 1560
  1573. C
  1574. CALL PSDUS(WKID,4,0)
  1575. C
  1576. CALL PSVWI(PGSVWI)
  1577. CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
  1578. CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
  1579. C
  1580. RMAT(1)=1.
  1581. RMAT(2)=0.
  1582. RMAT(3)=0.
  1583. RMAT(4)=1.
  1584. RMAT(5)=0.
  1585. RMAT(6)=0.
  1586. IF (INMP.EQ.1) THEN
  1587. CALL PQOPST(IERR,ISTYPE,ID)
  1588. C CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
  1589. ENDIF
  1590. C
  1591. RETURN
  1592. C***********************************************************************
  1593. C
  1594. C subroutine TRMFIN
  1595. C
  1596. ENTRY PTRMFI
  1597. C PTRNFN 19
  1598. C debut du bloc phigs de TRMFIN
  1599. C
  1600. 1860 CONTINUE
  1601. * IACT=0
  1602. IWISS=0
  1603. C essai
  1604. C devrait permettre a l'utilisateur de savoir qu'il a selectionne la tou
  1605. * CALL POPST(1)
  1606. * CALL PEXST(INUSEG)
  1607. * CALL PCLST
  1608. * CALL POPST(INUSEG)
  1609. * CALL PSTXPR(2)
  1610. * CALL PSTXFN(-1)
  1611. * CALL PSCHSP(0.1)
  1612. * CALL PSATCH(0.015)
  1613. * CALL PSTXCI(7)
  1614. * CALL PATR(3.,34.,0.,0.,'Fin de session de CASTEM2000')
  1615. * CALL PCLST
  1616. C CALL PPOST(WKID,INUSEG,1.)
  1617. C CALL PXPSV(WKID,4,INUSEG,1.)
  1618. * CALL PUWK(WKID,1)
  1619. * PGFLAG = 0
  1620. RETURN
  1621. C***********************************************************************
  1622.  
  1623. C
  1624. C subroutine ZOOM
  1625. C
  1626. * ENTRY PZOOM(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
  1627. ENTRY PZOOM(IZOOM,XMI,XMA,YMI,YMA)
  1628. C
  1629. C PZOOM 20
  1630. C debut du bloc phigs de ZOOM
  1631. C
  1632. 2060 CONTINUE
  1633. IF (IPPP.EQ.1) THEN
  1634. CALL PQOPST(IERR,ISTYPE,ID)
  1635. C CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
  1636. ENDIF
  1637. C................................
  1638. IRESU=1
  1639. ITNR=2
  1640. *1093 ISORT=1
  1641.  
  1642. C la flag du zoom est mis a 1
  1643. PGFLZO = 1
  1644. C CALL PSVWCS(WKID,2,1,1,1,0,0)
  1645. CALL PSVTIP(WKID,2,0,0)
  1646. PGSVWI=0
  1647. C la structure ouverte est associee a la vue 0
  1648. CALL PQOPST(IIERR,PGTYPE,INUM)
  1649. IF (PGTYPE.EQ.POPNST) CALL PSVWI(PGSVWI)
  1650. C.... locator en mode request
  1651. CALL PSLCM(WKID,1,0,1)
  1652. C demande du premier locator
  1653. CALL PRQLC(WKID,1,STAT,ITNR1,XRO,YRO)
  1654. C demande du deuxieme locator
  1655. CALL PRQLC(WKID,1,STAT,ITNR1,XCOL,YCOL)
  1656.  
  1657. C definition du carre inscrit dans la zone saisie
  1658. XMI=MIN(XRO,XCOL)
  1659. XMA=MAX(XRO,XCOL)
  1660. YMI=MIN(YRO,YCOL)
  1661. YMA=MAX(YRO,YCOL)
  1662. C..... pour eviter les messages d'erreur dus aux valeurs trop petites
  1663. A=XMA-XMI
  1664. B=YMA-YMI
  1665. IF (A.LE.0.001) THEN
  1666. XMI=XMI*0.85
  1667. XMA=XMA*1.25
  1668. ENDIF
  1669. IF (B.LE.0.001) THEN
  1670. YMI=YMI*0.85
  1671. YMA=YMA*1.25
  1672. ENDIF
  1673.  
  1674. XC=XMI+A/2
  1675. YC=YMI+B/2
  1676. C=(A/2+B/2)/2
  1677. IF ((A/B.LT.1).OR.(B/A.LT.1)) THEN
  1678. C pour les cas particuliers ou a<<b ou b<<a
  1679. IF(A/B.LE.10) THEN
  1680. XMI=XC-A/2
  1681. XMA=XC+A/2
  1682. ELSE
  1683. IF (B/A.LE.10) THEN
  1684. YMI=YC-B/2
  1685. YMA=YC+B/2
  1686. ENDIF
  1687. ENDIF
  1688. ELSE
  1689. C cas ou a et b sont du meme ordre de grandeur
  1690. C on prend un carre
  1691. XMA=MAX(XMA,YMA-YMI+XMI)
  1692. YMI=MIN(YMI,-XMA+XMI+YMA)
  1693. endif
  1694. C
  1695. X1=XMI
  1696. X2=XMA
  1697. Y1=YMI
  1698. Y2=YMA
  1699. C..... redefinition de la vue
  1700. C**** CALL PQDSP(phigswsttool,IERR,DC,PGRX,PGRY,LX,LY)
  1701. CALL PQDSP(tool1,IERR,DC,PGRX,PGRY,LX,LY)
  1702. PGRAP=MIN(PGRX/RX,PGRY/RY)
  1703. IF (PGRX .LE. PGRY) THEN
  1704. VXMIN = .5*(PGRX-PGRAP*RX)
  1705. VXMAX = .5*(PGRX+PGRAP*RX)
  1706. CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
  1707. ELSE
  1708. VXMIN = .5*(PGRX-PGRAP*RY)
  1709. VXMAX = .5*(PGRX+PGRAP*RY)
  1710. CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
  1711. ENDIF
  1712. C.... redefinition de la vue 2
  1713. VWWNLM(1) = XMI
  1714. VWWNLM(2) = XMA
  1715. VWWNLM(3) = YMI
  1716. VWWNLM(4) = YMA
  1717. PJVPLM(1) = 0.
  1718. PJVPLM(3) = (WRATIO)*0.1
  1719. VWORMT(1,1) = 1.
  1720. VWORMT(2,2) = 1.
  1721. VWORMT(3,3) = 1.
  1722. VWORMT(1,2) = 0.
  1723. VWORMT(1,3) = 0.
  1724. VWORMT(2,1) = 0.
  1725. VWORMT(2,3) = 0.
  1726. VWORMT(3,1) = 0.
  1727. VWORMT(3,2) = 0.
  1728. XYCLIPI = 1
  1729. IF (VALEUR) THEN
  1730. C CALL OSVMP(WKID,2,XMI,XMA,YMI,YMA,0.,0.8,(WRATIO)*0.1,
  1731. C & (WRATIO)*0.9)
  1732. PJVPLM(2) = 0.8
  1733.  
  1734. PJVPLM(4) = (WRATIO)*0.9
  1735.  
  1736. CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
  1737. CALL PSVWR(WKID,2,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
  1738. ELSE
  1739. C CALL OSVMP(WKID,2,XMI,XMA,YMI,YMA,0.,0.9,(WRATIO)*0.1,
  1740. C & (WRATIO))
  1741. PJVPLM(2) = 0.9
  1742.  
  1743. PJVPLM(4) = WRATIO
  1744.  
  1745. CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
  1746. CALL PSVWR(WKID,2,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
  1747. ENDIF
  1748.  
  1749. C.... mise a jour des variables de sorties
  1750. XMI = SXMIN
  1751. XMA = SXXAX
  1752. YMI = SYMIN
  1753. YMA = SYYAX
  1754. PAS = 1
  1755. C cf gks ou gddm
  1756. C IF (IDEFOR.NE.0) THEN
  1757. C ISORT=0
  1758. C END
  1759. C
  1760. *1093 IF (IQUALI.EQ.10) IQUALI=0
  1761. *1093 IF (INUMNO.EQ.10) INUMNO=0
  1762. *1093 IF (INUMEL.EQ.10) INUMEL=0
  1763. C cf gks ou gddm
  1764. *1093 ISORT=1
  1765. IRESU=2
  1766. C
  1767. IF (IPPP.EQ.1) THEN
  1768. CALL PQOPST(IERR,ISTYPE,ID)
  1769. C CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
  1770. ENDIF
  1771.  
  1772. RETURN
  1773. C***********************************************************************
  1774.  
  1775. C
  1776. C subroutine CHANG
  1777. C
  1778. ENTRY PCHANG(IRESU,ISORT,ICHANG,JSEG)
  1779. C PCHANG 21
  1780. C debut du bloc phigs de CHANG
  1781. C
  1782. 2260 CONTINUE
  1783. ISEG=JSEG+(100*(WKID-1))
  1784. IF (ICHANG.EQ.1) THEN
  1785. ICHANG=10
  1786. C la structure ISEG est rundue invisible
  1787. CALL PSVIS(PGIVNB,PGIVIN,ISEG,1)
  1788. CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
  1789. ISORT=0
  1790. RETURN
  1791. ELSEIF (ICHANG.EQ.10) THEN
  1792. ICHANG=1
  1793. C ls structure ISEG est rendue visible
  1794. CALL PSVIS(PGIVNB,PGIVIN,ISEG,0)
  1795. CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
  1796. ISORT=0
  1797. RETURN
  1798. ENDIF
  1799. CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
  1800. ISORT=1
  1801. IRESU=JSEG
  1802. ICHANG=1
  1803. RETURN
  1804. C***********************************************************************
  1805.  
  1806. C
  1807. C subroutine INI
  1808. C
  1809. ENTRY PINI(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
  1810. C PINI 22
  1811. C debut du bloc phigs de INI
  1812. C
  1813. 2460 CONTINUE
  1814. PGSVWI=2
  1815. IF (IPPP.EQ.1) THEN
  1816. CALL PQOPST(IERR,ISTYPE,ID)
  1817. C CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
  1818. ENDIF
  1819. ISEG=1+(100*(WKID-1))
  1820. C les valeurs initiales de la vue 2 sont restaurees
  1821. X1=PGX1
  1822. X2=PGX2
  1823. Y1=PGY1
  1824. Y2=PGY2
  1825. PGCEH = 1
  1826. C**** CALL PQDSP(phigswsttool,IERR,DC,PGRX,PGRY,LX,LY)
  1827. CALL PQDSP(tool1,IERR,DC,PGRX,PGRY,LX,LY)
  1828. PGRAP=MIN (PGRX/RX,PGRY/RY)
  1829. IF (PGRX .LE. PGRY) THEN
  1830. VXMIN = .5*(PGRX-PGRAP*RX)
  1831. VXMAX = .5*(PGRX+PGRAP*RX)
  1832. CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
  1833. ELSE
  1834. VXMIN = .5*(PGRX-PGRAP*RY)
  1835. VXMAX = .5*(PGRX+PGRAP*RY)
  1836. CALL PSWKV(WKID,VXMIN,VXMAX,VXMIN,VXMAX)
  1837. ENDIF
  1838. VWWNLM(1) = X1
  1839. VWWNLM(2) = X2
  1840. VWWNLM(3) = Y1
  1841. VWWNLM(4) = Y2
  1842. VWORMT(1,1) = 1.
  1843. VWORMT(2,2) = 1.
  1844. VWORMT(3,3) = 1.
  1845. VWORMT(1,2) = 0.
  1846. VWORMT(1,3) = 0.
  1847. VWORMT(2,1) = 0.
  1848. VWORMT(2,3) = 0.
  1849. VWORMT(3,1) = 0.
  1850. VWORMT(3,2) = 0.
  1851. XYCLIPI = 1
  1852. PJVPLM(1) = 0.
  1853. PJVPLM(3) = (WRATIO)*0.1
  1854. IF (VALEUR) THEN
  1855. C redefinition de la vue 2
  1856. C CALL OSVMP(WKID,2,X1,X2,Y1,Y2,0.,0.8,
  1857. C & (WRATIO)*0.1,(WRATIO)*0.9)
  1858. PJVPLM(2) = 0.8
  1859.  
  1860. PJVPLM(4) = (WRATIO)*0.9
  1861.  
  1862. CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
  1863. CALL PSVWR(WKID,2,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
  1864. ELSE
  1865. C redefinition de la vue 2
  1866. C CALL OSVMP(WKID,2,X1,X2,Y1,Y2,0.,0.9,
  1867. C & (WRATIO)*0.1,(WRATIO))
  1868. PJVPLM(2) = 0.9
  1869.  
  1870. PJVPLM(4) = WRATIO
  1871.  
  1872. CALL PEVMM(VWWNLM,PJVPLM,IERR,VWMPMT)
  1873. CALL PSVWR(WKID,2,VWORMT,VWMPMT,PJVPLM,XYCLIPI)
  1874. ENDIF
  1875. C CALL PUWK(WKID,1)
  1876. IF (IDEFOR.NE.0) THEN
  1877. ISORT=0
  1878. RETURN
  1879. ENDIF
  1880. C les valeurs de la vue sont restituees
  1881. XMI = SXMIN
  1882. XMA = SXXAX
  1883. YMI = SYMIN
  1884. YMA = SYYAX
  1885. PAS = 1
  1886. IDEL1=0
  1887. IDEL2=0
  1888. IDEL3=0
  1889. IF (IQUALI.NE.0) IDEL1=3+(100*(WKID-1))
  1890. IF (INUMNO.NE.0) IDEL2=4+(100*(WKID-1))
  1891. IF (INUMEL.NE.0) IDEL3=5+(100*(WKID-1))
  1892. C les structures contenant les noeuds ,les elements et les quals
  1893. C sont videes
  1894. IF (IDEL1.NE.0) CALL PEMST(IDEL1)
  1895. IF (IDEL2.NE.0) CALL PEMST(IDEL2)
  1896. IF (IDEL3.NE.0) CALL PEMST(IDEL3)
  1897. IF (IQUALI.EQ.10) IQUALI=0
  1898. IF (INUMNO.EQ.10) INUMNO=0
  1899. IF (INUMEL.EQ.10) INUMEL=0
  1900. XMI=SXMIN
  1901. XMA=SXXAX
  1902. YMI=SYMIN
  1903. YMA=SYYAX
  1904. ISORT=1
  1905. IRESU=2
  1906. C
  1907. IF (IPPP.EQ.1) THEN
  1908. CALL PQOPST(IERR,ISTYPE,ID)
  1909. C CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
  1910. ENDIF
  1911.  
  1912. RETURN
  1913. C***********************************************************************
  1914.  
  1915. C
  1916. C subroutine FLGI
  1917. C
  1918. ENTRY PFLGJ
  1919. C
  1920. C PFLGI 23
  1921. C debut du bloc phigs de FLGI
  1922. C
  1923. 2860 CONTINUE
  1924. IANIM=0
  1925. IF(IANIM.EQ.0) RETURN
  1926. NGG=100.
  1927. C DO 2861 IFOO=1,20
  1928. DO2861IFOO=1,20
  1929. C DO 2862 ICOL=1,7
  1930. DO2862ICOL=1,7
  1931. DO2863JCOL=1,7
  1932. JXCOL=JCOL
  1933. CALL PSCR(WKID,JXCOL,3,0.0,0.0,0.0)
  1934. 2863 CONTINUE
  1935. IXCOL=ICOL
  1936. CALL PSCR(WKID,IXCOL,3,1.0,1.0,1.0)
  1937. IKKK=0
  1938. DO2864IKKL=1,100000
  1939. C DO2864IKKL=1,30000
  1940. IKKK=IKKK+1
  1941. 2864 CONTINUE
  1942. 2862 CONTINUE
  1943. C DO 2865 ICOL=6,2,-1
  1944. DO2865ICOL=7,1,-1
  1945. DO2866JCOL=1,7
  1946. JXCOL=JCOL
  1947. CALL PSCR(WKID,JXCOL,3,0.0,0.0,0.0)
  1948. 2866 CONTINUE
  1949. IXCOL=ICOL
  1950. CALL PSCR(WKID,IXCOL,3,1.0,1.0,1.0)
  1951. C DO 2867 IKKL=1,30000
  1952. DO2867IKKL=1,1250000
  1953. IKKK=IKKK+1
  1954. 2867 CONTINUE
  1955. 2865 CONTINUE
  1956. 2861 CONTINUE
  1957. C restitution exacte de la table de couleur
  1958. CALL PSCR(WKID,0,3,0.0,0.0,0.0)
  1959. CALL PSCR(WKID,4,3,0.0,0.0,1.0)
  1960. CALL PSCR(WKID,2,3,1.0,0.0,0.0)
  1961. CALL PSCR(WKID,6,3,1.0,0.0,1.0)
  1962. CALL PSCR(WKID,3,3,0.0,1.0,0.0)
  1963. CALL PSCR(WKID,5,3,0.0,1.0,1.0)
  1964. CALL PSCR(WKID,7,3,1.0,1.0,0.0)
  1965. CALL PSCR(WKID,1,3,1.0,1.0,1.0)
  1966. ICCOUN=ICCOUN+1
  1967. IF (ICCOUN.LE.9) WRITE(NAME,FMT='(''GIBI'',I1)') ICCOUN
  1968. IF (ICCOUN.GE.10) WRITE(NAME,FMT='(''GIBI'',I2)') ICCOUN
  1969. IF (ICCOUN.GE.100) WRITE(NAME,FMT='(''GIBI'',I3)') ICCOUN
  1970. RETURN
  1971. C***********************************************************************
  1972.  
  1973. C
  1974. C subroutine IMPR
  1975. C
  1976. ENTRY PFLGI
  1977. ENTRY PIMPR
  1978. C
  1979. C PIMPR 24
  1980. C debut du bloc phigs de IMPR
  1981. C
  1982. 3260 CONTINUE
  1983. KMETA=KMETA+1
  1984. IF (KMETA.GT.99) THEN
  1985. CALL PATR(25.,6.,0.,0.,'COMPTEUR DE MATAFILE SUPERIEUR A 99')
  1986. CALL PATR(25.,4.,0.,0.,'SAUVEGARDE IMPOSSIBLE')
  1987. RETURN
  1988. ENDIF
  1989. I10=KMETA/10
  1990. IREST=KMETA-10*I10
  1991. I10=10+1
  1992. IREST=IREST+1
  1993. STR=STR1//CARELE(I10)//CARELE(IREST)
  1994. KCON=1
  1995. METAID=1
  1996. C ouverture du fichier d'archive
  1997. CALL POPARF(METAID,STR)
  1998. C CALL PSWKW(METAID,0.,1.,0.,1.)
  1999. CALL PQOPST(IIERR,PGTYPE,INUM)
  2000. IF (PGTYPE.EQ.POPNST) CALL PCLST
  2001. C creation de la liste des structures a archiver
  2002. LIST(1)=0
  2003. ISEG=6+(100*(WKID-1))
  2004. LIST(2)=ISEG
  2005. ISEG=1+(100*(WKID-1))
  2006. LIST(3)=ISEG
  2007. IF (VALEUR) THEN
  2008. ISEG=7+(100*(WKID-1))
  2009. LIST(4)=ISEG
  2010. I=4
  2011. ELSE
  2012. ISEG=3+(100*(WKID-1))
  2013. IF (IQUALI.EQ.1) LIST(4)=ISEG
  2014. ISEG=4+(100*(WKID-1))
  2015. IF (INUMNO.EQ.1) LIST(5)=ISEG
  2016. ISEG=5+(100*(WKID-1))
  2017. IF (INUMEL.EQ.1) LIST(6)=ISEG
  2018. I=6
  2019. ENDIF
  2020. C archivage des structures contenues dans LIST
  2021. CALL PARST(METAID,I,LIST)
  2022. C fermeture du fichier d'archive
  2023. * CALL PCLRAF(METAID)
  2024. RETURN
  2025. C***********************************************************************
  2026.  
  2027. C
  2028. C subroutine VAL
  2029. C
  2030. ENTRY PVAL(IRESU,ISORT,NISO)
  2031. C
  2032. C PVAL 25
  2033. C debut du bloc phigs de VAL
  2034. C
  2035. 3560 CONTINUE
  2036. IF (IPPP.EQ.1) THEN
  2037. CALL PQOPST(IERR,ISTYPE,ID)
  2038. C CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
  2039. ENDIF
  2040. IF (NISO.NE.0.AND.IDEFOR.EQ.0) THEN
  2041. IXSEG=0
  2042. IRESU=10
  2043. ISORT=1
  2044. ENDIF
  2045. RETURN
  2046. C***********************************************************************
  2047.  
  2048. C
  2049. C subroutine MAJSEG
  2050. C
  2051. ENTRY PMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL)
  2052. C
  2053. C debut du bloc phigs de MAJSEG
  2054. C
  2055. 4060 CONTINUE
  2056. C fermeture de la structure courante et update de la Work station
  2057. IF (IMAJ.EQ.1) THEN
  2058. IF (IRESU.NE.2.OR.IQUALI.NE.0.OR.INUMNO.NE.0.OR.INUMEL.NE.0)
  2059. & CALL PCLST
  2060. ELSE
  2061. IF (IQUALI.EQ.10) IQUALI=0
  2062. IF (INUMNO.EQ.10) INUMNO=0
  2063. IF (INUMEL.EQ.10) INUMEL=0
  2064. IF (IRESU.LT.2.OR.IRESU.GT.5) THEN
  2065. ENDIF
  2066. C* IF (WKID.EQ.IWKIDLI) THEN
  2067. C* CALL PCLWK(WKID)
  2068. C* ELSE
  2069. C* WKID=WKID+1
  2070. C* ENDIF
  2071.  
  2072. ENDIF
  2073. C definition concernant le texte
  2074. IF (IRESU.EQ.10.AND.IFF.EQ.0) THEN
  2075. IFF=1
  2076. ENDIF
  2077.  
  2078. C effacement des structures associees a du textes
  2079. C IF (IRESU.NE.10.AND.IFF.EQ.1) THEN
  2080. IF (IRESU.NE.10) THEN
  2081. IFF=0
  2082. IFV=0
  2083. C effacement de toutes les structures associees a du texte
  2084. 1619 IF(INUSEG.GT.(50+100*(WKID-1))) THEN
  2085. C INUSEG=INUSEG-1
  2086. CALL PEMST(INUSEG)
  2087. CALL PDST(INUSEG)
  2088. INUSEG=INUSEG-1
  2089. GOTO 1619
  2090. ENDIF
  2091. ENDIF
  2092.  
  2093. C-------------------------------------
  2094. C* CALL PQOPST(IERR,ISTYPE,ID)
  2095. C* CALL PXQLVS(WKID,ID,0,10,IERR,IVIER,ITVWS)
  2096.  
  2097. RETURN
  2098. C***********************************************************************
  2099. C
  2100. C entry TRMESS
  2101. C
  2102. C ---------------------------------
  2103. C Affichage d'un message informatif
  2104. C ---------------------------------
  2105. ENTRY PTRMES(TITRE)
  2106. NCART=LONG(TITRE)
  2107. CALL PQOPST(IIERR,PGTYPE,INUM)
  2108. IF (PGTYPE.EQ.POPNST) CALL PCLST
  2109. C effacer le titre puisqu'on ecrit au meme endroit PV
  2110. ISEG=6+(100*(WKID-1))
  2111. CALL PEMST(ISEG)
  2112. CALL POPST(3)
  2113. CALL PEMST(3)
  2114. CALL PSVWI(1)
  2115. CALL PSTXPR(2)
  2116. CALL PSTXFN(-5)
  2117. CALL PSCHSP(0.1)
  2118. CALL PSATCH(0.015)
  2119. CALL PSTXCI(6)
  2120. CALL PATR(.6,1.3,0.,0.,TITRE(1:NCART))
  2121. CALL PCLST
  2122. IF (PGTYPE.EQ.POPNST) CALL POPST(INUM)
  2123. RETURN
  2124. C***********************************************************************
  2125. C
  2126. C subroutine TRGET
  2127. C
  2128. C -----------------------------------------
  2129. C Sous-programme uniquement appele par MODI
  2130. C -----------------------------------------
  2131. ENTRY PTRGET(LLIG,LCOL,CARACT)
  2132. NCART=LEN(CARACT)
  2133. C PTRGET 18
  2134. C debut du bloc phigs de TRGET
  2135. C
  2136. 1760 CONTINUE
  2137. CALL PQOPST(IIERRI,PGTYPE,INUM)
  2138. ISGNEW=9+(100*(WKID-1))
  2139. IF(PGTYPE.EQ.POPNST) CALL PCLST
  2140. CALL POPST(ISGNEW)
  2141. ILLIG=33.-LLIG
  2142. C DO 1761 IND=1,INCOOR
  2143. DO1761IND=1,INCOOR
  2144. IF((TEXTX(IND).EQ.LCOL).AND.(TEXTY(IND).EQ.ILLIG)) THEN
  2145. CARACT(1:15)=TEXTE(IND)(1:15)
  2146. ENDIF
  2147. 1761 CONTINUE
  2148. CALL PSVWI(PGSVWI)
  2149. CALL PSIVFT(WKID,PGIVNB,PGIVIN,0,PGIVEX)
  2150. CALL PSPKFT(WKID,1,PGHPNB,PGHPIN,0,PGHPEX)
  2151. RMAT(1)=1.
  2152. RMAT(2)=0.
  2153. RMAT(3)=0.
  2154. RMAT(4)=1.
  2155. RMAT(5)=0.
  2156. RMAT(6)=0.
  2157. CALL PCELST(ISGNEW)
  2158. CALL PEMST(ISGNEW)
  2159. RETURN
  2160. C ------------
  2161. C fin de TRGET
  2162. C ------------
  2163. END
  2164. C***********************************************************************
  2165. C
  2166. C subroutine PSVIS
  2167. C
  2168. SUBROUTINE PSVIS(PGIVNB,PGIVIN,ISUBSEG,FLAG)
  2169. C subroutine permettant de gerer la liste des structures visibles
  2170. C la liste des structures detectables
  2171. IMPLICIT INTEGER(I-N)
  2172. INTEGER PGIVNB,ISUBSEG,FLAG
  2173. INTEGER PGIVIN(4096)
  2174. C si la liste n'est pas vide
  2175. IF (PGIVNB.NE.0) THEN
  2176. C DO 5000 I=1,PGIVNB
  2177. DO5000I=1,PGIVNB
  2178. C si le numero de structure existe dans la liste et qu'il doit etr
  2179. C ajoute on ne fait rien
  2180. IF (PGIVIN(I).EQ.ISUBSEG.AND.FLAG.EQ.1) GOTO 5010
  2181. C si il existe dans la liste et doit etre supprime
  2182. IF (PGIVIN(I).EQ.ISUBSEG) GOTO 5020
  2183. 5000 CONTINUE
  2184. C dans le cas ou le numro de structure n'existe pas dans la liste
  2185. IF (FLAG.EQ.1) THEN
  2186. PGIVNB=PGIVNB+1
  2187. PGIVIN(PGIVNB)=ISUBSEG
  2188. ENDIF
  2189. GOTO 5010
  2190. 5020 PGIVNB=PGIVNB-1
  2191. C le dernier element de la liste a ete supprime
  2192. IF (I.EQ.PGIVNB+1) GOTO 5010
  2193. C DO 5030 J=I,PGIVNB
  2194. C un element dans la liste a ete supprime ,celle ci est restructur
  2195. DO5030J=I,PGIVNB
  2196. PGIVIN(J)=PGIVIN(J+1)
  2197. 5030 CONTINUE
  2198. GOTO 5010
  2199. ELSE IF (FLAG.EQ.1) THEN
  2200. C si la structure doit etre dectectable ou invisible son numero es
  2201. C ajoute a la liste
  2202. PGIVNB=PGIVNB+1
  2203. PGIVIN(PGIVNB)=ISUBSEG
  2204. ENDIF
  2205. 5010 CONTINUE
  2206. RETURN
  2207. END
  2208.  
  2209.  
  2210.  
  2211.  
  2212.  

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