Télécharger gtrini.eso

Retour à la liste

Numérotation des lignes :

  1. C GTRINI SOURCE BP208322 16/11/18 21:17:29 9177
  2. SUBROUTINE GTRINI(NOL,AXAX,AYAY,TITRE,HAUTT,VALEU,NCOUMA)
  3. C
  4. C DRIVER GRAPHIQUE GDDM (IBM)
  5. C
  6. C INITIALISATION D'UN TRACE
  7. C NOL : NON UTILISE
  8. C AX ,AYAX : DIMENSION POUR LA FEUILLE DE PAPIER
  9. C TITRE : TITRE (CHAINE DE CARACTERES)
  10. C HAUT : HAUTEUR DES CARACTERES
  11. C VALEUR : ECRAN OU ECRAN PLUS MARGE
  12. C NCOUMA : NOMBRE DE COULEUR DU TERMINAL
  13. C ICCOL : INDICE COULEUR COURANTE
  14. C ICOISO :
  15. C
  16. IMPLICIT INTEGER(I-N)
  17. external long
  18. SAVE ICCOL,KSEGN
  19. SAVE XINID,YINID,RX,RY,AX,AY
  20. SAVE VALEUR
  21. SAVE NHAUT,HAUT,NLIG
  22. SAVE IPF,ILIG2
  23. SAVE ICOISO,WIDTH,NLARG,NCOL,HEIGHT
  24. DIMENSION IPF(24)
  25. CHARACTER*(*) TITRE
  26. CHARACTER*21 CHACHA
  27. DIMENSION XTR(*),YTR(*)
  28. DIMENSION IPPAT(4),RMAT(9),LPROC(3)
  29. DIMENSION IARR1(1),IARR2(1),IARR3(1)
  30. DIMENSION KSEGT(20)
  31. CHARACTER*8 NAME
  32. CHARACTER*(*) CARACT
  33. LOGICAL IGDDEJ
  34. LOGICAL VALEUR,FENET,VALEU
  35. CHARACTER*(*) LEGEND(*)
  36. CHARACTER*(500) KEGEND
  37. -INC CCREEL
  38. *-INC CCOPTIO
  39. *-INC CCGEOME
  40. DATA IGDDEJ/.FALSE./
  41. DATA ICCOUN/0/
  42. C DATA POUR LE NOM DU FICHIER METAFILE
  43. C
  44. DATA IPPAT/65,66,67,68/
  45. DATA ICCOL/7/
  46. C NB DE COULEUR SI PAS AUTRE INDICATION
  47. NCOUMA=7
  48. C SAUVER HAUT
  49. HAUT=HAUTT
  50. NHAUT=31
  51. C SAUVER VALEUR
  52. VALEUR=VALEU
  53. C O SEGMENT POUR COMMENCER
  54. KSEGN=0
  55. C INITIALISATION DE L'UNITE PHYSIQUE
  56. AX=AXAX
  57. AY=AYAY
  58. DO 1 NBCR=72,2,-1
  59. IF (TITRE(NBCR:NBCR).NE.' ') GOTO 2
  60. 1 CONTINUE
  61. 2 CONTINUE
  62. 30 CONTINUE
  63. ILIG2=0
  64. IXSEG=0
  65. IF (IGDDEJ) THEN
  66. CALL FSRNIT
  67. ELSE
  68. CALL FSINN
  69. IGDDEJ=.TRUE.
  70. ENDIF
  71. * AUTORISER MODIFICATIONS LOCALES
  72. LPROC(1)=21
  73. LPROC(2)=1
  74. CALL DSOPEN(0,1,'* ',2,LPROC,0,'GIBI ')
  75. CALL DSUSE(1,0)
  76. * COMBIEN DE COULEURS UTILISABLES ??? (SANS LE FOND)
  77. CALL FSQURY(2,9,1,LPROC)
  78. NCOUMA=LPROC(1)-1
  79. * PATTERN POUR DEGRADES
  80. CALL GSLSS(3,'ADMNOBLA',0)
  81. C RECUPERATION TAILLE DE CARACTERE PAR DEFAUT
  82. C ADAPTATION A LA DIMENSION DE L'ECRAN
  83. CALL FSQURY(0,3,2,LPROC)
  84. NLIG=LPROC(1)
  85. NCOL=LPROC(2)
  86. NHAUT=NLIG-1
  87. NLARG=NCOL
  88. CALL FSPCRT(1,NLIG,NCOL,0)
  89. CALL GSFLD(2,1,NHAUT,NLARG)
  90. CALL GSQPS(WIDTH,HEIGHT)
  91. C ECRITURE DU TITRE
  92. CALL GSWIN(0.,80.,0.,2.)
  93. CALL GSSATI(4,2)
  94. CALL GSSEG(6)
  95. IF (KSEGN.LE.20) KSEGN=KSEGN+1
  96. KSEGT(KSEGN)=6
  97. CALL GSTAG(1)
  98. CALL GSCM(3)
  99. CALL GSCOL(7)
  100. CALL GSCHAR(69.,0.,10,'CASTEM2000')
  101. CALL GSQCB(CWID,CHEI)
  102. HA=HAUT*5.
  103. CALL GSCB(CWID*HA,CHEI*HA)
  104. CALL GSCHAR(0.,0.,NBCR,TITRE)
  105. CALL GSSCLS
  106. IF (VALEUR) THEN
  107. NLARG=NLARG-10
  108. ELSE
  109. NLARG=NLARG-5
  110. HEIGHT=(HEIGHT*(NHAUT-1))/REAL(NHAUT)
  111. ENDIF
  112. CALL GSVIEW(0.,WIDTH*NLARG/NCOL,HEIGHT/NHAUT,HEIGHT)
  113. C CLIPPING DISABLE POUR AVOIR CORRECTEMENT LES NUMEROS ET NOMS
  114. CALL GSCLP(0)
  115. RETURN
  116. *
  117. ENTRY GDFENE(XMIN,XXAX,YMIN,YYAX,XR1,XR2,YR1,YR2,FENET)
  118. C
  119. C DEFINITION DE LA FENETRE UTILISATEUR
  120. C XMIN,X,X,YMIN,YYAX : COORDONNEES DE LA FENETRE UTILISATEUR
  121. C XR1,XR2,YR1,YR2 : COORDONNEES RETOURNEES
  122. C (EFFECTIVEMENT UTILISEES)
  123. C FENET : CALCUL DU RATIO (OUI OU NON) NON UTILISE
  124. C
  125. EC1=AX-3.
  126. EC2=AY-3.
  127. C DEFINITION UNITE UTILISATEUR FENETRE UTILISEE MARGES A RESPECTER
  128. C OUVERTURE SEGMENT
  129. IF (FENET) THEN
  130. CALL GSUWIN(XMIN,XXAX,YMIN,YYAX)
  131. ELSE
  132. CALL GSWIN(XMIN,XXAX,YMIN,YYAX)
  133. ENDIF
  134. XINID=(XMIN+XXAX)/2.
  135. YINID=(YMIN+YYAX)/2.
  136. XR1=XMIN
  137. XR2=XXAX
  138. YR1=YMIN
  139. YR2=YYAX
  140. CALL GSSATI(4,2)
  141. CALL GSSEG(1)
  142. IXSEG=1
  143. IF (KSEGN.LE.20) KSEGN=KSEGN+1
  144. KSEGT(KSEGN)=1
  145. CALL GSTAG(1)
  146. CALL GSCM(3)
  147. CALL GSQCB(CWID,CHEI)
  148. CALL GSCB(CWID,CHEI)
  149. CALL GSCOL(ICCOL)
  150. CALL GSMIX(0)
  151. ICOISO=-100
  152. RETURN
  153. C
  154. ENTRY GTRLAB(X,Y,CARACT,NCAR,HAUTT)
  155. C
  156. C ECRITURE D'UN TEXTE EN (X,Y)
  157. C X,Y : COORDONNEES DE L'ORIGINE DU TEXTE
  158. C CARACT : TEXTE
  159. C NCAR : NOMBRE DE CARACTERES A ECRIRE
  160. C HAUT :
  161. C
  162. HAUT=HAUTT
  163. DO 201 ICAR=NCAR,1,-1
  164. IF (CARACT(ICAR:ICAR).NE.' ') GOTO 202
  165. 201 CONTINUE
  166. C CHAINE VIDE
  167. RETURN
  168. 202 CONTINUE
  169. CALL GSCHAR(X,Y,ICAR,CARACT)
  170. RETURN
  171. C
  172. ENTRY GTRBOX (HAUTX,HAUTY)
  173. CALL GSCM(3)
  174. CALL GSQCB(CWID,CHEI)
  175. CALL GSCB(CWID*HAUTX,CHEI*HAUTY)
  176. RETURN
  177. C
  178. ENTRY GCHCOU(JCOLO)
  179. C
  180. C CHANGEMENT COULEUR (8 DOIT CORRESPONDRE A L'EFFACEMENT)
  181. C JCOLO : INDICE DE LA NOUVELLE COULEUR
  182. C CHANGEMENT DE COULEUR (VOIR LA TABLE DES COULEUR)
  183. C
  184. CALL GSCOL(JCOLO)
  185. RETURN
  186. C
  187. ENTRY GFVALI(IFENI,IRESU,NH)
  188. C
  189. C ACTIVATION DE LA FENETRE DE TRAVAIL
  190. IF (IFENI.EQ.1) THEN
  191. CALL GSVIEW(WIDTH*NLARG/NCOL,WIDTH,HEIGHT/NHAUT,HEIGHT)
  192. CALL GSWIN(0.,1.,2.,REAL(NHAUT+2))
  193. IRESU=0
  194. ELSE
  195. C DESACTIVATION DE LA FENETRE
  196. CALL GSSCLS
  197. CALL GSVIEW(0.,WIDTH*NLARG/NCOL,HEIGHT/NHAUT,HEIGHT)
  198. CALL GSUWIN(XMIN,XXAX,YMIN,YYAX)
  199. ENDIF
  200. NH=NHAUT
  201. RETURN
  202. C
  203. ENTRY GMENU(LEGEND,NCASE,LLONG)
  204. C AFFICHAGE DU MENU
  205. C
  206. DO 805 II=1,24
  207. IPF(II)=0
  208. 805 CONTINUE
  209. * INIT CHAMP ALPHANUMERIQUE LISTE DES CLES
  210. * REINITIALISATION DES CHAMPS
  211. CALL ASDFLD(1,1,1,1,79,2)
  212. CALL ASFCOL(1,7)
  213. KLEN=LEN(LEGEND(1))
  214. KCASE=NCASE
  215. KLONG=LLONG
  216. * ON N'AFFICHE PAS 1 (= CONTINUER TOUJOURS PF0)
  217. IDEB1=0
  218. IDEB=1
  219. KEGEND=' '
  220. DO 800 II=2,KCASE
  221. MLONG=LONG(LEGEND(II))
  222. IF (MLONG.EQ.1) GOTO 800
  223. IPF(II-1)=1
  224. IF (II.LE.10) THEN
  225. KEGEND(IDEB:IDEB+3)='FP?:'
  226. WRITE (KEGEND(IDEB+2:IDEB+2),FMT='(I1)') II-1
  227. IDEB=IDEB+4
  228. ELSE
  229. KEGEND(IDEB:IDEB+4)='FP??:'
  230. WRITE (KEGEND(IDEB+2:IDEB+3),FMT='(I2)') II-1
  231. IDEB=IDEB+5
  232. ENDIF
  233. DO 801 III=1,MLONG
  234. IF (LEGEND(II)(III:III).NE.' ') GOTO 802
  235. 801 CONTINUE
  236. III=MLONG
  237. 802 CONTINUE
  238. KEGEND(IDEB:IDEB+MLONG-III+1)=LEGEND(II)(III:MLONG)
  239. IDEB=IDEB+MLONG-III+2
  240. IF (IDEB.GT.63.AND.IDEB1.EQ.0) IDEB1=IDEB
  241. 800 CONTINUE
  242. IF (IPF(11).EQ.0.AND.IPF(1).NE.0) THEN
  243. IPF(11)=1
  244. KEGEND(IDEB:IDEB+7)='FP11:LGI'
  245. IDEB=IDEB+8
  246. ENDIF
  247. IF (IDEB.LT.79.AND.IDEB1.NE.0) IDEB1=0
  248. IF (IDEB1.EQ.0.OR.IDEB.EQ.IDEB1) THEN
  249. CALL ASCPUT(1,IDEB-1,KEGEND(1:IDEB-1))
  250. IF (ILIG2.EQ.1) CALL ASDFLD(4,2,1,1,1,2)
  251. ILIG2=0
  252. ELSE
  253. CALL ASCPUT(1,IDEB1-1,KEGEND(1:IDEB1-1))
  254. ILIG2=1
  255. CALL ASDFLD(4,2,1,1,79,2)
  256. CALL ASFCOL(4,7)
  257. CALL ASCPUT(4,IDEB-IDEB1,KEGEND(IDEB1:IDEB-1))
  258. ENDIF
  259. RETURN
  260. C
  261. ENTRY GINSEG(NBSEGT,IRESS)
  262. C
  263. C INITIALISATION D'UN SEGMENT
  264. C NBSEGT : NUMERO DU SEGMENT
  265. C IRESS : SELON SA VALEUR, ON FERME LE SEGMENT PRECEDENT
  266. C
  267. IF (IRESS.NE.2) THEN
  268. IF (IRESS.LT.2.OR.IRESS.GT.5) CALL GSSCLS
  269. ELSE
  270. IRESS=7
  271. ENDIF
  272. CALL GSSATI(2,1)
  273. CALL GSSATI(4,2)
  274. CALL GSSEG(NBSEGT)
  275. IF (KSEGN.LE.20) KSEGN=KSEGN+1
  276. KSEGT(KSEGN)=NBSEGT
  277. CALL GSTAG(1)
  278. CALL GSCM(3)
  279. CALL GSQCB(CWID,CHEI)
  280. CALL GSCB(CWID,CHEI)
  281. RETURN
  282. C
  283. ENTRY GPOLRL(NTRSTU,XTR,YTR)
  284. C
  285. C TRACE D'UNE POLYLIGNE DANS LA VALEUR COURANTE
  286. C NTR : NOMBRE DE POINTS
  287. C XTR,YTR : COORDONNEES DES POINTS
  288. C
  289. NTR=NTRSTU
  290. IF (NTR.LE.1) RETURN
  291. CALL GSMOVE(XTR(1),YTR(1))
  292. CALL GSPLNE(NTR-1,XTR(2),YTR(2))
  293. RETURN
  294. C
  295. ENTRY GTRDIG(X,Y,INCLE)
  296. C
  297. C DIGITALISATION D'UN POINT
  298. C X,Y : COORDONNEES DU POINT DESIGNE
  299. C
  300. INCLE=0
  301. CALL GSENAB(2,1,0)
  302. CALL GSILOC(1,0,XINID,YINID)
  303. CALL GSENAB(2,1,1)
  304. CALL GSENAB(1,1,1)
  305. CALL GSENAB(1,0,1)
  306. CALL GSREAD(1,ITTVAL,ICOUNT)
  307. IF (ITTVAL.EQ.1) THEN
  308. CALL GSQCHO(INCLE)
  309. CALL GSREAD(1,ITTVAL,IPLOC)
  310. ENDIF
  311. IF (INCLE.GT.12) INCLE=INCLE-12
  312. CALL GSQLOC(INW,X,Y)
  313. CALL GSENAB(2,1,0)
  314. CALL GSENAB(1,1,0)
  315. CALL GSENAB(1,0,0)
  316. XINID=X
  317. YINID=Y
  318. RETURN
  319. C
  320. ENTRY GTRFAC(NP,XTR,YTR,ZN,ICOLE,IEFF)
  321. C
  322. C TRACE D'UNE FACE AVEC DEGRADE
  323. C NP : NOMBRE DE POINTS
  324. C XTR,YTR : COORDONNEES DES POINTS
  325. C ICOLE : COULEUR
  326. C KP : ECLAIRAGE
  327. C
  328. IEFF=0
  329. C KP=INT(ZN*4./1.58)+1
  330. C IF (IOMBRE.EQ.0) KP=4
  331. KP=4
  332. CALL GSMOVE(XTR(NP),YTR(NP))
  333. C ON APPLIQUE UNE PATTERN D'EFFACEMENT PUIS UNE DE REMPLISSAGE
  334. IEFF=0
  335. IF (KP.GE.3) IEFF=1
  336. C IF (KP.NE.4) THEN
  337. C CALL GSCOL(8)
  338. C CALL GSPAT(0)
  339. C CALL GSAREA(0)
  340. C CALL GSPLNE(NP-1,XTR,YTR)
  341. C CALL GSENDA
  342. C ENDIF
  343. * POUR AVOIR LA BONNE COULEUR SUR IMAGEN
  344. * IF (KP.NE.1) THEN
  345. CALL GSCOL(ICOLE)
  346. CALL GSPAT(IPPAT(KP))
  347. CALL GSAREA(0)
  348. CALL GSPLNE(NP-1,XTR,YTR)
  349. CALL GSENDA
  350. * ENDIF
  351. RETURN
  352. C
  353. ENTRY GTRAIS(NP,XTR,YTR,ICOLE)
  354. C
  355. C TRACE D'UNE FACE SANS CALCUL DE DEGRADE
  356. C NP : NOMBRE DE POINTS
  357. C XTR,YTR : COORDONNEES DES POINTS
  358. C ICOLE : COULEUR
  359. C
  360. IF (ICOLE.NE.ICOISO) THEN
  361. ICOISO=ICOLE
  362. CALL GSCOL(ICOISO)
  363. ENDIF
  364. CALL GSMOVE(XTR(NP),YTR(NP))
  365. CALL GSAREA(0)
  366. CALL GSPLNE(NP-1,XTR(1),YTR(1))
  367. CALL GSENDA
  368. RETURN
  369. C
  370. C EFFACEMENT ECRAN ON UTILISE GDDM OU CE QU'ON PEUT
  371. ENTRY GTREFF
  372. WRITE (CHACHA(1:4),FMT='(A4)') 17
  373. CHACHA(5:21)='VMFCLEAR '
  374. CALL CMS(CHACHA(3:21))
  375. RETURN
  376. C
  377. C AFFICHAGE RETOUR CLE TAPEE
  378. ENTRY GTRAFF(ICLE)
  379. C
  380. C AFFICHAGE RETOUR CLE TAPEE
  381. C ICLE : NUMERO DE CLE RENDUE
  382. C
  383. ICLE=0
  384. 1530 CONTINUE
  385. CALL ASREAD(ITTYP,ICLE,ICOUNT)
  386. IF (ITTYP.EQ.0) ICLE=0
  387. IF (ICLE.GT.12) ICLE=ICLE-12
  388. IF (ICLE.NE.0.AND.IPF(ICLE).EQ.0) GOTO 1530
  389. RETURN
  390. C
  391. * ROUTINE POUR SORTIR CORRECTEMENT DE GKS AVEC MODIFIER
  392. ENTRY GTRMFI
  393. RETURN
  394. C
  395. * ENTRY GZOOM(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
  396. ENTRY GZOOM(IZOOM,XMI,XMA,YMI,YMA)
  397. C
  398. C XMI,XMA,YMI,YMA POINTS RENDUS APRES LE ZOOM
  399. C
  400. IRESU=1
  401. C INITIALISATION DU ZOOM
  402. CALL GSQWIN(XL1,XL2,YL1,YL2)
  403. CALL GSENAB(2,1,0)
  404. CALL GSILOC(1,0,(XL1+XL2)/2,(YL1+YL2)/2)
  405. CALL GSENAB(2,1,1)
  406. CALL GSREAD(1,ITTVAL,ICOUNT)
  407. CALL GSQLOC(INW,XRO,XCOL)
  408. CALL GSQLID(2,1,3,LPROC)
  409. IF (LPROC(3).GE.5) THEN
  410. C ECHO TYPE BOITE
  411. CALL GSENAB(2,1,0)
  412. CALL GSIDVF(2,1,1,XRO)
  413. CALL GSIDVF(2,1,2,XCOL)
  414. CALL GSILOC(1,5,XRO+(XL2-XL1)/100,XCOL+(YL2-YL1)/100)
  415. CALL GSENAB(2,1,1)
  416. ENDIF
  417. CALL GSREAD(1,ITTVAL,ICOUNT)
  418. CALL GSQLOC(INW,YRO,YCOL)
  419. CALL GSENAB(2,1,0)
  420. C GESTION DU CADRE DEFINI PAR LES CURSEURS
  421. XMI=MIN(XRO,YRO)
  422. XMA=MAX(XRO,YRO)
  423. YMI=MIN(XCOL,YCOL)
  424. YMA=MAX(XCOL,YCOL)
  425. XMA=MAX(XMA,YMA-YMI+XMI)
  426. YMI=MIN(YMI,-XMA+XMI+YMA)
  427. * IF (XMI.EQ.XMA) XMA=XMA*1.01+1E-30
  428. IF (XMI.EQ.XMA) XMA=XMA*1.01+xpetit
  429. * IF (YMI.EQ.YMA) YMA=YMA*1.01+1E-30
  430. IF (YMI.EQ.YMA) YMA=YMA*1.01+xpetit
  431. XM1=XMI
  432. XM2=XMA
  433. YM1=YMI
  434. YM2=YMA
  435. PAS=MIN((XL2-XL1)/(XMA-XMI),(YL2-YL1)/(YMA-YMI))
  436. C INITIALISATION DE LA MATRICE DE TRANSFORMATION
  437. RMAT(1)=1
  438. RMAT(2)=0
  439. RMAT(3)=-XMI
  440. RMAT(4)=0
  441. RMAT(5)=1
  442. RMAT(6)=-YMI
  443. RMAT(7)=0
  444. RMAT(8)=0
  445. RMAT(9)=1
  446. CALL GSSTFM(1,9,RMAT,1)
  447. RMAT(1)=PAS
  448. RMAT(2)=0
  449. RMAT(3)=XL1
  450. RMAT(4)=0
  451. RMAT(5)=PAS
  452. RMAT(6)=YL1
  453. RMAT(7)=0
  454. RMAT(8)=0
  455. RMAT(9)=1
  456. CALL GSSTFM(1,9,RMAT,1)
  457. C IF (IDEFOR.NE.0) THEN
  458. C*1093 ISORT=0
  459. C RETURN
  460. C ENDIF
  461. IDEL1=0
  462. IDEL2=0
  463. IDEL3=0
  464. *1093 IF (IQUALI.NE.0) IDEL1=3
  465. *1093 IF (INUMNO.NE.0) IDEL2=4
  466. *1093 IF (INUMEL.NE.0) IDEL3=5
  467. IF (IDEL1.NE.0) CALL GSSDEL(IDEL1)
  468. IF (IDEL2.NE.0) CALL GSSDEL(IDEL2)
  469. IF (IDEL3.NE.0) CALL GSSDEL(IDEL3)
  470. KSEG0=KSEGN
  471. KSEGN=0
  472. DO 2020 KSEG=1,KSEG0
  473. IF (KSEGT(KSEG).EQ.IDEL1) GOTO 2020
  474. IF (KSEGT(KSEG).EQ.IDEL2) GOTO 2020
  475. IF (KSEGT(KSEG).EQ.IDEL3) GOTO 2020
  476. KSEGN=KSEGN+1
  477. KSEGT(KSEGN)=KSEGT(KSEG)
  478. 2020 CONTINUE
  479. *1093 IF (IQUALI.EQ.10) IQUALI=0
  480. *1093 IF (INUMNO.EQ.10) INUMNO=0
  481. *1093 IF (INUMEL.EQ.10) INUMEL=0
  482. *1093 ISORT=1
  483. IRESU=2
  484. CALL GSQAGA(1,SX,SY,HX,HY,RX,RY,DX,DY)
  485. C CALCUL DES COORDONNEES APRES LE ZOOM
  486. XMI=(XMIN-DX)/SX
  487. XMA=(XXAX-DX)/SX
  488. YMI=(YMIN-DY)/SY
  489. YMA=(YYAX-DY)/SY
  490. RETURN
  491. C
  492. ENTRY GCHANG(IRESU,ISORT,ICHANG,JSEG)
  493. C
  494. C VISUALISATION OU NON DU SEGMENT JSEG
  495. C POUR LES CLES QUAL, NOEUD OU ELEM
  496. C
  497. IF (ICHANG.EQ.1) THEN
  498. ICHANG=10
  499. CALL GSSATS(JSEG,2,0)
  500. ISORT=0
  501. RETURN
  502. ELSEIF (ICHANG.EQ.10) THEN
  503. ICHANG=1
  504. CALL GSSATS(JSEG,2,1)
  505. ISORT=0
  506. RETURN
  507. ENDIF
  508. ISORT=1
  509. IRESU=JSEG
  510. ICHANG=1
  511. RETURN
  512. C
  513. ENTRY GINI(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
  514. C
  515. C RETOUR AU DESSIN INITIAL - SUPPRESSION DES SEGMENTS
  516. C CONCERNANT QUAL, NOEUD ET ELEM
  517. C INITIALISATION DE LA MATRICE IDENTITE
  518. PAS=1
  519. RMAT(1)=1
  520. RMAT(2)=0
  521. RMAT(3)=0
  522. RMAT(4)=0
  523. RMAT(5)=1
  524. RMAT(6)=0
  525. RMAT(7)=0
  526. RMAT(8)=0
  527. RMAT(9)=1
  528. C APPLICATION DE LA MATRICE AU SEGMENT
  529. CALL GSSTFM(1,9,RMAT,0)
  530. C IF (IDEFOR.NE.0) THEN
  531. C ISORT=0
  532. C RETURN
  533. C ENDIF
  534. IDEL1=0
  535. IDEL2=0
  536. IDEL3=0
  537. IF (IQUALI.NE.0) IDEL1=3
  538. IF (INUMNO.NE.0) IDEL2=4
  539. IF (INUMEL.NE.0) IDEL3=5
  540. IF (IDEL1.NE.0) CALL GSSDEL(IDEL1)
  541. IF (IDEL2.NE.0) CALL GSSDEL(IDEL2)
  542. IF (IDEL3.NE.0) CALL GSSDEL(IDEL3)
  543. KSEG0=KSEGN
  544. KSEGN=0
  545. DO 2420 KSEG=1,KSEG0
  546. IF (KSEGT(KSEG).EQ.IDEL1) GOTO 2420
  547. IF (KSEGT(KSEG).EQ.IDEL2) GOTO 2420
  548. IF (KSEGT(KSEG).EQ.IDEL3) GOTO 2420
  549. KSEGN=KSEGN+1
  550. KSEGT(KSEGN)=KSEGT(KSEG)
  551. 2420 CONTINUE
  552. IF (IQUALI.EQ.10) IQUALI=0
  553. IF (INUMNO.EQ.10) INUMNO=0
  554. IF (INUMEL.EQ.10) INUMEL=0
  555. C RESTITUTION DES COORDONNEES
  556. XMI=XMIN
  557. XMA=XXAX
  558. YMI=YMIN
  559. YMA=YYAX
  560. ISORT=1
  561. IRESU=2
  562. RETURN
  563. C
  564. ENTRY GFLGI
  565. C
  566. C SORTIE GDF POUR CONVERSION EN EN LGI
  567. ICCOUN=ICCOUN+1
  568. IF (ICCOUN.LE.9) WRITE(NAME,FMT='(''GIBI'',I1)') ICCOUN
  569. IF (ICCOUN.GE.10) WRITE(NAME,FMT='(''GIBI'',I2)') ICCOUN
  570. IF (ICCOUN.GE.100) WRITE(NAME,FMT='(''GIBI'',I3)') ICCOUN
  571. C BOUCLE POUR RENDRE TRANSFORMABLES TOUS LES SEGMENTS SAUVES
  572. DO 2920 KSEG=1,KSEGN
  573. CALL GSSATS(KSEGT(KSEG),1,1)
  574. 2920 CONTINUE
  575. CALL GSSAVE(0,IARR1,NAME,0,IARR2,0,IARR3)
  576. DO 2930 KSEG=1,KSEGN
  577. CALL GSSATS(KSEGT(KSEG),1,0)
  578. 2930 CONTINUE
  579. RETURN
  580. C
  581. ENTRY GIMPR
  582. C
  583. C IMPRESSION POUR 3268
  584. C EN GKS : SAUVEGARDE DU DESSIN SUR METAFILE METAXX
  585. C AVEC XX = NUMERO DE 01 A 99
  586. CALL DSOPEN(1,2,'* ',0,LPROC,1,'GIBI ')
  587. CALL DSUSE(2,1)
  588. CALL GSCOPY(66,83)
  589. CALL FSCOPY
  590. CALL FSCLS(1)
  591. RETURN
  592. C
  593. ENTRY GVAL(IRESU,ISORT,NISO)
  594. C
  595. C IF (NISO.NE.0.AND.IDEFOR.EQ.0) THEN
  596. IF (NISO.NE.0) THEN
  597. IXSEG=0
  598. IRESU=10
  599. ISORT=1
  600. ENDIF
  601. RETURN
  602. C
  603. ENTRY GMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL)
  604. C
  605. IF (IMAJ.EQ.1) THEN
  606. IF (IRESU.NE.2.OR.IQUALI.NE.0.OR.INUMNO.NE.0.OR.INUMEL.NE.0)
  607. & CALL GSSCLS
  608. ELSE
  609. IF (IQUALI.EQ.10) IQUALI=0
  610. IF (INUMNO.EQ.10) INUMNO=0
  611. IF (INUMEL.EQ.10) INUMEL=0
  612. C
  613. IF (IRESU.LT.2.OR.(IRESU.GT.5.AND.IRESU.LT.10)) CALL GSCLR
  614. ENDIF
  615. RETURN
  616. C
  617. ENTRY GTRANI(IANIM,NDEF)
  618. * INITIALISATION POUR ANIMATION
  619. * IANIM 1 ALLER SIMPLE
  620. * IANIM 2 ALLER RETOUR
  621. * NDEF NOMBRE D'IMAGE
  622. RETURN
  623. C
  624. ENTRY GTRIMA(IDEF)
  625. * NOUVELLE IMAGE
  626. * IDEF NUMERO DE L'IMAGE
  627. C
  628. CALL FSFRCE
  629. RETURN
  630. C
  631. C MESSAGE EN BAS DE L'ECRAN
  632. ENTRY GTRMES(TITRE)
  633. CALL ASDFLD(2,NLIG,1,1,LEN(TITRE),2)
  634. CALL ASFCOL(2,7)
  635. CALL ASCPUT (2,LEN(TITRE),TITRE)
  636. RETURN
  637. C
  638. C INPUT AVEC PROMPT
  639. ENTRY GTRGET(TITRE,CARACT)
  640. CALL ASDFLD(2,NLIG,1,1,LEN(TITRE),2)
  641. CALL ASFCOL(2,7)
  642. CALL ASCPUT (2,LEN(TITRE),TITRE)
  643. CALL ASDFLD(3,NLIG,LEN(TITRE)+1,1,LEN(CARACT),0)
  644. CALL ASFCOL(3,7)
  645. KEGEND=' '
  646. CALL ASCPUT (3,LEN(CARACT),KEGEND)
  647. CALL ASFCUR(0,NLIG,LEN(TITRE)+1)
  648. CALL ASREAD(ITTYP,ICLE,ICOUNT)
  649. CALL ASCGET(3,LEN(CARACT),CARACT)
  650. CALL ASDFLD(2,NLIG,1,1,0,2)
  651. CALL ASDFLD(3,NLIG,79,1,0,2)
  652. RETURN
  653. END
  654.  
  655.  
  656.  
  657.  
  658.  
  659.  
  660.  
  661.  
  662.  
  663.  
  664.  
  665.  
  666.  
  667.  
  668.  

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