refract_pgparameters.f 2.82 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
c this is <refract_pgparameters.f>
c------------------------------------------------------------------------------
c
c 04/07/98 by Thomas Forbriger (IfG Stuttgart)
c
c plot parameter settings
c
c REVISIONS and CHANGES
c    04/07/98   V1.0   Thomas Forbriger
c
c==============================================================================
c
      subroutine refract_pgparameters
c
      include 'refract_para.inc'
c
      character*200 parastring
      character*20 numstring
      integer nchar, mm, pp, nc
      real oldch, newch
c 
      if (debug) print *,'DEBUG: entered pgparameters'
c 
      nchar=0
      call refract_sub_pgpara(parastring, nchar, 'mode: ',6)
      call pgnumb(plpar_mode, 0, 0, numstring, nc)
      call refract_sub_pgpara(parastring, nchar, numstring, nc)
c 
      call refract_sub_pgpara(parastring, nchar, '   ',3)
      call refract_sub_pgpara(parastring, nchar, 'exp: ',5)
      mm=int(plpar_expo*1.e3)
      pp=-3
      call pgnumb(mm, pp, 0, numstring, nc)
      call refract_sub_pgpara(parastring, nchar, numstring, nc)
c 
      call refract_sub_pgpara(parastring, nchar, '   ',3)
      call refract_sub_pgpara(parastring, nchar, 'clip: ',6)
      mm=int(plpar_clip*1.e3)
      pp=-3
      call pgnumb(mm, pp, 0, numstring, nc)
      call refract_sub_pgpara(parastring, nchar, numstring, nc)
      call refract_sub_pgpara(parastring, nchar, 'm',1)
c 
      call refract_sub_pgpara(parastring, nchar, '   ',3)
      call refract_sub_pgpara(parastring, nchar, 'amp: ',5)
      mm=int(plpar_amp*1.e3)
      pp=-3
      call pgnumb(mm, pp, 0, numstring, nc)
      call refract_sub_pgpara(parastring, nchar, numstring, nc)
      call refract_sub_pgpara(parastring, nchar, 'm',1)
c 
      if (plflag_reduce) then
        call refract_sub_pgpara(parastring, nchar, '   ',3)
        call refract_sub_pgpara(parastring, nchar, 'v\\dred\\u: ',10)
        mm=int(plpar_vred*1.e3)
        pp=-3
        call pgnumb(mm, pp, 0, numstring, nc)
        call refract_sub_pgpara(parastring, nchar, numstring, nc)
        call refract_sub_pgpara(parastring, nchar, 'km/s',4)
      endif
c 
      if (plpar_remav)
     &  call refract_sub_pgpara(parastring, nchar, '   avg',6)
      if (plflag_invers)
     &  call refract_sub_pgpara(parastring, nchar, '   inv',6)
c 
      call pgqch(oldch)
      newch=oldch*0.8
      call pgsch(newch)
      call pgframeact
      call pgmtxt('T', 1., 0.5, 0.5, parastring(1:nchar))
      call pgsch(oldch)
c 
      return
      end
c
c----------------------------------------------------------------------
c
      subroutine refract_sub_pgpara(ps, pc, is, ic)
c
      character ps*(200), is*(*)
      integer pc, ic
c 
      integer e1,e2,en
c
      e1=pc+1
      e2=pc+ic
      e1=min(200,e1)
      e2=min(200,e2)
      en=e2-e1+1
      ps(e1:e2)=is(1:en)
      pc=e2
c
      return
      end
c
c ----- END OF refract_pgparameters.f -----