Line data Source code
1 1 : program main
2 : c
3 : c set file corresponding to observed frequencies from grand summary
4 : c or short summary.
5 : c the type of dataset is determined by the parameter icasin.
6 : c
7 : c Double precision version
8 : c ++++++++++++++++++++++++
9 : c
10 : c Dated 10/3/90
11 : c
12 : implicit double precision (a-h, o-z)
13 : character*280 fin, fout
14 : character head*40, ccase*5
15 : logical noprm
16 : dimension cs(50), head(4), ccase(6), ics(8)
17 : c
18 : c common defining standard input and output
19 : c
20 : common/cstdio/ istdin, istdou, istdpr, istder
21 : equivalence(cs(39),ics(1))
22 : data ccase /'grand', 'short', 'dummy', 'grand', 'grand', 'grand'/
23 : data head /'Data set from',' summary in file',' ',' '/
24 : c
25 : c icasin: defines type of modes used for input, and controls output.
26 : c icasin = icase0 + 10*icase1 + 100*icase2
27 : c icase0 = 1: grand summary, variational frequency.
28 : c icase0 = 2: short summary.
29 : c icase0 = 4: grand summary, from eigenfrequency in cs(20).
30 : c Note that this allows setting Cowling
31 : c approximation frequency.
32 : c icase0 = 5: grand summary, from Richardson extrapolation frequency
33 : c in cs(37), if this is set.
34 : c Otherwise variational frequency is used.
35 : c icase0 = 6: grand summary, from (possibly corrected) eigenfrequency
36 : c in cs(21).
37 : c
38 : c If icase1 gt 0 include mode energy
39 : c If icase2 gt 0, and rotational solution is included, print
40 : c m values separately, otherwise print only mode with m = 0.
41 : c
42 1 : icasin=1
43 : c
44 1 : if(istdpr.gt.0)
45 0 : * write(istdpr,*) 'Enter case number (1, 2, 4, 5 or 6)'
46 1 : read(5,*) icasin
47 1 : icase0=mod(icasin,10)
48 1 : icase1=mod(icasin/10,10)
49 1 : icase2=mod(icasin/100,10)
50 : c.. write(6,*) 'icase0, icase1, icase2:', icase0, icase1, icase2
51 : c
52 1 : if(istdpr.gt.0)
53 0 : * write(istdpr,*) 'Enter input file name'
54 1 : read(5,'(a)') fin
55 1 : if(istdpr.gt.0)
56 0 : * write(istdpr,*) 'Enter output file name'
57 1 : read(5,'(a)') fout
58 : c
59 : open(2, file=fin, status='old',
60 1 : * form='unformatted')
61 1 : open(10, file=fout, status='unknown')
62 1 : if(istdpr.gt.0)
63 : * write(istdpr,*)
64 0 : * 'Enter 1 for output format f8.2, 2 for format f10.4,',
65 0 : * ' 3 for format f12.6'
66 1 : iformt = 1
67 1 : read(5,*) iformt
68 : c
69 1 : if(istdpr.gt.0)
70 0 : * write(istdpr,*) 'Input file:'
71 1 : if(istdpr.gt.0)
72 0 : * write(istdpr,*) fin
73 1 : if(istdpr.gt.0)
74 0 : * write(istdpr,*) 'Output file:'
75 1 : if(istdpr.gt.0)
76 0 : * write(istdpr,*) fout
77 : c
78 : c set header
79 : c
80 1 : head(2)(1:5) = ccase(icase0)
81 1 : write(head(3),110) fin
82 1 : if(icase0.eq.1) then
83 0 : head(4) = 'using variational frequencies'
84 1 : else if(icase0.eq.4) then
85 0 : head(4) = 'using (uncorrected) eigenfrequencies'
86 1 : else if(icase0.eq.5) then
87 0 : head(4) = 'using Richardson frequencies'
88 1 : else if(icase0.eq.6) then
89 1 : head(4) = 'using (corrected) eigenfrequencies'
90 : end if
91 : c
92 : c start stepping through dataset
93 : c
94 1 : nrd=0
95 1 : ierrri=0
96 : c
97 47 : 30 call rdfreq(icase0,2,cs,l,nord,sig,frq,ekin,ierr)
98 : c
99 47 : if(ierr.gt.0) go to 60
100 : c
101 : c skip model quantity
102 : c
103 46 : if(icase0.eq.2.and.l.lt.0) then
104 0 : go to 30
105 : end if
106 : c
107 : c test for unavailability of Richardson frequencies
108 : c
109 46 : if(ierrri.eq.0.and.ierr.eq.-1) then
110 0 : ierrri=1
111 0 : if(cs(27).gt.0) then
112 0 : head(4) = 'using variational frequencies'
113 : else
114 0 : head(4) = 'using (uncorrected) eigenfrequencies'
115 : end if
116 : end if
117 : c
118 : c test for inclusion of individual m values
119 : c
120 46 : noprm=.true.
121 : c
122 46 : if(icase0.ne.2) then
123 46 : icase=ics(5)
124 46 : irotsl=mod(icase/100,10)
125 : c.. write(6,*) 'icase, irotsl', icase, irotsl
126 : c
127 : c with rotational splitting, and icase2 = 0, only print m = 0 modes
128 : c
129 46 : if(irotsl.eq.1) then
130 0 : if(icase2.eq.1) then
131 0 : noprm=.false.
132 0 : m=nint(cs(38))
133 0 : else if(cs(38).ne.0) then
134 0 : go to 30
135 : end if
136 : end if
137 : end if
138 : c
139 46 : nrd=nrd+1
140 : c
141 46 : if(iformt.eq.1) then
142 0 : if(nrd.le.4) then
143 0 : if(noprm) then
144 0 : if(icase1.eq.0) then
145 0 : write(10,120) l,nord,frq,head(nrd)
146 : else
147 0 : write(10,125) l,nord,frq,ekin,head(nrd)
148 : end if
149 : else
150 0 : if(icase1.eq.0) then
151 0 : write(10,126) l,m,nord,frq,head(nrd)
152 : else
153 0 : write(10,127) l,m,nord,frq,ekin,head(nrd)
154 : end if
155 : end if
156 : else
157 0 : if(noprm) then
158 0 : if(icase1.eq.0) then
159 0 : write(10,120) l,nord,frq
160 : else
161 0 : write(10,125) l,nord,frq,ekin
162 : end if
163 : else
164 0 : if(icase1.eq.0) then
165 0 : write(10,126) l,m,nord,frq
166 : else
167 0 : write(10,127) l,m,nord,frq,ekin
168 : end if
169 : end if
170 : end if
171 46 : else if(iformt.eq.2) then
172 46 : if(nrd.le.4) then
173 4 : if(noprm) then
174 4 : if(icase1.eq.0) then
175 0 : write(10,130) l,nord,frq,head(nrd)
176 : else
177 4 : write(10,135) l,nord,frq,ekin,head(nrd)
178 : end if
179 : else
180 0 : if(icase1.eq.0) then
181 0 : write(10,136) l,m,nord,frq,head(nrd)
182 : else
183 0 : write(10,137) l,m,nord,frq,ekin,head(nrd)
184 : end if
185 : end if
186 : else
187 42 : if(noprm) then
188 42 : if(icase1.eq.0) then
189 0 : write(10,130) l,nord,frq
190 : else
191 42 : write(10,135) l,nord,frq,ekin
192 : end if
193 : else
194 0 : if(icase1.eq.0) then
195 0 : write(10,136) l,m,nord,frq
196 : else
197 0 : write(10,137) l,m,nord,frq,ekin
198 : end if
199 : end if
200 : end if
201 : else
202 0 : if(nrd.le.4) then
203 0 : if(icase1.eq.0) then
204 0 : write(10,140) l,nord,frq,head(nrd)
205 : else
206 0 : write(10,145) l,nord,frq,ekin,head(nrd)
207 : end if
208 : else
209 0 : if(icase1.eq.0) then
210 0 : write(10,140) l,nord,frq
211 : else
212 0 : write(10,145) l,nord,frq,ekin
213 : end if
214 : end if
215 : end if
216 46 : go to 30
217 : c
218 : 60 continue
219 1 : stop
220 : 110 format(a40)
221 : 120 format(i5,i7, f8.2,2x,a40)
222 : 125 format(i5,i7, f8.2,1pe13.5,2x,a40)
223 : 126 format(3i4, f8.2,2x,a40)
224 : 127 format(3i4, f8.2,1pe13.5,2x,a40)
225 : 130 format(i5,i7,f10.4,2x,a40)
226 : 135 format(i5,i7,f10.4,1pe13.5,2x,a40)
227 : 136 format(3i4, f10.4,2x,a40)
228 : 137 format(3i4, f10.4,1pe13.5,2x,a40)
229 : 140 format(i5,i7,f12.6,2x,a40)
230 : 145 format(i5,i7,f12.6,1pe13.5,2x,a40)
231 1 : end
|
