Download mtrini.eso
Back to the list
1 : C MTRINI SOURCE PV 08/05/13 21:15:00 6100
2 : C MTRINI SOURCE PV 92/02/27 21:03:45 486
3 : C
4 : C driver, derivato dalla strini.eso, per generazione di
5 : C un file mif da manipolare con FrameMaker per text-processing
6 : C 02.09.92 folco,loris
7 : C 15.09.93 pierre
8 : C 1995 degrade pour le trace face Pierre Pegon JRC-ISPRA
9 : C
10 : SUBROUTINE MTRINI(NOL,AXAX,AYAY,TITR,HAUTT,VALEU,NCOUMA)
11 : IMPLICIT INTEGER(I-N)
12 : -INC CCREEL
13 : -INC CCOPTIO
14 : external long
15 : DIMENSION XTR(*),YTR(*)
16 : CHARACTER*(*) TITR,CARAC,PROMPT,REPLY
17 : CHARACTER*(*) LEGEND
18 : CHARACTER*80 TITRE
19 : CHARACTER*500 CHEMIN
20 : equivalence (chemin,ichemi)
21 : LOGICAL VALEU,FENE,VALEUR,FENET
22 : SAVE XIOCAD,YIOCAD,VALEUR,FENET,TITRE,LTITRE
23 : SAVE XMIN,YMIN,XXAX,YYAX,CLX,XRAP,YRAP,XDEP,YDEP
24 : save kcoul,initia,ipag,jfont,jfonl,jpol,landsc
25 : CLP
26 : save lfi
27 : CLP
28 : CLP PARAMETER(IUPS=24)
29 : PARAMETER(IUPS=97)
30 : CPP data initia/0/
31 : CPP data ipag/1/
32 : DIMENSION ITB(17)
33 : logical landsc
34 : character miffil*64,line*256
35 : character*18 lfi,lsp
36 : character*2 cisov(18),cline(18)
37 : C+PPf (FACE)
38 : DIMENSION ITCODP(6)
39 : DATA ITCODP/6,5,4,3,2,1/
40 : C+PPf
41 : data sacfac/1.134/
42 : data initia/0/
43 : data jfont /0/
44 : data jfonl /0/
45 : data jpol /0/
46 : data ipag /1/
47 : c
48 : C PP For a 7-color scale I assume it uses only kolor(4,2,6,3,5,7,0)
49 : c
50 : data cisov /'D0','D1','D2','D3','D4','D5','D6','D7','D8',
51 : > 'D9','DA','DB','DC','DD','DE','DF','DG','DH'/
52 : data cline /'C0','C1','C2','C3','C4','C5','C6','C7',10*'C0'/
53 : c
54 : * verification des bornes
55 : bornex(xxx)=min(max(xiocad*0.01,xxx),xiocad*0.99)
56 : borney(yyy)=min(max(yiocad*0.01,yyy),yiocad*0.99)
57 : cfolco
58 : c
59 : c Note: saclay PostScript output generates a scale that is
60 : c not in true cm, but a bit larger (1 unit= 1.134 cm)
61 : c To obtain 'true' cm we must then divide by 1.134
62 : c We then add 2.0 cm to make the border
63 : coxmif(xxx)=(xxx/sacfac)+2.0
64 : coymif(yyy)=(21.0-yyy)/sacfac+2.0
65 : cfolco
66 : *
67 : C INITIALISATION
68 : * on part pour 7 couleurs
69 : NCOUMA=7
70 : C!!!
71 : NCOUMA=16
72 : C!!!
73 : kcoul=0
74 : LTITRE=LONG(TITR)
75 : TITRE=TITR
76 : VALEUR=VALEU
77 : * INITIALISATION DE POSTSCRIPT
78 : CLX=0.3
79 : xiocad=diocad
80 : yiocad=xiocad*21/29.7
81 : CLP lfi=''
82 : lfi=''
83 : CLP lsp=''
84 : lsp=''
85 : landsc=.true.
86 : c
87 : C+PP
88 : if (ZINIPS) then
89 : ZINIPS = .false.
90 : initia = 0
91 : endif
92 : C+PP
93 : if (initia.eq.0) then
94 : initia=1
95 : kcoul=0
96 : write(iups,'(a)') '# Generated by CASTEM2000'
97 : write(iups,'(a,i1)') '# Dimension: ',idim
98 : write(iups,'(a,a)') '# Title:',titr
99 : write(iups,'(a)') '#'
100 : C LP
101 : C---------------------------
102 : c
103 : c 'mifheader.l' : name of file containing MIF header (Landscape)
104 : c 'mifheader.p' : name of file containing MIF header (Portrait)
105 : c
106 : chemin='MIF_PATH'//char(0)
107 : lchem=500
107 : call ooozen(ichemi,lchem)
108 : if (lchem.eq.0) then
109 : write (ioimp,*) 'Please define MIF_PATH'
110 : stop
111 : endif
112 : lchem=long(chemin(1:lchem))
113 : if(landsc) then
114 : miffil=chemin(1:lchem)//'/mifheader.la'
115 : else
116 : miffil=chemin(1:lchem)//'/mifheader.po'
117 : endif
118 : jfm=89
119 : open(jfm,file=miffil,FORM='FORMATTED',err=901)
120 : nlrd=0
121 : 1 read(jfm,'(a)',end=2) line
122 : nlrd=nlrd+1
123 : klast=0
124 : do 3 k=256,1,-1
125 : if(line(k:k).ne.' ') then
126 : klast=k
127 : go to 4
128 : endif
129 : 3 continue
130 : 4 continue
131 : if(nlrd.eq.1) then
132 : c
133 : c comment out ' # End of page'
194 : endif
195 : initia=initia+1
196 : write(iups,'(a)') '#'
197 : write(iups,'(a)') '# New Page ----------------------------'
198 : write(iups,'(a)') '#'
199 : write(iups,'(a)') ''
201 : write(iups,'(a,i3,a)') ''
202 : if(landsc) then
203 : write(iups,'(a)') ''
204 : write(iups,'(a)') ''
205 : else
206 : write(iups,'(a)') ''
207 : write(iups,'(a)') ''
208 : endif
209 : write(iups,'(a)') ''
210 : write(iups,'(a)') '#'
211 : write(iups,'(a)') '# Objects on page:'
212 : write(iups,'(a)') '#'
213 : write(iups,'(a)') ''
215 : write(iups,'(a)') ' '
216 : write(iups,'(a,2f8.3,a)') ' '
217 : write(iups,'(a)') ' '
218 : write(iups,'(a)') ' '
219 : c------------(assegnazione fonts)------
220 : if(jfonl.eq.1) then
221 : write(iups,'(a)') ' '
223 : write(iups,'(a)') ' '
224 : write(iups,'(a)') ' '
225 : write(iups,'(a)') ' > # end of Font'
226 : jfonl=0
227 : endif
228 : if(jfont.eq.0) then
229 : write(iups,'(a)') ' '
231 : write(iups,'(a)') ' '
232 : write(iups,'(a)') ' '
233 : write(iups,'(a)') ' '
234 : write(iups,'(a)') ' '
235 : CLP write(iups,'(a)') ' '
236 : write(iups,'(a)') ' '
237 : write(iups,'(a)') ' '
238 : write(iups,'(a)') ' '
239 : write(iups,'(a)') ' '
240 : write(iups,'(a)') ' '
241 : write(iups,'(a)') ' '
242 : write(iups,'(a)') ' '
243 : write(iups,'(a)') ' '
244 : write(iups,'(a)') ' '
245 : write(iups,'(a)') ' '
246 : write(iups,'(a)') ' '
247 : write(iups,'(a)') ' '
248 : write(iups,'(a)') ' '
249 : write(iups,'(a)') ' '
250 : write(iups,'(a)') ' '
251 : write(iups,'(a)') ' '
252 : write(iups,'(a)') ' > # end of Font'
253 : jfont=1
254 : endif
255 : write(iups,'(a)') ' '
256 : write(iups,'(a)') '> # end of TextLine'
257 : ipag=ipag+1
258 : c
259 : c
260 : RETURN
261 : **
262 : ENTRY mTRLAB(XT,YT,CARAC,NCARR,HAUT)
263 : * ECRITURE TEXT
264 : C
265 : kcoul=0
266 : write (IUPS,'(a)')cline(kcoul+1)
267 : C
268 : xmif=coxmif(bornex((xdep+xt)*xrap))
269 : ymif=coymif(borney((ydep+yt)*yrap))
270 : write(iups,'(a)') '#'
271 : write(iups,'(a)') ''
273 : write(iups,'(a,2f8.3,a)') ''
274 : write(iups,'(a)') ''
275 : write(iups,'(a)') ''
276 : c------------(assegnazione fonts)------
277 : CLP
278 : if(jfonl.eq.0) then
279 : write(iups,'(a)') ' '
281 : write(iups,'(a)') ' '
282 : write(iups,'(a)') ' '
283 : write(iups,'(a)') ' > # end of Font'
284 : jfonl=1
285 : endif
286 : CLP
287 : if(jfont.eq.0) then
288 : write(iups,'(a)') ' '
290 : write(iups,'(a)') ' '
291 : write(iups,'(a)') ' '
292 : CLP write(iups,'(a)') ' '
293 : write(iups,'(a)') ' '
294 : CLP write(iups,'(a)') ' '
295 : write(iups,'(a)') ' '
296 : CLP write(iups,'(a)') ' '
297 : write(iups,'(a)') ' '
298 : write(iups,'(a)') ' '
299 : write(iups,'(a)') ' '
300 : write(iups,'(a)') ' '
301 : write(iups,'(a)') ' '
302 : write(iups,'(a)') ' '
303 : write(iups,'(a)') ' '
304 : write(iups,'(a)') ' '
305 : write(iups,'(a)') ' '
306 : write(iups,'(a)') ' '
307 : write(iups,'(a)') ' '
308 : write(iups,'(a)') ' '
309 : write(iups,'(a)') ' '
310 : write(iups,'(a)') ' '
311 : write(iups,'(a)') ' '
312 : write(iups,'(a)') ' '
313 : write(iups,'(a)') ' > # end of Font'
314 : jfont=1
315 : endif
316 : write(iups,'(a,a,a)') ' '
317 : write(iups,'(a)') '> # end of TextLine'
318 : c
319 : RETURN
320 : **
321 : ENTRY mCHCOU(JCOLO)
322 : * CHANGEMENT DE COULEUR
323 : kcoul=jcolo
324 : RETURN
325 : **
326 : ENTRY mINSEG(JSEG,IRESS)
327 : * CHANGEMENT SEGMENT IGNORE
328 : RETURN
329 : **
330 : ENTRY mPOLRL(NTRSTU,XTR,YTR)
331 : * POLYLINE
332 : write(iups,'(a)') '#'
333 : write(iups,'(a)') ''
336 : write(iups,'(a)') lfi
337 : write(iups,'(a)') ' '
338 : write(iups,'(a)') ' '
339 : write(iups,'(a)') ' '
340 : jpol=1
341 : endif
342 : write (IUPS,'(a)')cline(kcoul+1)
343 : write(iups,'(a,i3)') ' '
344 : do 10 i=1,ntrstu
345 : xmif=coxmif(bornex((xdep+xtr(i))*xrap))
346 : ymif=coymif(borney((ydep+ytr(i))*yrap))
347 : write(iups,'(a,2f8.3,a)') ' '
348 : 10 continue
349 : write(iups,'(a)') '> # end of PolyLine'
350 : c
351 : RETURN
352 : **
353 : ENTRY mTRFAC(NTRSTU,XTR,YTR,ZN,ICOLE,IEFF)
354 : * FACETTE
355 : C+PPf
356 : ZZN=ABS(ZN/XPI*2)
357 : IF (ZZN.GT.0.99999)ZZN=0.99999
358 : IZN=INT(6*ZZN)+1
359 : IZN=ITCODP(IZN)
360 : C+PPf
361 : kcoul=icole
362 : write(iups,'(a)') '#'
363 : write(iups,'(a)') ''
366 : C+PPf
367 : C PPf if(jpol.eq.0) then
368 : C PPf write(iups,'(a)') ''
369 : C PPf write(iups,'(a)') lfi
370 : C PPf write(iups,'(a)') ''
371 : C PPf endif
372 : C PPf write (IUPS,'(a)')cisov(kcoul+1)
373 : write (IUPS,'(a)')cline(kcoul+1)
374 : C+PPf
375 : write(iups,'(a6,i1,a1)') ''
376 : C+PPf
377 : do 20 i=1,ntrstu
378 : xmif=coxmif(bornex((xdep+xtr(i))*xrap))
379 : ymif=coymif(borney((ydep+ytr(i))*yrap))
380 : write(iups,'(a,2f8.3,a)') ''
381 : 20 continue
382 : write(iups,'(a)') '>'
383 : c
384 : IEFF=1
385 : RETURN
386 : **
387 : ENTRY mTRAIS(NP,XTR,YTR,ICOLE)
388 : * FACETTE
389 : kcoul=icole
390 : write(iups,'(a)') '#'
391 : write(iups,'(a)') ''
394 : write(iups,'(a)') lfi
395 : write(iups,'(a)') ''
396 : endif
397 : write (IUPS,'(a)')cisov(kcoul+1)
398 : do 30 i=1,np
399 : xmif=coxmif(bornex((xdep+xtr(i))*xrap))
400 : ymif=coymif(borney((ydep+ytr(i))*yrap))
401 : write(iups,'(a,2f8.3,a)') ''
402 : 30 continue
403 : write(iups,'(a)') '>'
404 : c
405 : RETURN
406 : **
407 : ENTRY mTRDIG(XRO,XCOL,ICLE)
408 : * DIGITALISATION DE POINT IGNORE
409 : ICLE=0
410 : RETURN
411 : **
412 : ENTRY mTRAFF(ICLE)
413 : * FIN DE DESSIN
414 : ICLE=0
415 : jpol=0
416 : write(iups,'(a)') ' >'
417 : write(iups,'(a)') ' >'
418 : write(iups,'(a)') ' >'
419 : write(iups,'(a)') ' >'
420 : write(iups,'(a)') ' >'
421 : write(iups,'(a)') ' >'
422 : write(iups,'(a)') ' >'
423 : write(iups,'(a)') ' >'
424 : write(iups,'(a)') ' >'
425 : write(iups,'(a)') ' >'
426 : write(iups,'(a)') ' >'
427 : write(iups,'(a)') ' >'
428 : write(iups,'(a)') ' >'
429 : write(iups,'(a)') ' >'
430 : write(iups,'(a)') ' >'
431 : write(iups,'(a)') ' >'
432 : write(iups,'(a)') ' >'
433 : write(iups,'(a)') ' >'
434 : write(iups,'(a)') ' >'
435 : write(iups,'(a)') ' >'
436 : write(iups,'(a)') ' >'
437 : write(iups,'(a)') ' >'
438 : write(iups,'(a)') ' >'
439 : write(iups,'(a)') ' >'
440 : write(iups,'(a)') ' >'
441 : write(iups,'(a)') '> # End of page'
442 : write(iups,'(a)') '# End of MIFFile'
443 : RETURN
444 : **
445 : ENTRY mMENU(LEGEND,NCASE,LLONG)
446 : * MENU IGNORE
447 : RETURN
448 : **
449 : ENTRY mTRANI(ITYPI,NBIMAH)
450 : * ANIMATION IGNOREE
451 : RETURN
452 : **
453 : ENTRY mTRIMA(IMAGI)
454 : * IMAGE IGNOREE
455 : RETURN
456 : **
457 : ENTRY mFVALI(IFENI,IRESU,NH)
458 : * CHANGEMENT DE VIEW PORT
459 : IF (IFENI.EQ.1) THEN
460 : XRAP=CLX*10/0.95
461 : YRAP=clx*2/0.95
462 : XDEP=(xiocad-10*clx)/xrap
463 : YDEP=0.
464 : ENDIF
465 : NH=31
466 : RETURN
467 : **
468 : ENTRY mZOOM(IZOOM,XMI,XMA,YMI,YMA)
469 : * IGNOREE
470 : RETURN
471 : **
472 : ENTRY mINIt(IRESU,ISORT,IQUALI,INUMNO,INUMEL,XMI,XMA,YMI,YMA)
473 : * RETOUR AU DESSIN INITIAL IGNORE
474 : RETURN
475 : **
476 : ENTRY mCHANG(IRESU,ISORT,ICHANG,JSEG)
477 : * AFFICHAGE DESAFFICHAGE NUM NOEUDS ELEMENTS QUAL IGNORE
478 : RETURN
479 : **
480 : ENTRY mTRBOX(HAUTX,HAUTY)
481 : * INUTILISE
482 : RETURN
483 : **
484 : ENTRY mTREFF
485 : * INUTILISE
486 : RETURN
487 : **
488 : ENTRY mVAL(IRESU,ISORT,NISO)
489 : * INUTILISE
490 : RETURN
491 : **
492 : ENTRY mMAJSE(IMAJ,IRESU,IQUALI,INUMNO,INUMEL)
493 : * INUTILISE
494 : RETURN
495 : **
496 : **
497 : ENTRY mIMPR
498 : * INUTILISE
499 : RETURN
500 : **
501 : ENTRY mTRTIN
502 : * INUTILISE
503 : RETURN
504 : **
505 : ENTRY mFLGI
506 : * INUTILISE
507 : RETURN
508 : **
509 : ENTRY mTRMES(CARAC)
510 : * INUTILISE
511 : RETURN
512 : **
513 : ENTRY mTRGET(PROMPT,REPLY)
514 : * INUTILISE
515 : RETURN
516 : ENTRY mTRMFI
517 : * INUTILISE
518 : RETURN
519 : END
520 :
521 :
522 :
523 :
524 :
525 :
526 :
527 :
528 :
529 :