1 |
C --------
|
2 |
CN NAME: R P P M
|
3 |
C --------
|
4 |
|
5 |
CP PURPOSE:
|
6 |
CP SOLVE THE 1D EQUATIONS OF RELATIVISTIC HYDRODYNAMICS IN PLANAR SYMMETRY
|
7 |
CP FOR AN IDEAL GAS EQUATION OF STATE.
|
8 |
C
|
9 |
|
10 |
CC COMMENTS:
|
11 |
CC THIS PROGRAM IS DESCRIBED IN THE PAPER BY MARTI & MUELLER, JCP, 1996.
|
12 |
CC IT USES AN EXACT RIEMANN SOLVER (MARTI & MUELLER, JFM, 1994), PPM SPATIAL
|
13 |
CC RECONSTRUCTION AND AVERAGING IN THE DOMAIN OF DEPENDENCE OF THE
|
14 |
CC CELL INTERFACES FOR TIME ADVANCE.
|
15 |
CC LIGHT SPEED IN CODE UNITS IS EQUAL TO 1.
|
16 |
CC
|
17 |
CC WRITTEN BY: Jose-Maria Marti
|
18 |
CC Departamento de Astronomia y Astrofisica
|
19 |
CC Universidad de Valencia
|
20 |
CC 46100 Burjassot (Valencia), Spain
|
21 |
CC jose-maria.marti@uv.es
|
22 |
CC AND
|
23 |
CC Ewald Mueller
|
24 |
CC Max-Planck-Institut fuer Astrophysik
|
25 |
CC Karl-Schwarzschild-Str. 1
|
26 |
CC 85741 Garching, Germany
|
27 |
CC emueller@mpa-garching.mpg.de
|
28 |
C
|
29 |
|
30 |
PROGRAM RPPM
|
31 |
|
32 |
IMPLICIT NONE
|
33 |
|
34 |
INCLUDE 'size'
|
35 |
|
36 |
C ----------
|
37 |
C COMMON BLOCKS
|
38 |
C ----------
|
39 |
|
40 |
INTEGER BNDMNX,BNDMXX
|
41 |
COMMON /BOUN/ BNDMNX,BNDMXX
|
42 |
|
43 |
INTEGER NEND,NOUT,ITSTP,NX
|
44 |
COMMON /INPTI/ NEND,NOUT,ITSTP,NX
|
45 |
|
46 |
INTEGER NSTEP
|
47 |
COMMON /NSTEP/ NSTEP
|
48 |
|
49 |
INTEGER NOUT1
|
50 |
COMMON /OUTI/ NOUT1
|
51 |
|
52 |
DOUBLEPRECISION GAMMA
|
53 |
COMMON /ADIND/ GAMMA
|
54 |
|
55 |
DOUBLEPRECISION X(-4:MN5),XL(-4:MN5),XR(-4:MN5),DX(-4:MN5)
|
56 |
COMMON /GRD/ X,XL,XR,DX
|
57 |
|
58 |
DOUBLEPRECISION P(-4:MN5),RHO(-4:MN5),VEL(-4:MN5),W(-4:MN5),
|
59 |
& U(-4:MN5),CS(-4:MN5),H(-4:MN5),DPDRH(-4:MN5),
|
60 |
& DPDU(-4:MN5),R(-4:MN5),M(-4:MN5),E(-4:MN5)
|
61 |
COMMON /HYDRO/ P,RHO,VEL,W,U,CS,H,DPDRH,DPDU,R,M,E
|
62 |
|
63 |
DOUBLEPRECISION TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
64 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
65 |
COMMON /INPTF/ TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
66 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
67 |
|
68 |
DOUBLEPRECISION TOUT1
|
69 |
COMMON /OUTF/ TOUT1
|
70 |
|
71 |
DOUBLEPRECISION TIME,DT
|
72 |
COMMON /ZEIT/ TIME,DT
|
73 |
|
74 |
CHARACTER*7 OUTFIL
|
75 |
CHARACTER*8 LABEL
|
76 |
CHARACTER*4 BASENM
|
77 |
CHARACTER*2 SUFFIX
|
78 |
COMMON /CHRC/ LABEL,OUTFIL,BASENM,SUFFIX
|
79 |
|
80 |
C --------------------
|
81 |
C READ INITIAL PARAMETERS
|
82 |
C --------------------
|
83 |
|
84 |
CALL INPUT
|
85 |
|
86 |
C --------------------
|
87 |
C CONSTRUCT A NEW MODEL
|
88 |
C --------------------
|
89 |
|
90 |
IF (SUFFIX(2:2).NE.'A') THEN
|
91 |
|
92 |
WRITE(6,2000)
|
93 |
2000 FORMAT('RPPM: CHECK INPUT FILE SUFFIX')
|
94 |
STOP
|
95 |
|
96 |
END IF
|
97 |
|
98 |
WRITE(6,2100)
|
99 |
2100 FORMAT('RPPM: CONSTRUCTING NEW INITIAL MODEL')
|
100 |
|
101 |
CALL GRID
|
102 |
|
103 |
CALL INIT
|
104 |
|
105 |
CALL TSTEP
|
106 |
|
107 |
DT = MIN(DT, DTINI)
|
108 |
|
109 |
OUTFIL = BASENM//'O'//SUFFIX
|
110 |
|
111 |
NOUT1 = 0
|
112 |
TOUT1 = 0.D0
|
113 |
|
114 |
C -------------
|
115 |
C START TIME LOOP
|
116 |
C -------------
|
117 |
|
118 |
DO 100 NSTEP = 1, NEND
|
119 |
|
120 |
TIME = TIME + DT
|
121 |
NOUT1 = NOUT1 + 1
|
122 |
TOUT1 = TOUT1 + DT
|
123 |
|
124 |
IF (TIME.GT.TMAX) GOTO 200
|
125 |
|
126 |
CALL BNDRY
|
127 |
|
128 |
CALL HYDROW
|
129 |
|
130 |
IF ( (NOUT1.GE.NOUT) .OR. (TOUT1.GE.TOUT)) CALL PLTOUT
|
131 |
|
132 |
CALL TSTEP
|
133 |
|
134 |
100 CONTINUE
|
135 |
|
136 |
200 CONTINUE
|
137 |
|
138 |
STOP 'RPPM: NORMAL TERMINATION'
|
139 |
END
|
140 |
|
141 |
C --------
|
142 |
CN NAME: I N P U T
|
143 |
C --------
|
144 |
|
145 |
CP PURPOSE:
|
146 |
CP READS THE INITIAL PARAMETERS FROM FILE inpt.dat
|
147 |
C
|
148 |
|
149 |
CC COMMENTS:
|
150 |
CC SEE INSERTED COMMENTS
|
151 |
|
152 |
SUBROUTINE INPUT
|
153 |
|
154 |
IMPLICIT NONE
|
155 |
|
156 |
INCLUDE 'size'
|
157 |
|
158 |
C ---------
|
159 |
C COMMON BLOCKS
|
160 |
C ---------
|
161 |
|
162 |
INTEGER NEND,NOUT,ITSTP,NX
|
163 |
COMMON /INPTI/ NEND,NOUT,ITSTP,NX
|
164 |
|
165 |
DOUBLEPRECISION TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
166 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
167 |
COMMON /INPTF/ TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
168 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
169 |
|
170 |
CHARACTER*7 OUTFIL
|
171 |
CHARACTER*8 LABEL,LABEL1
|
172 |
CHARACTER*4 BASENM
|
173 |
CHARACTER*2 SUFFIX
|
174 |
COMMON /CHRC/ LABEL,OUTFIL,BASENM,SUFFIX
|
175 |
|
176 |
C ---------
|
177 |
C INTERNAL VARIABLES
|
178 |
C ---------
|
179 |
|
180 |
CHARACTER*72 TEXT
|
181 |
CHARACTER*2 TXT
|
182 |
CHARACTER*15 TXTXT
|
183 |
DATA TXTXT /'............. '/
|
184 |
|
185 |
OPEN(1,FILE='inpt.dat',FORM='FORMATTED',STATUS='OLD')
|
186 |
|
187 |
READ (1,*) TEXT
|
188 |
WRITE(6,*) TEXT
|
189 |
READ (1,*) TEXT
|
190 |
WRITE(6,*) TEXT
|
191 |
READ (1,*) TEXT
|
192 |
WRITE(6,*) TEXT
|
193 |
PRINT*, '-------------------------------------------------------'
|
194 |
|
195 |
C ----------------------------
|
196 |
C BASENM IS THE ROOT FOR THE OUTPUT, PLOT AND RESTART FILE NAMES (ROOTS
|
197 |
C RST_, RBW_, RSR_, RBWI STAND FOR SPECIAL TESTS)
|
198 |
C ----------------------------
|
199 |
|
200 |
READ (1,*) TXT,LABEL,BASENM
|
201 |
WRITE(6,*) TXT,LABEL,TXTXT,BASENM
|
202 |
LABEL1 = 'basenm'
|
203 |
IF (LABEL.NE.LABEL1) GOTO 10
|
204 |
|
205 |
C ----------------------------
|
206 |
C NEND IS THE TOTAL NUMBER OF TIMESTEPS
|
207 |
C ----------------------------
|
208 |
|
209 |
READ (1,*) TXT,LABEL,NEND
|
210 |
WRITE(6,*) TXT,LABEL,TXTXT,NEND
|
211 |
LABEL1 = 'nend'
|
212 |
IF (LABEL.NE.LABEL1) GOTO 10
|
213 |
|
214 |
C ----------------------------
|
215 |
C THE PROGRAM STOPS WHEN TIME IS .GE. THAN TMAX
|
216 |
C ----------------------------
|
217 |
|
218 |
READ (1,*) TXT,LABEL,TMAX
|
219 |
WRITE(6,*) TXT,LABEL,TXTXT,TMAX
|
220 |
LABEL1 = 'tmax'
|
221 |
IF (LABEL.NE.LABEL1) GOTO 10
|
222 |
|
223 |
C ----------------------------
|
224 |
C SUFFIX IS THE SUFFIX FOR THE OUTPUT AND RESTART FILE NAMES
|
225 |
C ----------------------------
|
226 |
|
227 |
READ (1,*) TXT,LABEL,SUFFIX
|
228 |
WRITE(6,*) TXT,LABEL,TXTXT,SUFFIX
|
229 |
LABEL1 = 'suffix'
|
230 |
IF (LABEL.NE.LABEL1) GOTO 10
|
231 |
|
232 |
C ----------------------------
|
233 |
C AN OUTPUT FILE IS WRITEN EVERY NOUT TIMESTEPS
|
234 |
C ----------------------------
|
235 |
|
236 |
READ (1,*) TXT,LABEL,NOUT
|
237 |
WRITE(6,*) TXT,LABEL,TXTXT,NOUT
|
238 |
LABEL1 = 'nout'
|
239 |
IF (LABEL.NE.LABEL1) GOTO 10
|
240 |
|
241 |
C ----------------------------
|
242 |
C AN OUTPUT FILE IS WRITEN EVERY TOUT TIME UNITS
|
243 |
C ----------------------------
|
244 |
|
245 |
READ (1,*) TXT,LABEL,TOUT
|
246 |
WRITE(6,*) TXT,LABEL,TXTXT,TOUT
|
247 |
LABEL1 = 'tout'
|
248 |
IF (LABEL.NE.LABEL1) GOTO 10
|
249 |
|
250 |
C -----------------------------
|
251 |
C DT IS WRITEN ON THE SCREEN EVERY ITSTP TIMESTEPS
|
252 |
C -----------------------------
|
253 |
|
254 |
READ (1,*) TXT,LABEL,ITSTP
|
255 |
WRITE(6,*) TXT,LABEL,TXTXT,ITSTP
|
256 |
LABEL1 = 'itstp'
|
257 |
IF (LABEL.NE.LABEL1) GOTO 10
|
258 |
|
259 |
C -----------------------------
|
260 |
C CFL IS THE TIME-LIMITING FACTOR (.LT. 1)
|
261 |
C -----------------------------
|
262 |
|
263 |
READ (1,*) TXT,LABEL,CFL
|
264 |
WRITE(6,*) TXT,LABEL,TXTXT,CFL
|
265 |
LABEL1 = 'cfl'
|
266 |
IF (LABEL.NE.LABEL1) GOTO 10
|
267 |
|
268 |
C -------------------
|
269 |
C DTINI IS THE INITIAL DT
|
270 |
C -------------------
|
271 |
|
272 |
READ (1,*) TXT,LABEL,DTINI
|
273 |
WRITE(6,*) TXT,LABEL,TXTXT,DTINI
|
274 |
LABEL1 = 'dtini'
|
275 |
IF (LABEL.NE.LABEL1) GOTO 10
|
276 |
|
277 |
C -------------------------------------------
|
278 |
C SMALL IS THE THRESHOLD FOR NONDIMENSIONAL NUMBERS (I.E. VELOCITY)
|
279 |
C -------------------------------------------
|
280 |
|
281 |
READ (1,*) TXT,LABEL,SMALL
|
282 |
WRITE(6,*) TXT,LABEL,TXTXT,SMALL
|
283 |
LABEL1 = 'small'
|
284 |
IF (LABEL.NE.LABEL1) GOTO 10
|
285 |
|
286 |
C -----------------------------------------
|
287 |
C SMLRHO IS THE THRESHOLD FOR DENSITIES (RHO, R)
|
288 |
C -----------------------------------------
|
289 |
|
290 |
READ (1,*) TXT,LABEL,SMLRHO
|
291 |
WRITE(6,*) TXT,LABEL,TXTXT,SMLRHO
|
292 |
LABEL1 = 'smlrho'
|
293 |
IF (LABEL.NE.LABEL1) GOTO 10
|
294 |
|
295 |
C --------------------------------
|
296 |
C SMALLP IS THE THRESHOLD FOR PRESSURE
|
297 |
C --------------------------------
|
298 |
|
299 |
READ (1,*) TXT,LABEL,SMALLP
|
300 |
WRITE(6,*) TXT,LABEL,TXTXT,SMALLP
|
301 |
LABEL1 = 'smallp'
|
302 |
IF (LABEL.NE.LABEL1) GOTO 10
|
303 |
|
304 |
C ---------------------------------
|
305 |
C SMALLU IS THE THRESHOLD FOR INTERNAL ENERGY
|
306 |
C ---------------------------------
|
307 |
|
308 |
READ (1,*) TXT,LABEL,SMALLU
|
309 |
WRITE(6,*) TXT,LABEL,TXTXT,SMALLU
|
310 |
LABEL1 = 'smallu'
|
311 |
IF (LABEL.NE.LABEL1) GOTO 10
|
312 |
|
313 |
C ------------------------
|
314 |
C GRIDLX IS THE LENGTH OF THE GRID
|
315 |
C ------------------------
|
316 |
|
317 |
READ (1,*) TXT,LABEL,GRIDLX
|
318 |
WRITE(6,*) TXT,LABEL,TXTXT,GRIDLX
|
319 |
LABEL1 = 'gridlx'
|
320 |
IF (LABEL.NE.LABEL1) GOTO 10
|
321 |
|
322 |
IF ((BASENM.EQ.'RST_'.OR.BASENM.EQ.'RBW_'.OR.BASENM.EQ.'RSR_'.OR.
|
323 |
& BASENM.EQ.'RBWI').AND.
|
324 |
& GRIDLX.NE.1.D0) THEN
|
325 |
|
326 |
GRIDLX = 1.D0
|
327 |
WRITE(6,1200)
|
328 |
1200 FORMAT('INPUT: GRIDLX RESET TO 1.D0')
|
329 |
|
330 |
END IF
|
331 |
|
332 |
C ---------------------------
|
333 |
C NX IS THE NUMBER OF GRID POINTS
|
334 |
C ---------------------------
|
335 |
|
336 |
READ (1,*) TXT,LABEL,NX
|
337 |
WRITE(6,*) TXT,LABEL,TXTXT,NX
|
338 |
LABEL1 = 'nx'
|
339 |
IF (LABEL.NE.LABEL1) GOTO 10
|
340 |
|
341 |
IF (NX.LT.4.OR.NX.GT.MNX) STOP 'INPUT: UNSUITABLE NX'
|
342 |
|
343 |
C ----------------------------------------
|
344 |
C ETA1 IS USED IN SUBROUTINE DETECT (PPM RECONSTRUCTION)
|
345 |
C TYPICAL VALUE: 5.D0
|
346 |
C ----------------------------------------
|
347 |
|
348 |
READ (1,*) TXT,LABEL,ETA1
|
349 |
WRITE(6,*) TXT,LABEL,TXTXT,ETA1
|
350 |
LABEL1 = 'eta1'
|
351 |
IF (LABEL.NE.LABEL1) GOTO 10
|
352 |
|
353 |
C -------------------------------------------
|
354 |
C ETA2 IS USED IN SUBROUTINE DETECT (PPM RECONSTRUCTION)
|
355 |
C TYPICAL VALUE: 5.D-2
|
356 |
C -------------------------------------------
|
357 |
|
358 |
READ (1,*) TXT,LABEL,ETA2
|
359 |
WRITE(6,*) TXT,LABEL,TXTXT,ETA2
|
360 |
LABEL1 = 'eta2'
|
361 |
IF (LABEL.NE.LABEL1) GOTO 10
|
362 |
|
363 |
C ---------------------------------------
|
364 |
C EPSLN IS USED IN SUBROUTINE DETECT (PPM RECONSTRUCTION)
|
365 |
C TYPICAL VALUE: 1.D-1
|
366 |
C ---------------------------------------
|
367 |
|
368 |
READ (1,*) TXT,LABEL,EPSLN
|
369 |
WRITE(6,*) TXT,LABEL,TXTXT,EPSLN
|
370 |
LABEL1 = 'epsln'
|
371 |
IF (LABEL.NE.LABEL1) GOTO 10
|
372 |
|
373 |
C -----------------------------------------
|
374 |
C AK0 IS USED IN SUBROUTINE DETECT (PPM RECONSTRUCTION)
|
375 |
C TYPICAL VALUE: 1.D0
|
376 |
C -----------------------------------------
|
377 |
READ (1,*) TXT,LABEL,AK0
|
378 |
WRITE(6,*) TXT,LABEL,TXTXT,AK0
|
379 |
LABEL1 = 'ak0'
|
380 |
IF (LABEL.NE.LABEL1) GOTO 10
|
381 |
|
382 |
C ----------------------------------------
|
383 |
C EPSILN IS USED IN SUBROUTINE FLATEN (PPM RECONSTRUCTION)
|
384 |
C TYPICAL VALUE: 1.D0
|
385 |
C ----------------------------------------
|
386 |
|
387 |
READ (1,*) TXT,LABEL,EPSILN
|
388 |
WRITE(6,*) TXT,LABEL,TXTXT,EPSILN
|
389 |
LABEL1 = 'epsiln'
|
390 |
IF (LABEL.NE.LABEL1) GOTO 10
|
391 |
|
392 |
C ---------------------------------------
|
393 |
C OMG1 IS USED IN SUBROUTINE FLATEN (PPM RECONSTRUCTION)
|
394 |
C TYPICAL VALUE: 5.2D-1
|
395 |
C ---------------------------------------
|
396 |
|
397 |
READ (1,*) TXT,LABEL,OMG1
|
398 |
WRITE(6,*) TXT,LABEL,TXTXT,OMG1
|
399 |
LABEL1 = 'omg1'
|
400 |
IF (LABEL.NE.LABEL1) GOTO 10
|
401 |
|
402 |
C ----------------------------------------
|
403 |
C OMG2 IS USED IN SUBROUTINE FLATEN (PPM RECONSTRUCTION)
|
404 |
C TYPICAL VALUE: 1.D1
|
405 |
C ----------------------------------------
|
406 |
|
407 |
READ (1,*) TXT,LABEL,OMG2
|
408 |
WRITE(6,*) TXT,LABEL,TXTXT,OMG2
|
409 |
LABEL1 = 'omg2'
|
410 |
IF (LABEL.NE.LABEL1) GOTO 10
|
411 |
|
412 |
PRINT*, '-------------------------------------------------------'
|
413 |
|
414 |
RETURN
|
415 |
|
416 |
10 CONTINUE
|
417 |
PRINT*, ' '
|
418 |
WRITE(6,1020)
|
419 |
1020 FORMAT('INPUT: INCORRECT INPUT DECK')
|
420 |
WRITE(6,1001) LABEL, LABEL1
|
421 |
1001 FORMAT(' LABEL = ',A6,' EXPECTED LABEL = ',A6)
|
422 |
STOP
|
423 |
|
424 |
END
|
425 |
|
426 |
C --------
|
427 |
CN NAME: G R I D
|
428 |
C --------
|
429 |
|
430 |
CP PURPOSE:
|
431 |
CP ESTABLISHES THE BOUNDARY CONDITIONS AND SETS UP THE NUMERICAL GRID
|
432 |
C
|
433 |
|
434 |
CC COMMENTS:
|
435 |
CC BOUNDARY CONDITIONS ARE SPECIFIED FOR A SERIES OF 1D TESTS. BOUNDARIES.
|
436 |
CC APPROPRIATE BOUNDARIES MUST BE CHOSEN BY THE USER FOR SPECIFIC PROBLEMS.
|
437 |
CC AN EQUIDISTANT X-GRID IS GENERATED BY DEFAULT, HOWEVER THE CODE IS
|
438 |
CC SUITED FOR NON-EQUIDISTANT GRIDS
|
439 |
|
440 |
SUBROUTINE GRID
|
441 |
|
442 |
IMPLICIT NONE
|
443 |
|
444 |
INCLUDE 'size'
|
445 |
|
446 |
C ----------
|
447 |
C COMMON BLOCKS
|
448 |
C ----------
|
449 |
|
450 |
INTEGER BNDMNX,BNDMXX
|
451 |
COMMON /BOUN/ BNDMNX,BNDMXX
|
452 |
|
453 |
INTEGER NEND,NOUT,ITSTP,NX
|
454 |
COMMON /INPTI/ NEND,NOUT,ITSTP,NX
|
455 |
|
456 |
DOUBLEPRECISION X(-4:MN5),XL(-4:MN5),XR(-4:MN5),DX(-4:MN5)
|
457 |
COMMON /GRD/ X,XL,XR,DX
|
458 |
|
459 |
DOUBLEPRECISION TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
460 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
461 |
COMMON /INPTF/ TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
462 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
463 |
|
464 |
CHARACTER*7 OUTFIL
|
465 |
CHARACTER*8 LABEL
|
466 |
CHARACTER*4 BASENM
|
467 |
CHARACTER*2 SUFFIX
|
468 |
COMMON /CHRC/ LABEL,OUTFIL,BASENM,SUFFIX
|
469 |
|
470 |
C -------------
|
471 |
C INTERNAL VARIABLES
|
472 |
C -------------
|
473 |
|
474 |
INTEGER I
|
475 |
|
476 |
DOUBLEPRECISION DELX
|
477 |
|
478 |
C ---------------------------------
|
479 |
C BOUNDARY CONDITIONS
|
480 |
C BNDM.. = 1 ===> REFLECTING BOUNDARY
|
481 |
C BNDM.. = 2 ===> FLOW OUT BOUNDARY
|
482 |
C BNDM.. = 3 ===> FLOW IN BOUNDARY
|
483 |
C BNDM.. = 4 ===> PERIODIC BOUNDARY
|
484 |
C BNDM.. = 5 ===> ANY OTHER BOUNDARY
|
485 |
C ---------------------------------
|
486 |
|
487 |
IF (BASENM.EQ.'RST_'.OR.BASENM.EQ.'RBW_'.OR.BASENM.EQ.'RBWI') THEN
|
488 |
BNDMNX = 2
|
489 |
BNDMXX = 2
|
490 |
ELSE IF (BASENM.EQ.'RSR_') THEN
|
491 |
BNDMNX = 2
|
492 |
BNDMXX = 1
|
493 |
ELSE
|
494 |
BNDMNX = 2
|
495 |
BNDMXX = 2
|
496 |
END IF
|
497 |
|
498 |
IF (BNDMNX.EQ.4.AND.BNDMXX.NE.4) STOP 'GRID: INCORRECT BOUNDARIES'
|
499 |
|
500 |
C ----------
|
501 |
C SET UP X-GRID
|
502 |
C ----------
|
503 |
|
504 |
X(1) = 0.D0
|
505 |
|
506 |
DELX = GRIDLX/DFLOAT(NX)
|
507 |
|
508 |
DO 10 I=2,NX+1
|
509 |
XL(I) = XL(I-1) + DELX
|
510 |
10 CONTINUE
|
511 |
|
512 |
|
513 |
DO 20 I=1,NX
|
514 |
XR(I) = XL(I+1)
|
515 |
20 CONTINUE
|
516 |
|
517 |
DO 30 I=1,NX
|
518 |
X(I) = 0.5D0*(XL(I) + XR(I))
|
519 |
30 CONTINUE
|
520 |
|
521 |
DO 40 I=1,NX
|
522 |
DX(I) = XR(I) - XL(I)
|
523 |
40 CONTINUE
|
524 |
|
525 |
RETURN
|
526 |
END
|
527 |
|
528 |
C --------
|
529 |
CN NAME: I N I T
|
530 |
C --------
|
531 |
|
532 |
CP PURPOSE:
|
533 |
CP DEFINES THE INITIAL MODEL
|
534 |
C
|
535 |
|
536 |
CC COMMENTS:
|
537 |
CC DEFINES INITIAL DATA FOR A SERIES OF STANDARD 1D TEST PROBLEMS.
|
538 |
CC APPROPRIATE INITIAL DATA MUST BE DEFINED BY THE USER FOR SPECIFIC
|
539 |
CC PROBLEMS.
|
540 |
|
541 |
SUBROUTINE INIT
|
542 |
|
543 |
IMPLICIT NONE
|
544 |
|
545 |
INCLUDE 'size'
|
546 |
|
547 |
C -----------
|
548 |
C COMMON BLOCKS
|
549 |
C -----------
|
550 |
|
551 |
INTEGER NEND,NOUT,ITSTP,NX
|
552 |
COMMON /INPTI/ NEND,NOUT,ITSTP,NX
|
553 |
|
554 |
DOUBLEPRECISION GAMMA
|
555 |
COMMON /ADIND/ GAMMA
|
556 |
|
557 |
DOUBLEPRECISION X(-4:MN5),XL(-4:MN5),XR(-4:MN5),DX(-4:MN5)
|
558 |
COMMON /GRD/ X,XL,XR,DX
|
559 |
|
560 |
DOUBLEPRECISION P(-4:MN5),RHO(-4:MN5),VEL(-4:MN5),W(-4:MN5),
|
561 |
& U(-4:MN5),CS(-4:MN5),H(-4:MN5),DPDRH(-4:MN5),
|
562 |
& DPDU(-4:MN5),R(-4:MN5),M(-4:MN5),E(-4:MN5)
|
563 |
COMMON /HYDRO/ P,RHO,VEL,W,U,CS,H,DPDRH,DPDU,R,M,E
|
564 |
|
565 |
DOUBLEPRECISION TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
566 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
567 |
COMMON /INPTF/ TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
568 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
569 |
|
570 |
DOUBLEPRECISION TIME,DT
|
571 |
COMMON /ZEIT/ TIME,DT
|
572 |
|
573 |
CHARACTER*7 OUTFIL
|
574 |
CHARACTER*8 LABEL
|
575 |
CHARACTER*4 BASENM
|
576 |
CHARACTER*2 SUFFIX
|
577 |
COMMON /CHRC/ LABEL,OUTFIL,BASENM,SUFFIX
|
578 |
|
579 |
C -----------
|
580 |
C INTERNAL VARIABLES
|
581 |
C -----------
|
582 |
|
583 |
INTEGER I
|
584 |
|
585 |
C ---------
|
586 |
C INITIAL TIME
|
587 |
C ---------
|
588 |
|
589 |
TIME = 0.D0
|
590 |
|
591 |
C ---------------------
|
592 |
C RELATIVISTIC SOD'S TUBE
|
593 |
C ---------------------
|
594 |
|
595 |
IF (BASENM.EQ.'RST_') THEN
|
596 |
|
597 |
GAMMA = 1.4D0
|
598 |
|
599 |
DO 100 I=1,NX
|
600 |
|
601 |
IF (X(I).LE.GRIDLX/2.D0) THEN
|
602 |
VEL(I) = 0.D0
|
603 |
RHO(I) = 1.D0
|
604 |
U(I) = 2.5D0
|
605 |
ELSE
|
606 |
VEL(I) = 0.D0
|
607 |
RHO(I) = 0.125D0
|
608 |
U(I) = 2.D0
|
609 |
END IF
|
610 |
|
611 |
100 CONTINUE
|
612 |
|
613 |
GOTO 450
|
614 |
|
615 |
END IF
|
616 |
|
617 |
C ----------------------
|
618 |
C SCHNEIDER ET AL.'S TEST
|
619 |
C ----------------------
|
620 |
|
621 |
IF (BASENM.EQ.'SCHN') THEN
|
622 |
|
623 |
GAMMA = 5.D0/3.D0
|
624 |
|
625 |
DO 125 I=1,NX
|
626 |
|
627 |
IF (X(I).LE.GRIDLX/2.D0) THEN
|
628 |
VEL(I) = 0.D0
|
629 |
RHO(I) = 10.D0
|
630 |
U(I) = 2.D0
|
631 |
ELSE
|
632 |
VEL(I) = 0.D0
|
633 |
RHO(I) = 1.D0
|
634 |
U(I) = 1.D-6
|
635 |
END IF
|
636 |
|
637 |
125 CONTINUE
|
638 |
|
639 |
GOTO 450
|
640 |
|
641 |
END IF
|
642 |
|
643 |
C --------------------
|
644 |
C RELATIVISTIC BLAST WAVE
|
645 |
C --------------------
|
646 |
|
647 |
IF (BASENM.EQ.'RBW_') THEN
|
648 |
|
649 |
GAMMA = 5.D0/3.D0
|
650 |
|
651 |
DO 200 I=1,NX
|
652 |
|
653 |
IF (X(I).LE.GRIDLX/2.D0) THEN
|
654 |
VEL(I) = 0.D0
|
655 |
RHO(I) = 1.D0
|
656 |
U(I) = 1.5D3
|
657 |
ELSE
|
658 |
VEL(I) = 0.D0
|
659 |
RHO(I) = 1.D0
|
660 |
U(I) = 1.5D-2
|
661 |
END IF
|
662 |
|
663 |
200 CONTINUE
|
664 |
|
665 |
GOTO 450
|
666 |
|
667 |
END IF
|
668 |
|
669 |
C -----------------------
|
670 |
C RELATIVISTIC SHOCK REFLECTION
|
671 |
C -----------------------
|
672 |
|
673 |
IF (BASENM.EQ.'RSR_') THEN
|
674 |
|
675 |
GAMMA = 4.D0/3.D0
|
676 |
|
677 |
DO 300 I=1,NX
|
678 |
|
679 |
VEL(I) = 0.99999D0
|
680 |
RHO(I) = 1.D0
|
681 |
U(I) = 1.D-7/DSQRT(1.D0 - VEL(I)*VEL(I))
|
682 |
|
683 |
300 CONTINUE
|
684 |
|
685 |
GOTO 450
|
686 |
|
687 |
END IF
|
688 |
|
689 |
C ------------------------
|
690 |
C RELATIVISTIC BLAST WAVE INTERACTION
|
691 |
C ------------------------
|
692 |
|
693 |
IF (BASENM.EQ.'RBWI') THEN
|
694 |
|
695 |
GAMMA = 1.4D0
|
696 |
|
697 |
DO 400 I=1,NX
|
698 |
|
699 |
IF (X(I).LE.0.1D0*GRIDLX) THEN
|
700 |
VEL(I) = 0.D0
|
701 |
RHO(I) = 1.D0
|
702 |
U(I) = 2.5D3
|
703 |
ELSE IF (X(I).LE.0.9D0*GRIDLX) THEN
|
704 |
VEL(I) = 0.D0
|
705 |
RHO(I) = 1.D0
|
706 |
U(I) = 2.5D-2
|
707 |
ELSE
|
708 |
VEL(I) = 0.D0
|
709 |
RHO(I) = 1.D0
|
710 |
U(I) = 2.5D2
|
711 |
END IF
|
712 |
|
713 |
400 CONTINUE
|
714 |
|
715 |
GOTO 450
|
716 |
END IF
|
717 |
|
718 |
STOP 'INIT: NO INITIAL DATA SPECIFIED'
|
719 |
|
720 |
450 CONTINUE
|
721 |
|
722 |
CALL EOS (NX, RHO, U, GAMMA, P, H, CS, DPDRH, DPDU)
|
723 |
|
724 |
DO 500 I=1,NX
|
725 |
|
726 |
W(I) = 1.D0/DSQRT(1.D0 - VEL(I)*VEL(I))
|
727 |
|
728 |
R(I) = RHO(I)*W(I)
|
729 |
M(I) = R(I)*H(I)*W(I)*VEL(I)
|
730 |
E(I) = R(I)*H(I)*W(I) - P(I) - R(I)
|
731 |
|
732 |
500 CONTINUE
|
733 |
|
734 |
RETURN
|
735 |
END
|
736 |
|
737 |
C --------
|
738 |
CN NAME: T S T E P
|
739 |
C --------
|
740 |
|
741 |
CP PURPOSE:
|
742 |
CP COMPUTES THE NEW TIMESTEP VALUE FROM COURANT CONDITION
|
743 |
C
|
744 |
|
745 |
CC COMMENTS:
|
746 |
CC NONE
|
747 |
|
748 |
SUBROUTINE TSTEP
|
749 |
|
750 |
IMPLICIT NONE
|
751 |
|
752 |
INCLUDE 'size'
|
753 |
|
754 |
C -----------
|
755 |
C COMMON BLOCKS
|
756 |
C -----------
|
757 |
|
758 |
INTEGER NEND,NOUT,ITSTP,NX
|
759 |
COMMON /INPTI/ NEND,NOUT,ITSTP,NX
|
760 |
|
761 |
INTEGER NSTEP
|
762 |
COMMON /NSTEP/ NSTEP
|
763 |
|
764 |
DOUBLEPRECISION X(-4:MN5),XL(-4:MN5),XR(-4:MN5),DX(-4:MN5)
|
765 |
COMMON /GRD/ X,XL,XR,DX
|
766 |
|
767 |
DOUBLEPRECISION P(-4:MN5),RHO(-4:MN5),VEL(-4:MN5),W(-4:MN5),
|
768 |
& U(-4:MN5),CS(-4:MN5),H(-4:MN5),DPDRH(-4:MN5),
|
769 |
& DPDU(-4:MN5),R(-4:MN5),M(-4:MN5),E(-4:MN5)
|
770 |
COMMON /HYDRO/ P,RHO,VEL,W,U,CS,H,DPDRH,DPDU,R,M,E
|
771 |
|
772 |
DOUBLEPRECISION TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
773 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
774 |
COMMON /INPTF/ TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
775 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
776 |
|
777 |
DOUBLEPRECISION TIME,DT
|
778 |
COMMON /ZEIT/ TIME,DT
|
779 |
|
780 |
C ------------
|
781 |
C INTERNAL VARIABLES
|
782 |
C ------------
|
783 |
|
784 |
INTEGER I,IC
|
785 |
|
786 |
DOUBLEPRECISION DTCC,DTEST(MN)
|
787 |
|
788 |
DOUBLEPRECISION LAMBD1,LAMBD4,LAMBDA
|
789 |
|
790 |
DOUBLEPRECISION V
|
791 |
|
792 |
IC = 0
|
793 |
DTCC = 0.D0
|
794 |
|
795 |
DO 10 I=1,NX
|
796 |
|
797 |
LAMBD1 = (VEL(I) - CS(I))/(1.D0 - VEL(I)*CS(I))
|
798 |
LAMBD4 = (VEL(I) + CS(I))/(1.D0 + VEL(I)*CS(I))
|
799 |
LAMBDA = DMAX1(DABS(LAMBD1),DABS(LAMBD4))
|
800 |
DTEST(I) = LAMBDA/(XR(I) - XL(I))
|
801 |
|
802 |
10 CONTINUE
|
803 |
|
804 |
DO 13 I=1,NX
|
805 |
|
806 |
IF (DTEST(I).GT.DTCC) THEN
|
807 |
IC = I
|
808 |
DTCC = DTEST(I)
|
809 |
END IF
|
810 |
|
811 |
13 CONTINUE
|
812 |
|
813 |
DT = CFL/DTCC
|
814 |
|
815 |
V = DABS(VEL(IC))
|
816 |
|
817 |
IF (MOD(NSTEP,ITSTP).NE.0) RETURN
|
818 |
|
819 |
WRITE(6,1001) NSTEP,DT,IC,CS(IC),V
|
820 |
|
821 |
1001 FORMAT(I5,2X,1PE8.1,2X,I5,2X,1P2E11.2,2X,1P2E11.2)
|
822 |
|
823 |
RETURN
|
824 |
END
|
825 |
|
826 |
C --------
|
827 |
CN NAME: B N D R Y
|
828 |
C --------
|
829 |
|
830 |
CP PURPOSE:
|
831 |
CP PROVIDES DIFFERENT TYPES OF BOUNDARY CONDITIONS
|
832 |
C
|
833 |
|
834 |
CC COMMENTS:
|
835 |
CC NEW BOUNDARY CONDITIONS CAN BE SPECIFIED AT THE USER'S WILL
|
836 |
|
837 |
SUBROUTINE BNDRY
|
838 |
|
839 |
IMPLICIT NONE
|
840 |
|
841 |
INCLUDE 'size'
|
842 |
|
843 |
C --------
|
844 |
C COMMON BLOCKS
|
845 |
C --------
|
846 |
|
847 |
INTEGER BNDMNX,BNDMXX
|
848 |
COMMON /BOUN/ BNDMNX,BNDMXX
|
849 |
|
850 |
INTEGER NEND,NOUT,ITSTP,NX
|
851 |
COMMON /INPTI/ NEND,NOUT,ITSTP,NX
|
852 |
|
853 |
DOUBLEPRECISION X(-4:MN5),XL(-4:MN5),XR(-4:MN5),DX(-4:MN5)
|
854 |
COMMON /GRD/ X,XL,XR,DX
|
855 |
|
856 |
DOUBLEPRECISION P(-4:MN5),RHO(-4:MN5),VEL(-4:MN5),W(-4:MN5),
|
857 |
& U(-4:MN5),CS(-4:MN5),H(-4:MN5),DPDRH(-4:MN5),
|
858 |
& DPDU(-4:MN5),R(-4:MN5),M(-4:MN5),E(-4:MN5)
|
859 |
COMMON /HYDRO/ P,RHO,VEL,W,U,CS,H,DPDRH,DPDU,R,M,E
|
860 |
|
861 |
DOUBLEPRECISION TIME,DT
|
862 |
COMMON /ZEIT/ TIME,DT
|
863 |
|
864 |
C ---------
|
865 |
C INTERNAL VARIABLES
|
866 |
C ---------
|
867 |
|
868 |
INTEGER I
|
869 |
|
870 |
C ------------
|
871 |
C LEFT BOUNDARY
|
872 |
C ------------
|
873 |
|
874 |
GOTO (410, 420, 430, 440, 450), BNDMNX
|
875 |
|
876 |
C -----------------
|
877 |
C REFLECTING BOUNDARY
|
878 |
C -----------------
|
879 |
|
880 |
410 CONTINUE
|
881 |
|
882 |
DO 415 I=-4,0
|
883 |
|
884 |
RHO(I) = RHO(1-I)
|
885 |
VEL(I) = -VEL(1-I)
|
886 |
U(I) = U(1-I)
|
887 |
P(I) = P(1-I)
|
888 |
CS(I) = CS(1-I)
|
889 |
H(I) = H(1-I)
|
890 |
W(I) = W(1-I)
|
891 |
DX(I) = DX(1-I)
|
892 |
|
893 |
415 CONTINUE
|
894 |
|
895 |
GOTO 500
|
896 |
|
897 |
C ---------------
|
898 |
C FLOW OUT BOUNDARY
|
899 |
C ---------------
|
900 |
|
901 |
420 CONTINUE
|
902 |
|
903 |
DO 425 I=-4,0
|
904 |
|
905 |
RHO(I) = RHO(1)
|
906 |
VEL(I) = VEL(1)
|
907 |
U(I) = U(1)
|
908 |
P(I) = P(1)
|
909 |
CS(I) = CS(1)
|
910 |
H(I) = H(1)
|
911 |
W(I) = W(1)
|
912 |
DX(I) = DX(1)
|
913 |
|
914 |
425 CONTINUE
|
915 |
|
916 |
GOTO 500
|
917 |
|
918 |
C ---------------
|
919 |
C FLOW IN BOUNDARY
|
920 |
C ---------------
|
921 |
|
922 |
430 CONTINUE
|
923 |
|
924 |
STOP 'BNDRY: INFLOW BOUNDARY MUST BE SUPPLIED BY THE USER'
|
925 |
|
926 |
GOTO 500
|
927 |
|
928 |
C --------------
|
929 |
C PERIODIC BOUNDARY
|
930 |
C --------------
|
931 |
|
932 |
440 CONTINUE
|
933 |
|
934 |
DO 445 I=-4,0
|
935 |
|
936 |
RHO(I) = RHO(NX+I)
|
937 |
VEL(I) = VEL(NX+I)
|
938 |
U(I) = U(NX+I)
|
939 |
P(I) = P(NX+I)
|
940 |
CS(I) = CS(NX+I)
|
941 |
H(I) = H(NX+I)
|
942 |
W(I) = W(NX+I)
|
943 |
DX(I) = DX(NX+I)
|
944 |
|
945 |
445 CONTINUE
|
946 |
|
947 |
GOTO 500
|
948 |
|
949 |
C ---------------------------------------------------------
|
950 |
C SPECIAL BOUNDARY (ADD ANY NONSTANDARD BOUNDARY CONDITION HERE)
|
951 |
C INFLOW JET BOUNDARY
|
952 |
C ---------------------------------------------------------
|
953 |
|
954 |
450 CONTINUE
|
955 |
|
956 |
STOP 'BNDRY: NON STANDARD BOUNDARY. TO BE SUPPLIED BY THE USER'
|
957 |
|
958 |
500 CONTINUE
|
959 |
|
960 |
DO 505 I=0,-4,-1
|
961 |
|
962 |
XL(I) = XL(I+1)-DX(I)
|
963 |
XR(I) = XR(I+1)-DX(I+1)
|
964 |
X(I) = 0.5*(XL(I)+XR(I))
|
965 |
|
966 |
505 CONTINUE
|
967 |
|
968 |
C ------------
|
969 |
C RIGHT BOUNDARY
|
970 |
C ------------
|
971 |
|
972 |
GOTO (510, 520, 530, 540, 550), BNDMXX
|
973 |
|
974 |
C -----------------
|
975 |
C REFLECTING BOUNDARY
|
976 |
C -----------------
|
977 |
|
978 |
510 CONTINUE
|
979 |
|
980 |
DO 515 I=1,5
|
981 |
|
982 |
RHO(NX+I) = RHO(NX+1-I)
|
983 |
VEL(NX+I) = -VEL(NX+1-I)
|
984 |
U(NX+I) = U(NX+1-I)
|
985 |
P(NX+I) = P(NX+1-I)
|
986 |
CS(NX+I) = CS(NX+1-I)
|
987 |
H(NX+I) = H(NX+1-I)
|
988 |
W(NX+I) = W(NX+1-I)
|
989 |
DX(NX+I) = DX(NX+1-I)
|
990 |
|
991 |
515 CONTINUE
|
992 |
|
993 |
GOTO 600
|
994 |
|
995 |
C --------------
|
996 |
C FLOW OUT BOUNDARY
|
997 |
C --------------
|
998 |
|
999 |
520 CONTINUE
|
1000 |
|
1001 |
DO 525 I=NX+1,NX+5
|
1002 |
|
1003 |
RHO(I) = RHO(NX)
|
1004 |
VEL(I) = VEL(NX)
|
1005 |
U(I) = U(NX)
|
1006 |
P(I) = P(NX)
|
1007 |
CS(I) = CS(NX)
|
1008 |
H(I) = H(NX)
|
1009 |
W(I) = W(NX)
|
1010 |
DX(I) = DX(NX)
|
1011 |
|
1012 |
525 CONTINUE
|
1013 |
|
1014 |
GOTO 600
|
1015 |
|
1016 |
C --------------
|
1017 |
C FLOW IN BOUNDARY
|
1018 |
C --------------
|
1019 |
|
1020 |
530 CONTINUE
|
1021 |
|
1022 |
STOP 'BNDRY: INFLOW BOUNDARY MUST BE SUPPLIED BY THE USER'
|
1023 |
|
1024 |
GOTO 600
|
1025 |
|
1026 |
C ---------------
|
1027 |
C PERIODIC BOUNDARY
|
1028 |
C ---------------
|
1029 |
|
1030 |
540 CONTINUE
|
1031 |
|
1032 |
DO 545 I=1,5
|
1033 |
|
1034 |
RHO(NX+I) = RHO(I)
|
1035 |
VEL(NX+I) = VEL(I)
|
1036 |
U(NX+I) = U(I)
|
1037 |
P(NX+I) = P(I)
|
1038 |
CS(NX+I) = CS(I)
|
1039 |
H(NX+I) = H(I)
|
1040 |
W(NX+I) = W(I)
|
1041 |
DX(NX+I) = DX(I)
|
1042 |
|
1043 |
545 CONTINUE
|
1044 |
|
1045 |
GOTO 600
|
1046 |
|
1047 |
C ---------------------------------------
|
1048 |
C SPECIAL BOUNDARY
|
1049 |
C ADD ANY NONSTANDARD BOUNDARY CONDITION HERE
|
1050 |
C ---------------------------------------
|
1051 |
|
1052 |
550 CONTINUE
|
1053 |
|
1054 |
DO 555 I=NX+1,NX+5
|
1055 |
|
1056 |
DX(I) = DX(NX)
|
1057 |
XL(I) = XL(I-1) + DX(I-1)
|
1058 |
XR(I) = XR(I-1) + DX(I)
|
1059 |
X(I) = 0.5*(XL(I)+XR(I))
|
1060 |
RHO(I) = 1.D0+DABS(VEL(NX))*TIME/X(I)
|
1061 |
VEL(I) = VEL(NX)
|
1062 |
U(I) = U(NX)
|
1063 |
P(I) = P(NX)
|
1064 |
CS(I) = CS(NX)
|
1065 |
H(I) = H(NX)
|
1066 |
W(I) = W(NX)
|
1067 |
|
1068 |
555 CONTINUE
|
1069 |
|
1070 |
600 CONTINUE
|
1071 |
|
1072 |
DO 650 I=NX+1,NX+5
|
1073 |
|
1074 |
XL(I) = XL(I-1) + DX(I-1)
|
1075 |
XR(I) = XR(I-1) + DX(I)
|
1076 |
X(I) = 0.5*(XL(I)+XR(I))
|
1077 |
|
1078 |
650 CONTINUE
|
1079 |
|
1080 |
RETURN
|
1081 |
END
|
1082 |
|
1083 |
C --------
|
1084 |
CN NAME: H Y D R O W
|
1085 |
C --------
|
1086 |
|
1087 |
CP PURPOSE:
|
1088 |
CP ADVANCE IN TIME THE 1D EQUATIONS OF RELATIVISTIC HYDRODYNAMICS
|
1089 |
CP (IN CONSERVATION FORM) IN PLANAR COORDINATES.
|
1090 |
C
|
1091 |
|
1092 |
CC COMMENTS:
|
1093 |
CC NONE
|
1094 |
|
1095 |
SUBROUTINE HYDROW
|
1096 |
|
1097 |
IMPLICIT NONE
|
1098 |
|
1099 |
INCLUDE 'size'
|
1100 |
|
1101 |
C ---------
|
1102 |
C COMMON BLOCKS
|
1103 |
C ---------
|
1104 |
|
1105 |
INTEGER NEND,NOUT,ITSTP,NX
|
1106 |
COMMON /INPTI/ NEND,NOUT,ITSTP,NX
|
1107 |
|
1108 |
DOUBLEPRECISION COEFF1(-4:MN5),COEFF2(-4:MN5),COEFF3(-4:MN5),
|
1109 |
& COEFF4(-4:MN5),COEFF5(-4:MN5)
|
1110 |
COMMON /COEFF/ COEFF1,COEFF2,COEFF3,COEFF4,COEFF5
|
1111 |
|
1112 |
DOUBLEPRECISION DELP(-4:MN5),DELRHO(-4:MN5),DELVEL(-4:MN5),
|
1113 |
& DELU(-4:MN5)
|
1114 |
COMMON /DELU/ DELP,DELRHO,DELVEL,DELU
|
1115 |
|
1116 |
DOUBLEPRECISION FICT(-4:MN5)
|
1117 |
COMMON /FICT/ FICT
|
1118 |
|
1119 |
DOUBLEPRECISION FLATN(-4:MN5),FLATN1(-4:MN5)
|
1120 |
COMMON /FLAT/ FLATN,FLATN1
|
1121 |
|
1122 |
DOUBLEPRECISION GAMMA
|
1123 |
COMMON /ADIND/ GAMMA
|
1124 |
|
1125 |
DOUBLEPRECISION X(-4:MN5),XL(-4:MN5),XR(-4:MN5),DX(-4:MN5)
|
1126 |
COMMON /GRD/ X,XL,XR,DX
|
1127 |
|
1128 |
DOUBLEPRECISION P(-4:MN5),RHO(-4:MN5),VEL(-4:MN5),
|
1129 |
& W(-4:MN5),U(-4:MN5),CS(-4:MN5),H(-4:MN5),
|
1130 |
& DPDRH(-4:MN5),DPDU(-4:MN5),R(-4:MN5),M(-4:MN5),
|
1131 |
& E(-4:MN5)
|
1132 |
COMMON /HYDRO/ P,RHO,VEL,W,U,CS,H,DPDRH,DPDU,R,M,E
|
1133 |
|
1134 |
DOUBLEPRECISION TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,
|
1135 |
& SMALLU,GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
1136 |
COMMON /INPTF/ TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,
|
1137 |
& SMALLU,GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
1138 |
|
1139 |
DOUBLEPRECISION PL(-4:MN6),PR(-4:MN6),RHOL(-4:MN6),RHOR(-4:MN6),
|
1140 |
& VELL(-4:MN6),VELR(-4:MN6),
|
1141 |
& UL(-4:MN6),UR(-4:MN6),CSL(-4:MN6),
|
1142 |
& CSR(-4:MN6),RL(-4:MN6),RR(-4:MN6),ML(-4:MN6),
|
1143 |
& MR(-4:MN6),EL(-4:MN6),
|
1144 |
& ER(-4:MN6)
|
1145 |
COMMON /INTERF/ PL,PR,RHOL,RHOR,VELL,VELR,UL,UR,CSL,
|
1146 |
& CSR,RL,RR,ML,MR,EL,ER
|
1147 |
|
1148 |
DOUBLEPRECISION TIME,DT
|
1149 |
COMMON /ZEIT/ TIME,DT
|
1150 |
|
1151 |
DOUBLEPRECISION DP(-4:MN5),P6(-4:MN5),DRHO(-4:MN5),RHO6(-4:MN5),
|
1152 |
& DVEL(-4:MN5),VEL6(-4:MN5),
|
1153 |
& DU(-4:MN5),U6(-4:MN5)
|
1154 |
COMMON /U6/ DP,P6,DRHO,RHO6,DVEL,VEL6,DU,U6
|
1155 |
|
1156 |
DOUBLEPRECISION PM(-4:MN5),PP(-4:MN5),RHOM(-4:MN5),RHOP(-4:MN5),
|
1157 |
& VELM(-4:MN5),VELP(-4:MN5),
|
1158 |
& UM(-4:MN5),UP(-4:MN5)
|
1159 |
COMMON /UMP/ PM,PP,RHOM,RHOP,VELM,VELP,UM,UP
|
1160 |
|
1161 |
C ------------
|
1162 |
C INTERNAL VARIABLES
|
1163 |
C ------------
|
1164 |
|
1165 |
INTEGER I
|
1166 |
|
1167 |
DOUBLEPRECISION AUX1
|
1168 |
|
1169 |
DOUBLEPRECISION DTDX(-4:MN5)
|
1170 |
|
1171 |
DOUBLEPRECISION RFLX(-4:MN6),MFLX(-4:MN6),EFLX(-4:MN6)
|
1172 |
|
1173 |
C -------------
|
1174 |
C SPATIAL RECONSTRUCTION (PPM)
|
1175 |
C -------------
|
1176 |
|
1177 |
CALL COEF(NX,COEFF1,COEFF2,COEFF3,COEFF4,COEFF5)
|
1178 |
|
1179 |
CALL INTERP(NX,PM,P,PP,DELP)
|
1180 |
|
1181 |
CALL INTERP(NX,RHOM,RHO,RHOP,DELRHO)
|
1182 |
|
1183 |
CALL DETECT(NX,RHOM,RHO,RHOP,DELRHO)
|
1184 |
|
1185 |
CALL INTERP(NX,VELM,VEL,VELP,DELVEL)
|
1186 |
|
1187 |
CALL FLATEN
|
1188 |
|
1189 |
|
1190 |
DO 17 I=0,NX+1
|
1191 |
RHOM(I) = FLATN(I)*RHO(I) + FLATN1(I)*RHOM(I)
|
1192 |
RHOP(I) = FLATN(I)*RHO(I) + FLATN1(I)*RHOP(I)
|
1193 |
VELM(I) = FLATN(I)*VEL(I) + FLATN1(I)*VELM(I)
|
1194 |
VELP(I) = FLATN(I)*VEL(I) + FLATN1(I)*VELP(I)
|
1195 |
PM(I) = FLATN(I)*P(I) + FLATN1(I)*PM(I)
|
1196 |
PP(I) = FLATN(I)*P(I) + FLATN1(I)*PP(I)
|
1197 |
17 CONTINUE
|
1198 |
|
1199 |
CALL MONOT(NX,PM,P,PP,DP,P6)
|
1200 |
|
1201 |
CALL MONOT(NX,RHOM,RHO,RHOP,DRHO,RHO6)
|
1202 |
|
1203 |
CALL MONOT(NX,VELM,VEL,VELP,DVEL,VEL6)
|
1204 |
|
1205 |
C -------------------
|
1206 |
C AVERAGED STATES FOR TIME ADVANCE
|
1207 |
C -------------------
|
1208 |
|
1209 |
CALL STAT1D
|
1210 |
|
1211 |
C ----------------
|
1212 |
C COMPUTATION OF NUMERICAL FLUXES (WITH AN EXACT RIEMANN SOLVER)
|
1213 |
C ----------------
|
1214 |
|
1215 |
DO 23 I=1,NX+1
|
1216 |
|
1217 |
CALL NFLUX(RHOL(I),RHOR(I),PL(I),PR(I),VELL(I),VELR(I),
|
1218 |
& UL(I),UR(I),CSL(I),CSR(I),RFLX(I),MFLX(I),EFLX(I))
|
1219 |
23 CONTINUE
|
1220 |
|
1221 |
C ----------
|
1222 |
C TIME ADVANCE
|
1223 |
C ----------
|
1224 |
|
1225 |
DO 50 I=1,NX
|
1226 |
DTDX(I) = DT/DX(I)
|
1227 |
R(I) = R(I) - DTDX(I)*(RFLX(I+1) - RFLX(I))
|
1228 |
R(I) = DMAX1(SMLRHO,R(I))
|
1229 |
50 CONTINUE
|
1230 |
|
1231 |
DO 60 I=1,NX
|
1232 |
AUX1 = -DTDX(I)*(MFLX(I+1) - MFLX(I))
|
1233 |
M(I) = M(I) + AUX1 + DT*FICT(I)
|
1234 |
AUX1 = -DTDX(I)*(EFLX(I+1) - EFLX(I))
|
1235 |
E(I) = E(I) + AUX1
|
1236 |
60 CONTINUE
|
1237 |
|
1238 |
C --------------
|
1239 |
C PRIMITIVE VARIABLES
|
1240 |
C --------------
|
1241 |
|
1242 |
CALL GETPRFQ(NX,R,M,E,VEL,W,RHO,U,P,H,CS,DPDRH,DPDU)
|
1243 |
|
1244 |
RETURN
|
1245 |
END
|
1246 |
|
1247 |
C --------
|
1248 |
CN NAME: P L T O U T
|
1249 |
C --------
|
1250 |
|
1251 |
CP PURPOSE:
|
1252 |
CP COMPUTES THE ANALYTICAL SOLUTION OF STANDARD 1D PROBLEMS AND WRITES
|
1253 |
CP THE RESULTS IN THE OUTPUT FILES
|
1254 |
C
|
1255 |
|
1256 |
CC COMMENTS:
|
1257 |
CC NONE
|
1258 |
|
1259 |
SUBROUTINE PLTOUT
|
1260 |
|
1261 |
IMPLICIT NONE
|
1262 |
|
1263 |
INCLUDE 'size'
|
1264 |
|
1265 |
C -----------
|
1266 |
C COMMON BLOCKS
|
1267 |
C -----------
|
1268 |
|
1269 |
INTEGER NSTEP
|
1270 |
COMMON /NSTEP/ NSTEP
|
1271 |
|
1272 |
INTEGER NOUT1
|
1273 |
COMMON /OUTI/ NOUT1
|
1274 |
|
1275 |
INTEGER NEND,NOUT,ITSTP,NX
|
1276 |
COMMON /INPTI/ NEND,NOUT,ITSTP,NX
|
1277 |
|
1278 |
DOUBLEPRECISION P(-4:MN5),RHO(-4:MN5),VEL(-4:MN5),W(-4:MN5),
|
1279 |
& U(-4:MN5),CS(-4:MN5),H(-4:MN5),DPDRH(-4:MN5),
|
1280 |
& DPDU(-4:MN5),R(-4:MN5),M(-4:MN5),E(-4:MN5)
|
1281 |
COMMON /HYDRO/ P,RHO,VEL,W,U,CS,H,DPDRH,DPDU,R,M,E
|
1282 |
|
1283 |
DOUBLEPRECISION X(-4:MN5),XL(-4:MN5),XR(-4:MN5),DX(-4:MN5)
|
1284 |
COMMON /GRD/ X,XL,XR,DX
|
1285 |
|
1286 |
DOUBLEPRECISION TOUT1
|
1287 |
COMMON /OUTF/ TOUT1
|
1288 |
|
1289 |
DOUBLEPRECISION TIME,DT
|
1290 |
COMMON /ZEIT/ TIME,DT
|
1291 |
|
1292 |
DOUBLEPRECISION G
|
1293 |
COMMON /ADIND/ G
|
1294 |
|
1295 |
CHARACTER*7 OUTFIL
|
1296 |
CHARACTER*8 LABEL
|
1297 |
CHARACTER*4 BASENM
|
1298 |
CHARACTER*2 SUFFIX
|
1299 |
COMMON /CHRC/ LABEL,OUTFIL,BASENM,SUFFIX
|
1300 |
|
1301 |
C ------------
|
1302 |
C INTERNAL VARIABLES
|
1303 |
C ------------
|
1304 |
|
1305 |
INTEGER I
|
1306 |
|
1307 |
DOUBLEPRECISION P1,RHO1,VEL1,U1,CS1
|
1308 |
|
1309 |
DOUBLEPRECISION OCS2,CS2,FCS2,DFDCS2,CS9
|
1310 |
|
1311 |
DOUBLEPRECISION P2,RHO2,VEL2,U2
|
1312 |
|
1313 |
DOUBLEPRECISION P3,RHO3,VEL3,U3,CS3
|
1314 |
|
1315 |
DOUBLEPRECISION P4,RHO4,VEL4,U4,CS4
|
1316 |
|
1317 |
DOUBLEPRECISION P5,RHO5,VEL5,U5,CS5
|
1318 |
|
1319 |
DOUBLEPRECISION P6,RHO6,VEL6,U6,CS6
|
1320 |
|
1321 |
DOUBLEPRECISION P7,RHO7,VEL7,U7,CS7
|
1322 |
|
1323 |
DOUBLEPRECISION P8,RHO8,VEL8,U8,CS8
|
1324 |
|
1325 |
DOUBLEPRECISION P10,RHO10,VEL10,U10,CS10
|
1326 |
|
1327 |
DOUBLEPRECISION X1,X2,X3,X4,X5,X6,X7,X8,X9
|
1328 |
|
1329 |
DOUBLEPRECISION A,B,C,D,K,L
|
1330 |
|
1331 |
DOUBLEPRECISION PA(MN),RHOA(MN),VELA(MN),UA(MN)
|
1332 |
|
1333 |
DOUBLEPRECISION WW,VS,XS
|
1334 |
|
1335 |
C ----------------------
|
1336 |
C ANALYTICAL SOLUTION FOR STANDARD TESTS
|
1337 |
C ----------------------
|
1338 |
|
1339 |
IF (BASENM.EQ.'RSR_') THEN
|
1340 |
|
1341 |
WW = 1.D0/SQRT(1.D0 - VEL(1)*VEL(1))
|
1342 |
U1 = 0.D0
|
1343 |
U2 = WW - 1.D0
|
1344 |
RHO1 = 1.D0
|
1345 |
RHO2 = ((G + 1.D0)/(G - 1.D0) + G*U2/(G - 1.D0))*RHO1
|
1346 |
VEL1 = VEL(1)
|
1347 |
VEL2 = 0.D0
|
1348 |
P1 = (G - 1.D0)*RHO1*U1
|
1349 |
P2 = (G - 1.D0)*RHO2*U2
|
1350 |
VS = -VEL1/(RHO2/RHO1/WW - 1.D0)
|
1351 |
XS = XR(NX) + VS*TIME
|
1352 |
|
1353 |
DO 30 I = 1,NX
|
1354 |
|
1355 |
IF (X(I).LT.XS) THEN
|
1356 |
UA(I) = U1
|
1357 |
RHOA(I) = RHO1
|
1358 |
VELA(I) = VEL1
|
1359 |
PA(I) = P1
|
1360 |
ELSE
|
1361 |
UA(I) = U2
|
1362 |
RHOA(I) = RHO2
|
1363 |
VELA(I) = VEL2
|
1364 |
PA(I) = P2
|
1365 |
END IF
|
1366 |
|
1367 |
30 CONTINUE
|
1368 |
|
1369 |
END IF
|
1370 |
|
1371 |
IF (BASENM.EQ.'RST_') THEN
|
1372 |
|
1373 |
P1 = 1.D0
|
1374 |
RHO1 = 1.D0
|
1375 |
VEL1 = 0.D0
|
1376 |
U1 = P1/(G - 1.D0)/RHO1
|
1377 |
CS1 = DSQRT(G*P1*(G - 1.D0)/(RHO1*(G - 1.D0) + G*P1))
|
1378 |
|
1379 |
P3 = 0.3115D0
|
1380 |
RHO3 = 0.4345D0
|
1381 |
VEL3 = 0.4262D0
|
1382 |
U3 = P3/(G - 1.D0)/RHO3
|
1383 |
CS3 = DSQRT(G*P3*(G - 1.D0)/(RHO3*(G - 1.D0) + G*P3))
|
1384 |
|
1385 |
P4 = P3
|
1386 |
RHO4 = 0.273D0
|
1387 |
VEL4 = VEL3
|
1388 |
U4 = P4/(G - 1.D0)/RHO4
|
1389 |
CS4 = DSQRT(G*P4*(G - 1.D0)/(RHO4*(G - 1.D0) + G*P4))
|
1390 |
|
1391 |
P5 = 0.1D0
|
1392 |
RHO5 = 0.125D0
|
1393 |
VEL5 = 0.D0
|
1394 |
U5 = P5/(G - 1.D0)/RHO5
|
1395 |
CS5 = DSQRT(G*P5*(G - 1.D0)/(RHO5*(G - 1.D0) + G*P5))
|
1396 |
|
1397 |
X1 = 0.5D0 + (VEL1 - CS1)*TIME/(1.D0 - VEL1*CS1)
|
1398 |
|
1399 |
X2 = 0.5D0 + (VEL3 - CS3)*TIME/(1.D0 - VEL3*CS3)
|
1400 |
|
1401 |
X3 = 0.5D0 + VEL3*TIME
|
1402 |
|
1403 |
X4 = 0.5D0 + VEL4*TIME/(1.D0 - RHO5*DSQRT(1.D0 - VEL4**2)/RHO4)
|
1404 |
|
1405 |
ELSE IF(BASENM.EQ.'RBW_') THEN
|
1406 |
|
1407 |
P1 = 1000.D0
|
1408 |
RHO1 = 1.D0
|
1409 |
VEL1 = 0.D0
|
1410 |
U1 = P1/(G-1.D0)/RHO1
|
1411 |
CS1 = DSQRT(G*P1*(G - 1.D0)/(RHO1*(G - 1.D0) + G*P1))
|
1412 |
|
1413 |
P3 = 18.6D0
|
1414 |
RHO3 = 9.15D-2
|
1415 |
VEL3 = 0.960D0
|
1416 |
U3 = P3/(G-1.D0)/RHO3
|
1417 |
CS3 = DSQRT(G*P3*(G - 1.D0)/(RHO3*(G - 1.D0) + G*P3))
|
1418 |
|
1419 |
P4 = P3
|
1420 |
RHO4 = 10.75D0
|
1421 |
VEL4 = VEL3
|
1422 |
U4 = P4/(G - 1.D0)/RHO4
|
1423 |
CS4 = DSQRT(G*P4*(G - 1.D0)/(RHO4*(G - 1.D0) + G*P4))
|
1424 |
|
1425 |
P5 = 1.D-2
|
1426 |
RHO5 = 1.D0
|
1427 |
VEL5 = 0.D0
|
1428 |
U5 = P5/(G - 1.D0)/RHO5
|
1429 |
CS5 = DSQRT(G*P5*(G - 1.D0)/(RHO5*(G - 1.D0) + G*P5))
|
1430 |
|
1431 |
X1 = 0.5D0 + (VEL1 - CS1)*TIME/(1.D0 - VEL1*CS1)
|
1432 |
|
1433 |
X2 = 0.5D0 + (VEL3 - CS3)*TIME/(1.D0 - VEL3*CS3)
|
1434 |
|
1435 |
X3 = 0.5D0 + VEL3*TIME
|
1436 |
|
1437 |
X4 = 0.5D0 + VEL4*TIME/(1.D0 - RHO5*DSQRT(1.D0 - VEL4**2)/RHO4)
|
1438 |
|
1439 |
ELSE IF(BASENM.EQ.'SCHN') THEN
|
1440 |
|
1441 |
P1 = 13.33333333D0
|
1442 |
RHO1 = 10.D0
|
1443 |
VEL1 = 0.D0
|
1444 |
U1 = P1/(G - 1.D0)/RHO1
|
1445 |
CS1 = DSQRT(G*P1*(G - 1.D0)/(RHO1*(G - 1.D0) + G*P1))
|
1446 |
|
1447 |
P3 = 1.448D0
|
1448 |
RHO3 = 2.639D0
|
1449 |
VEL3 = 0.714D0
|
1450 |
U3 = P3/(G - 1.D0)/RHO3
|
1451 |
CS3 = DSQRT(G*P3*(G - 1.D0)/(RHO3*(G - 1.D0) + G*P3))
|
1452 |
|
1453 |
P4 = P3
|
1454 |
RHO4 = 5.071D0
|
1455 |
VEL4 = VEL3
|
1456 |
U4 = P4/(G - 1.D0)/RHO4
|
1457 |
CS4 = DSQRT(G*P4*(G - 1.D0)/(RHO4*(G - 1.D0)+G*P4))
|
1458 |
|
1459 |
P5 = 0.666666666666D-6
|
1460 |
RHO5 = 1.D0
|
1461 |
VEL5 = 0.D0
|
1462 |
U5 = P5/(G - 1.D0)/RHO5
|
1463 |
CS5 = DSQRT(G*P5*(G - 1.D0)/(RHO5*(G - 1.D0) + G*P5))
|
1464 |
|
1465 |
X1 = 0.5D0 + (VEL1 - CS1)*TIME/(1.D0 - VEL1*CS1)
|
1466 |
|
1467 |
X2 = 0.5D0 + (VEL3 - CS3)*TIME/(1.D0 - VEL3*CS3)
|
1468 |
|
1469 |
X3 = 0.5D0 + VEL3*TIME
|
1470 |
|
1471 |
X4 = 0.5D0 + VEL4*TIME/(1.D0 - RHO5*DSQRT(1.D0 - VEL4**2)/RHO4)
|
1472 |
|
1473 |
ELSE IF (BASENM.EQ.'RBWI') THEN
|
1474 |
|
1475 |
U1 = 2.5D3
|
1476 |
RHO1 = 1.D0
|
1477 |
VEL1 = 0.D0
|
1478 |
P1 = (G - 1.D0)*U1*RHO1
|
1479 |
CS1 = DSQRT(G*P1*(G - 1.D0)/(RHO1*(G - 1.D0) + G*P1))
|
1480 |
|
1481 |
RHO3 = 0.0491D0
|
1482 |
VEL3 = 0.957D0
|
1483 |
P3 = 14.71D0
|
1484 |
U3 = P3/(G - 1.D0)/RHO3
|
1485 |
CS3 = DSQRT(G*P3*(G - 1.D0)/(RHO3*(G - 1.D0) + G*P3))
|
1486 |
|
1487 |
RHO4 = 14.39D0
|
1488 |
VEL4 = VEL3
|
1489 |
P4 = P3
|
1490 |
U4 = P4/(G - 1.D0)/RHO4
|
1491 |
CS4 = DSQRT(G*P4*(G - 1.D0)/(RHO4*(G - 1.D0) + G*P4))
|
1492 |
|
1493 |
IF (TIME.LT.0.4200) THEN
|
1494 |
|
1495 |
U5 = 2.5D-2
|
1496 |
RHO5 = 1.D0
|
1497 |
VEL5 = 0.D0
|
1498 |
P5 = (G - 1.D0)*RHO5*U5
|
1499 |
CS5 = DSQRT(G*P5*(G - 1.D0)/(RHO5*(G - 1.D0) + G*P5))
|
1500 |
|
1501 |
U6 = U5
|
1502 |
RHO6 = RHO5
|
1503 |
VEL6 = VEL5
|
1504 |
P6 = P5
|
1505 |
CS6 = CS5
|
1506 |
|
1507 |
ELSE
|
1508 |
|
1509 |
RHO5 = 104.41D0
|
1510 |
VEL5 = 0.456D0
|
1511 |
P5 = 369.84D0
|
1512 |
U5 = P5/(G - 1.D0)/RHO5
|
1513 |
CS5 = DSQRT(G*P5*(G - 1.D0)/(RHO5*(G - 1.D0) + G*P5))
|
1514 |
|
1515 |
RHO6 = 117.25D0
|
1516 |
VEL6 = VEL5
|
1517 |
P6 = P5
|
1518 |
U6 = P6/(G - 1.D0)/RHO6
|
1519 |
CS6 = DSQRT(G*P6*(G - 1.D0)/(RHO6*(G - 1.D0) + G*P6))
|
1520 |
|
1521 |
END IF
|
1522 |
|
1523 |
RHO7 = 9.72D0
|
1524 |
VEL7 = -0.882D0
|
1525 |
P7 = 4.639D0
|
1526 |
U7 = P7/(G - 1.D0)/RHO7
|
1527 |
CS7 = DSQRT(G*P7*(G - 1.D0)/(RHO7*(G - 1.D0) + G*P7))
|
1528 |
|
1529 |
RHO8 = 0.112D0
|
1530 |
VEL8 = VEL7
|
1531 |
P8 = P7
|
1532 |
U8 = P8/(G - 1.D0)/RHO8
|
1533 |
CS8 = DSQRT(G*P8*(G - 1.D0)/(RHO8*(G - 1.D0) + G*P8))
|
1534 |
|
1535 |
U10 = 2.5D2
|
1536 |
RHO10= 1.D0
|
1537 |
VEL10= 0.D0
|
1538 |
P10 = (G - 1.D0)*U10*RHO10
|
1539 |
CS10 = DSQRT(G*P10*(G - 1.D0)/(RHO10*(G - 1.D0) + G*P10))
|
1540 |
|
1541 |
X1 = 0.1D0 - TIME*CS1
|
1542 |
|
1543 |
X2 = 0.1D0 + TIME*(VEL3 - CS3)/(1.D0 - VEL3*CS3)
|
1544 |
|
1545 |
X3 = 0.1D0 + TIME*VEL3
|
1546 |
|
1547 |
IF (TIME.LT.0.4200D0) THEN
|
1548 |
X4 = 0.1D0 + TIME*0.9776D0
|
1549 |
|
1550 |
X5 = 0.9D0 - TIME*0.9274D0
|
1551 |
|
1552 |
X6 = X5
|
1553 |
ELSE
|
1554 |
X4 = 0.5106D0 + (TIME - 0.4200D0)*0.088D0
|
1555 |
|
1556 |
X5 = 0.5106D0 + (TIME - 0.4200D0)*VEL5
|
1557 |
|
1558 |
X6 = 0.5106D0 + (TIME - 0.4200D0)*0.703D0
|
1559 |
END IF
|
1560 |
|
1561 |
X7 = 0.9D0 + TIME*VEL7
|
1562 |
|
1563 |
X8 = 0.9D0 + TIME*(VEL8 + CS8)/(1.D0 + VEL8*CS8)
|
1564 |
|
1565 |
X9 = 0.9D0 + TIME*CS10
|
1566 |
|
1567 |
END IF
|
1568 |
|
1569 |
IF (BASENM.EQ.'RST_'.OR.BASENM.EQ.'RBW_'.OR.
|
1570 |
& BASENM.EQ.'SCHN') THEN
|
1571 |
|
1572 |
DO 70 I=1,NX
|
1573 |
|
1574 |
IF (X(I).LT.X1) THEN
|
1575 |
|
1576 |
PA(I) = P1
|
1577 |
RHOA(I) = RHO1
|
1578 |
VELA(I) = VEL1
|
1579 |
UA(I) = U1
|
1580 |
|
1581 |
ELSE IF (X(I).LT.X2) THEN
|
1582 |
|
1583 |
A = (X(I) - 0.5D0)/TIME
|
1584 |
B = DSQRT(G - 1.D0)
|
1585 |
C = (B + CS1)/(B - CS1)
|
1586 |
D = -B/2.D0
|
1587 |
K = (1.D0 + A)/(1.D0 - A)
|
1588 |
L = C*K**D
|
1589 |
OCS2 = CS1
|
1590 |
50 FCS2 = L*(1.D0 + OCS2)**D*(OCS2 - B) +
|
1591 |
& (1.D0 - OCS2)**D*(OCS2+B)
|
1592 |
DFDCS2 = L*(1.D0 + OCS2)**D*(1.D0 + D*(OCS2 - B)/
|
1593 |
& (1.D0 + OCS2)) +
|
1594 |
& (1.D0 - OCS2)**D*(1.D0 - D*(OCS2 + B)/
|
1595 |
& (1.D0 - OCS2))
|
1596 |
CS2 = OCS2 - FCS2/DFDCS2
|
1597 |
|
1598 |
IF (DABS(CS2 - OCS2)/OCS2.GT.5.D-10) THEN
|
1599 |
OCS2 = CS2
|
1600 |
GOTO 50
|
1601 |
END IF
|
1602 |
|
1603 |
VELA(I) = (A + CS2)/(1.D0 + A*CS2)
|
1604 |
RHOA(I) = RHO1*((CS2**2*(G - 1.D0 - CS1**2))/
|
1605 |
& (CS1**2*(G - 1.D0 - CS2**2.)))**(1.D0/(G - 1.D0))
|
1606 |
PA(I) = CS2**2*(G - 1.D0)*RHOA(I)/(G - 1.D0 - CS2**2)/G
|
1607 |
UA(I) = PA(I)/(G - 1.D0)/RHOA(I)
|
1608 |
|
1609 |
ELSE IF (X(I).LT.X3) THEN
|
1610 |
|
1611 |
PA(I) = P3
|
1612 |
RHOA(I) = RHO3
|
1613 |
VELA(I) = VEL3
|
1614 |
UA(I) = U3
|
1615 |
|
1616 |
ELSE IF (X(I).LT.X4) THEN
|
1617 |
|
1618 |
PA(I) = P4
|
1619 |
RHOA(I) = RHO4
|
1620 |
VELA(I) = VEL4
|
1621 |
UA(I) = U4
|
1622 |
|
1623 |
ELSE
|
1624 |
|
1625 |
PA(I) = P5
|
1626 |
RHOA(I) = RHO5
|
1627 |
VELA(I) = VEL5
|
1628 |
UA(I) = U5
|
1629 |
END IF
|
1630 |
|
1631 |
70 CONTINUE
|
1632 |
|
1633 |
END IF
|
1634 |
|
1635 |
IF (BASENM.EQ.'RBWI') THEN
|
1636 |
|
1637 |
DO 80 I=1,NX
|
1638 |
|
1639 |
IF (X(I).LT.X1) THEN
|
1640 |
|
1641 |
RHOA(I) = RHO1
|
1642 |
VELA(I) = VEL1
|
1643 |
PA(I) = P1
|
1644 |
|
1645 |
ELSE IF (X(I).LT.X2) THEN
|
1646 |
|
1647 |
A = (X(I) - 0.1D0)/TIME
|
1648 |
B = DSQRT(G - 1.D0)
|
1649 |
C = (B + CS1)/(B - CS1)
|
1650 |
D = -B/2.D0
|
1651 |
K = (1.D0 + A)/(1.D0 - A)
|
1652 |
L = C*K**D
|
1653 |
OCS2 = CS1
|
1654 |
52 FCS2 = L*(1.D0 + OCS2)**D*(OCS2 - B) +
|
1655 |
& (1.D0 - OCS2)**D*(OCS2 + B)
|
1656 |
DFDCS2 = L*(1.D0 + OCS2)**D*(1.D0 + D*(OCS2 - B)/
|
1657 |
& (1.D0 + OCS2)) +
|
1658 |
& (1.D0 - OCS2)**D*(1.D0 - D*(OCS2 + B)/
|
1659 |
& (1.D0 - OCS2))
|
1660 |
CS2 = OCS2 - FCS2/DFDCS2
|
1661 |
|
1662 |
IF (ABS(CS2-OCS2)/OCS2.GT.5.E-10)THEN
|
1663 |
OCS2 = CS2
|
1664 |
GOTO 52
|
1665 |
END IF
|
1666 |
|
1667 |
VELA(I) = (A+CS2)/(1.D0+A*CS2)
|
1668 |
RHOA(I) = RHO1*((CS2**2.*(G-1.D0-CS1**2))/
|
1669 |
& (CS1**2*(G-1.D0-CS2**2)))**(1.D0/(G-1.D0))
|
1670 |
PA(I) = CS2**2*(G-1.D0)*RHOA(I)/(G-1.D0-CS2**2)/G
|
1671 |
UA(I) = PA(I)/(G-1.D0)/RHOA(I)
|
1672 |
|
1673 |
ELSE IF (X(I).LT.X3) THEN
|
1674 |
|
1675 |
RHOA(I) = RHO3
|
1676 |
VELA(I) = VEL3
|
1677 |
PA(I) = P3
|
1678 |
|
1679 |
ELSE IF (X(I).LT.X4) THEN
|
1680 |
|
1681 |
RHOA(I) = RHO4
|
1682 |
VELA(I) = VEL4
|
1683 |
PA(I) = P4
|
1684 |
|
1685 |
ELSE IF (X(I).LT.X5) THEN
|
1686 |
|
1687 |
RHOA(I) = RHO5
|
1688 |
VELA(I) = VEL5
|
1689 |
PA(I) = P5
|
1690 |
|
1691 |
ELSE IF (X(I).LT.X6) THEN
|
1692 |
|
1693 |
RHOA(I) = RHO6
|
1694 |
VELA(I) = VEL6
|
1695 |
PA(I) = P6
|
1696 |
|
1697 |
ELSE IF (X(I).LT.X7) THEN
|
1698 |
|
1699 |
RHOA(I) = RHO7
|
1700 |
VELA(I) = VEL7
|
1701 |
PA(I) = P7
|
1702 |
|
1703 |
ELSE IF (X(I).LT.X8) THEN
|
1704 |
|
1705 |
RHOA(I) = RHO8
|
1706 |
VELA(I) = VEL8
|
1707 |
PA(I) = P8
|
1708 |
|
1709 |
ELSE IF (X(I).LT.X9) THEN
|
1710 |
|
1711 |
A = (X(I) - 0.9D0)/TIME
|
1712 |
B = SQRT(G - 1.D0)
|
1713 |
C = (B + CS10)/(B - CS10)
|
1714 |
D = B/2.D0
|
1715 |
K = (1.D0 + A)/(1.D0 - A)
|
1716 |
L = C*K**D
|
1717 |
OCS2 = CS10
|
1718 |
54 FCS2 = L*(1.D0 - OCS2)**D*(OCS2 - B) +
|
1719 |
& (1.D0 + OCS2)**D*(OCS2 + B)
|
1720 |
DFDCS2 = L*(1.D0 - OCS2)**D*(1.D0 + D*(OCS2 - B)/
|
1721 |
& (1.D0 - OCS2))+
|
1722 |
& (1.D0 + OCS2)**D*(1.D0 - D*(OCS2 + B)/
|
1723 |
& (1.D0 + OCS2))
|
1724 |
CS9 = OCS2 - FCS2/DFDCS2
|
1725 |
|
1726 |
IF (DABS(CS9-OCS2)/OCS2.GT.5.D-10)THEN
|
1727 |
OCS2 = CS9
|
1728 |
GOTO 54
|
1729 |
END IF
|
1730 |
|
1731 |
VELA(I) = (A - CS9)/(1.D0 - A*CS9)
|
1732 |
RHOA(I) = RHO10*((CS9 **2*(G - 1.D0 - CS10**2))/
|
1733 |
& (CS10**2*(G - 1.D0 - CS9 **2)))**(1.D0/(G - 1.D0))
|
1734 |
PA(I) = CS9**2*(G - 1.D0)*RHOA(I)/(G - 1.D0 - CS9**2)/G
|
1735 |
UA(I) = PA(I)/(G - 1.D0)/RHOA(I)
|
1736 |
|
1737 |
ELSE
|
1738 |
|
1739 |
RHOA(I) = RHO10
|
1740 |
VELA(I) = VEL10
|
1741 |
PA(I) = P10
|
1742 |
|
1743 |
END IF
|
1744 |
|
1745 |
80 CONTINUE
|
1746 |
|
1747 |
END IF
|
1748 |
|
1749 |
C ----
|
1750 |
C OUTPUT
|
1751 |
C ----
|
1752 |
|
1753 |
OPEN(10,FILE='DATA/'//OUTFIL,FORM='FORMATTED',STATUS='NEW')
|
1754 |
WRITE(10,111) NSTEP,TIME
|
1755 |
111 FORMAT('N =', I6, 3X, 'TIME = ', 1PE10.3)
|
1756 |
|
1757 |
DO 85 I=1,NX
|
1758 |
WRITE(10,200) X(I),P(I),PA(I),RHO(I),RHOA(I),
|
1759 |
& VEL(I),VELA(I)
|
1760 |
85 CONTINUE
|
1761 |
|
1762 |
200 FORMAT(F6.4,1X,2(F11.4,1X),2(F9.4,1X),2(F7.5,1X))
|
1763 |
CLOSE(10)
|
1764 |
|
1765 |
NOUT1 = 0
|
1766 |
TOUT1 = 0.D0
|
1767 |
|
1768 |
CALL FILNAM
|
1769 |
|
1770 |
RETURN
|
1771 |
END
|
1772 |
|
1773 |
C --------
|
1774 |
CN NAME: E O S
|
1775 |
C --------
|
1776 |
|
1777 |
CP PURPOSE:
|
1778 |
CP COMPUTES DERIVED THERMODYNAMICAL QUANTITIES
|
1779 |
C
|
1780 |
|
1781 |
CC COMMENTS:
|
1782 |
CC GAMMA-LAW EOS
|
1783 |
|
1784 |
SUBROUTINE EOS(N,RHO,U,G,P,H,CS,DPDRH,DPDU)
|
1785 |
|
1786 |
IMPLICIT NONE
|
1787 |
|
1788 |
INCLUDE 'size'
|
1789 |
|
1790 |
C -------
|
1791 |
C ARGUMENTS
|
1792 |
C -------
|
1793 |
|
1794 |
INTEGER N
|
1795 |
|
1796 |
DOUBLEPRECISION U(-4:MN5),RHO(-4:MN5),P(-4:MN5),H(-4:MN5),
|
1797 |
& CS(-4:MN5),DPDRH(-4:MN5),DPDU(-4:MN5)
|
1798 |
|
1799 |
DOUBLEPRECISION G
|
1800 |
|
1801 |
C -----------
|
1802 |
C INTERNAL VARIABLES
|
1803 |
C -----------
|
1804 |
|
1805 |
INTEGER I
|
1806 |
|
1807 |
DOUBLEPRECISION GAM1
|
1808 |
|
1809 |
DO 10 I=1,N
|
1810 |
GAM1 = G -1.D0
|
1811 |
P(I) = GAM1*RHO(I)*U(I)
|
1812 |
DPDRH(I) = GAM1*U(I)
|
1813 |
DPDU(I) = GAM1*RHO(I)
|
1814 |
H(I) = 1.D0 + U(I) + P(I)/RHO(I)
|
1815 |
CS(I) = DSQRT((DPDRH(I) + P(I)*DPDU(I)/RHO(I)/RHO(I))/H(I))
|
1816 |
10 CONTINUE
|
1817 |
|
1818 |
RETURN
|
1819 |
END
|
1820 |
|
1821 |
C --------
|
1822 |
CN NAME: C O E F
|
1823 |
C --------
|
1824 |
|
1825 |
CP PURPOSE:
|
1826 |
CP COMPUTES THE COEFFICIENTS FOR INTERPOLATED VALUES
|
1827 |
C
|
1828 |
|
1829 |
CC COMMENTS:
|
1830 |
CC COMPUTES DE GRID-DEPENDENT COEFFICIENTS APPEARING IN EQS.59-61 OF MARTI
|
1831 |
CC AND MUELLER (1996), JCP, VOL. 123, 1-14
|
1832 |
|
1833 |
SUBROUTINE COEF(N,COEFF1,COEFF2,COEFF3,COEFF4,COEFF5)
|
1834 |
|
1835 |
IMPLICIT NONE
|
1836 |
|
1837 |
INCLUDE 'size'
|
1838 |
|
1839 |
C --------
|
1840 |
C ARGUMENTS
|
1841 |
C --------
|
1842 |
|
1843 |
INTEGER N
|
1844 |
|
1845 |
DOUBLEPRECISION COEFF1(-4:MN5),COEFF2(-4:MN5),COEFF3(-4:MN5)
|
1846 |
DOUBLEPRECISION COEFF4(-4:MN5),COEFF5(-4:MN5)
|
1847 |
|
1848 |
C ----------
|
1849 |
C COMMON BLOCKS
|
1850 |
C ----------
|
1851 |
|
1852 |
DOUBLEPRECISION X(-4:MN5),XL(-4:MN5),XR(-4:MN5),DX(-4:MN5)
|
1853 |
COMMON /GRD/ X,XL,XR,DX
|
1854 |
|
1855 |
C --------------
|
1856 |
C INTERNAL VARIABLES
|
1857 |
C --------------
|
1858 |
|
1859 |
INTEGER I
|
1860 |
|
1861 |
DOUBLEPRECISION SCRCH1(-4:MN6),SCRCH2(-4:MN6),SCRCH3(-4:MN6),
|
1862 |
& SCRCH4(-4:MN6)
|
1863 |
|
1864 |
|
1865 |
DO 10 I=0,N+2
|
1866 |
|
1867 |
SCRCH1(I) = DX(I) + DX(I-1)
|
1868 |
SCRCH2(I) = SCRCH1(I) + DX(I)
|
1869 |
SCRCH3(I) = SCRCH1(I) + DX(I-1)
|
1870 |
|
1871 |
10 CONTINUE
|
1872 |
|
1873 |
DO 20 I=0,N+1
|
1874 |
|
1875 |
SCRCH4(I) = DX(I)/(SCRCH1(I) + DX(I+1))
|
1876 |
COEFF1(I) = SCRCH4(I)*SCRCH3(I)/SCRCH1(I+1)
|
1877 |
COEFF2(I) = SCRCH4(I)*SCRCH2(I+1)/SCRCH1(I)
|
1878 |
|
1879 |
20 CONTINUE
|
1880 |
|
1881 |
DO 30 I=0,N
|
1882 |
|
1883 |
SCRCH4(I) = 1.D0/(SCRCH1(I) + SCRCH1(I+2))
|
1884 |
COEFF3(I) = -SCRCH4(I)*DX(I)*SCRCH1(I)/SCRCH3(I+1)
|
1885 |
COEFF4(I) = SCRCH4(I)*DX(I+1)*SCRCH1(I+2)/SCRCH2(I+1)
|
1886 |
COEFF5(I) = DX(I) - 2.D0*(DX(I+1)*COEFF3(I) + DX(I)*COEFF4(I))
|
1887 |
COEFF5(I) = COEFF5(I)/SCRCH1(I+1)
|
1888 |
|
1889 |
30 CONTINUE
|
1890 |
|
1891 |
RETURN
|
1892 |
END
|
1893 |
|
1894 |
C --------
|
1895 |
CN NAME: I N T E R P
|
1896 |
C --------
|
1897 |
|
1898 |
CP PURPOSE:
|
1899 |
CP COMPUTES INTERPOLATED VALUES AT INTERFACES
|
1900 |
C
|
1901 |
|
1902 |
CC COMMENTS:
|
1903 |
CC STEP 1 IN THE RECONSTRUCTION PROCEDURE (SEE APPENDIX I IN MARTI
|
1904 |
CC & MUELLER 1996)
|
1905 |
|
1906 |
SUBROUTINE INTERP(N,UM,U,UP,DELU)
|
1907 |
|
1908 |
IMPLICIT NONE
|
1909 |
|
1910 |
INCLUDE 'size'
|
1911 |
|
1912 |
C --------
|
1913 |
C ARGUMENTS
|
1914 |
C --------
|
1915 |
|
1916 |
INTEGER N
|
1917 |
|
1918 |
DOUBLEPRECISION UM(-4:MN5),U(-4:MN5),UP(-4:MN5),DELU(-4:MN5)
|
1919 |
|
1920 |
C ---------
|
1921 |
C COMMON BLOCKS
|
1922 |
C ---------
|
1923 |
|
1924 |
DOUBLEPRECISION COEFF1(-4:MN5),COEFF2(-4:MN5),COEFF3(-4:MN5)
|
1925 |
DOUBLEPRECISION COEFF4(-4:MN5),COEFF5(-4:MN5)
|
1926 |
COMMON /COEFF/ COEFF1,COEFF2,COEFF3,COEFF4,COEFF5
|
1927 |
|
1928 |
C -----------
|
1929 |
C INTERNAL VARIABLES
|
1930 |
C -----------
|
1931 |
|
1932 |
INTEGER I
|
1933 |
|
1934 |
DOUBLEPRECISION SCRCH1(-4:MN6),SCRCH2(-4:MN6)
|
1935 |
|
1936 |
DOUBLEPRECISION SDELU
|
1937 |
|
1938 |
DO 10 I=-2,N+3
|
1939 |
|
1940 |
SCRCH1(I) = U(I) - U(I-1)
|
1941 |
|
1942 |
10 CONTINUE
|
1943 |
|
1944 |
C ------------------------------------------------------
|
1945 |
C DELU(I) AS IN EQ.61 OF MARTI AND MUELLER (1996), JCP, VOL. 123, 1-14
|
1946 |
C ------------------------------------------------------
|
1947 |
|
1948 |
DO 20 I=0,N+1
|
1949 |
|
1950 |
DELU(I) = COEFF1(I)*SCRCH1(I+1) + COEFF2(I)*SCRCH1(I)
|
1951 |
|
1952 |
20 CONTINUE
|
1953 |
|
1954 |
C -------------------------------------------------------
|
1955 |
C DELU(I) AS IN EQ.60 OF MARTI AND MUELLER (1996), JCP, VOL. 123, 1-14
|
1956 |
C -------------------------------------------------------
|
1957 |
|
1958 |
DO 30 I=0,N+1
|
1959 |
|
1960 |
IF (SCRCH1(I+1)*SCRCH1(I).GT.0.D0) THEN
|
1961 |
SDELU = DELU(I)/DABS(DELU(I))
|
1962 |
SCRCH2(I) = MIN(DABS(SCRCH1(I)),DABS(SCRCH1(I+1)))
|
1963 |
DELU(I) = MIN(DABS(DELU(I)),2.D0*SCRCH2(I))*SDELU
|
1964 |
ELSE
|
1965 |
DELU(I) = 0.D0
|
1966 |
END IF
|
1967 |
|
1968 |
30 CONTINUE
|
1969 |
|
1970 |
C ----------------------------------------------
|
1971 |
C INTERFACE VALUES AS IN EQ.59 OF MARTI AND MUELLER (1996), JCP,
|
1972 |
C VOL. 123, 1-14
|
1973 |
C ----------------------------------------------
|
1974 |
|
1975 |
DO 40 I=0,N
|
1976 |
|
1977 |
UP(I) = U(I) + COEFF5(I)*SCRCH1(I+1) + COEFF3(I)*DELU(I+1)
|
1978 |
UP(I) = UP(I) + COEFF4(I)*DELU(I)
|
1979 |
UM(I+1) = UP(I)
|
1980 |
|
1981 |
40 CONTINUE
|
1982 |
|
1983 |
RETURN
|
1984 |
END
|
1985 |
|
1986 |
C --------
|
1987 |
CN NAME: D E T E C T
|
1988 |
C --------
|
1989 |
|
1990 |
CP PURPOSE:
|
1991 |
CP DETECTS CONTACT DISCONTINUITIES AND STEEPENS THE CORRESPONDING
|
1992 |
CP RECONSTRUCTED VALUES AT INTERFACES
|
1993 |
C
|
1994 |
|
1995 |
CC COMMENTS:
|
1996 |
CC STEP 2 IN THE RECONSTRUCTION PROCEDURE (SEE APPENDIX I IN MARTI
|
1997 |
CC & MUELLER 1996)
|
1998 |
|
1999 |
SUBROUTINE DETECT(N,UM,U,UP,DELU)
|
2000 |
|
2001 |
IMPLICIT NONE
|
2002 |
|
2003 |
INCLUDE 'size'
|
2004 |
|
2005 |
C -------
|
2006 |
C ARGUMENTS
|
2007 |
C -------
|
2008 |
|
2009 |
INTEGER N
|
2010 |
|
2011 |
DOUBLEPRECISION UM(-4:MN5),U(-4:MN5),UP(-4:MN5),DELU(-4:MN5)
|
2012 |
|
2013 |
C -----------
|
2014 |
C COMMON BLOCKS
|
2015 |
C -----------
|
2016 |
|
2017 |
DOUBLEPRECISION X(-4:MN5),XL(-4:MN5),XR(-4:MN5),DX(-4:MN5)
|
2018 |
COMMON /GRD/ X,XL,XR,DX
|
2019 |
|
2020 |
DOUBLEPRECISION P(-4:MN5),RHO(-4:MN5),VEL(-4:MN5),W(-4:MN5),
|
2021 |
& UU(-4:MN5),CS(-4:MN5),H(-4:MN5),DPDRH(-4:MN5),
|
2022 |
& DPDU(-4:MN5),R(-4:MN5),M(-4:MN5),E(-4:MN5)
|
2023 |
COMMON /HYDRO/ P,RHO,VEL,W,UU,CS,H,DPDRH,DPDU,R,M,E
|
2024 |
|
2025 |
DOUBLEPRECISION TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
2026 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
2027 |
COMMON /INPTF/ TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
2028 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
2029 |
|
2030 |
DOUBLEPRECISION GB
|
2031 |
COMMON /ADIND/ GB
|
2032 |
|
2033 |
C ---------
|
2034 |
C INTERNAL VARIABLES
|
2035 |
C ---------
|
2036 |
|
2037 |
INTEGER I
|
2038 |
|
2039 |
DOUBLEPRECISION D2U(-4:MN6),ETA(-4:MN6),ETATIL(-4:MN6)
|
2040 |
|
2041 |
DOUBLEPRECISION SCRCH1(-4:MN6),SCRCH2(-4:MN6),SCRCH3(-4:MN6),
|
2042 |
& SCRCH4(-4:MN6)
|
2043 |
|
2044 |
|
2045 |
DO 10 I=-1,N+3
|
2046 |
|
2047 |
SCRCH1(I) = DX(I) + DX(I-1)
|
2048 |
SCRCH2(I) = SCRCH1(I) + DX(I+1)
|
2049 |
SCRCH3(I) = U(I) - U(I-1)
|
2050 |
SCRCH1(I) = SCRCH3(I)/SCRCH1(I)
|
2051 |
|
2052 |
10 CONTINUE
|
2053 |
|
2054 |
DO 20 I=-1,N+2
|
2055 |
|
2056 |
D2U(I) = (SCRCH1(I+1) - SCRCH1(I))/SCRCH2(I)
|
2057 |
SCRCH4(I) = X(I) - X(I-1)
|
2058 |
SCRCH4(I) = SCRCH4(I)*SCRCH4(I)*SCRCH4(I)
|
2059 |
|
2060 |
20 CONTINUE
|
2061 |
|
2062 |
DO 30 I=0,N+1
|
2063 |
|
2064 |
SCRCH1(I) = D2U(I+1)*D2U(I-1)
|
2065 |
SCRCH3(I) = DABS(U(I+1) - U(I-1))
|
2066 |
SCRCH3(I) = SCRCH3(I) - EPSLN*MIN(DABS(U(I+1)),DABS(U(I-1)))
|
2067 |
|
2068 |
30 CONTINUE
|
2069 |
|
2070 |
C ------------------------------------------------------
|
2071 |
C ETATIL(I) AS IN EQ.67 OF MARTI AND MUELLER (1996), JCP, VOL. 123, 1-14
|
2072 |
C -------------------------------------------------------
|
2073 |
|
2074 |
DO 40 I=0,N+1
|
2075 |
|
2076 |
IF ((U(I+1) - U(I-1)).EQ.0.D0) THEN
|
2077 |
SCRCH2(I) = SMALL*SMLRHO
|
2078 |
ELSE
|
2079 |
SCRCH2(I) = U(I+1) - U(I-1)
|
2080 |
END IF
|
2081 |
|
2082 |
IF ((SCRCH1(I).GT.0.D0).OR.(SCRCH3(I).LT.0.D0)) THEN
|
2083 |
ETATIL(I) = 0.D0
|
2084 |
ELSE
|
2085 |
ETATIL(I) = (D2U(I-1) - D2U(I+1))*(SCRCH4(I) + SCRCH4(I+1))
|
2086 |
ETATIL(I) = ETATIL(I)/(X(I+1) - X(I-1))/SCRCH2(I)
|
2087 |
END IF
|
2088 |
|
2089 |
40 CONTINUE
|
2090 |
|
2091 |
C -------------------------------------------------------
|
2092 |
C ETA(I) AS IN EQ.66 OF MARTI AND MUELLER (1996), JCP, VOL. 123, 1-14
|
2093 |
C ONLY FOR ZONES VERIFYING EQ.63 (OTHERWISE, ZERO)
|
2094 |
C -------------------------------------------------------
|
2095 |
|
2096 |
DO 50 I=0,N+1
|
2097 |
|
2098 |
ETA(I) = MAX(0.D0,MIN(ETA1*(ETATIL(I) - ETA2),1.D0))
|
2099 |
SCRCH1(I) = DABS(P (I+1) - P (I-1))/MIN(P (I+1),P (I-1))
|
2100 |
SCRCH2(I) = DABS(RHO(I+1) - RHO(I-1))/MIN(RHO(I+1),RHO(I-1))
|
2101 |
|
2102 |
50 CONTINUE
|
2103 |
|
2104 |
DO 60 I=0,N+1
|
2105 |
|
2106 |
IF (GB*AK0*SCRCH2(I).LT.SCRCH1(I)) THEN
|
2107 |
ETA(I) = 0.D0
|
2108 |
END IF
|
2109 |
|
2110 |
60 CONTINUE
|
2111 |
|
2112 |
C ----------------------------
|
2113 |
C NEW RECONSTRUCTED VALUES (EQ.65)
|
2114 |
C ----------------------------
|
2115 |
|
2116 |
DO 70 I=0,N+1
|
2117 |
|
2118 |
SCRCH1(I) = U(I-1) + 0.5D0*DELU(I-1)
|
2119 |
SCRCH2(I) = U(I+1) - 0.5D0*DELU(I+1)
|
2120 |
UM(I) = UM(I)*(1.D0-ETA(I)) + SCRCH1(I)*ETA(I)
|
2121 |
UP(I) = UP(I)*(1.D0-ETA(I)) + SCRCH2(I)*ETA(I)
|
2122 |
|
2123 |
70 CONTINUE
|
2124 |
|
2125 |
RETURN
|
2126 |
END
|
2127 |
|
2128 |
C --------
|
2129 |
CN NAME: M O N O T
|
2130 |
C --------
|
2131 |
|
2132 |
CP PURPOSE:
|
2133 |
CP RECONSTRUCTED VALUES OBTAINED IN STEPS 1 TO 3 ARE MODIFIED SUCH THAT
|
2134 |
CP THE INTERPOLATION PARABOLA IN EACH ZONE IS MONOTONE
|
2135 |
C
|
2136 |
|
2137 |
CC COMMENTS:
|
2138 |
CC STEP 4 IN THE RECONSTRUCTION PROCEDURE (SEE APPENDIX I IN MARTI
|
2139 |
CC & MUELLER 1996)
|
2140 |
|
2141 |
SUBROUTINE MONOT(N,UM,U,UP,DU,U6)
|
2142 |
|
2143 |
IMPLICIT NONE
|
2144 |
|
2145 |
INCLUDE 'size'
|
2146 |
|
2147 |
C --------
|
2148 |
C ARGUMENTS
|
2149 |
C --------
|
2150 |
|
2151 |
INTEGER N
|
2152 |
|
2153 |
DOUBLEPRECISION UM(-4:MN5),U(-4:MN5),UP(-4:MN5),DU(-4:MN5)
|
2154 |
DOUBLEPRECISION U6(-4:MN5)
|
2155 |
|
2156 |
C --------
|
2157 |
C INTERNAL VARIABLES
|
2158 |
C --------
|
2159 |
|
2160 |
INTEGER I
|
2161 |
|
2162 |
DOUBLEPRECISION SCRCH1(-4:MN6),SCRCH2(-4:MN6),SCRCH3(-4:MN6)
|
2163 |
|
2164 |
C -----------------------------------------------------
|
2165 |
C NEW RECONSRUCTED VALUES IF CONDITION IN EQ.73 OF MARTI & MUELLER
|
2166 |
C 1996 HOLDS
|
2167 |
C -----------------------------------------------------
|
2168 |
|
2169 |
DO 10 I=0,N+1
|
2170 |
|
2171 |
DU(I) = UP(I) - UM(I)
|
2172 |
SCRCH1(I) = UP(I) - U(I)
|
2173 |
SCRCH1(I) = SCRCH1(I)*(UM(I)-U(I))
|
2174 |
|
2175 |
10 CONTINUE
|
2176 |
|
2177 |
DO 20 I=0,N+1
|
2178 |
|
2179 |
IF (SCRCH1(I).GE.0.D0) THEN
|
2180 |
UM(I) = U(I)
|
2181 |
UP(I) = U(I)
|
2182 |
END IF
|
2183 |
|
2184 |
20 CONTINUE
|
2185 |
|
2186 |
C --------------------------------------------------------
|
2187 |
C NEW RECONSTRUCTED VALUES IF CONDITION IN EQ.74 OR EQ.75 OF MARTI
|
2188 |
C & MUELLER 1996 HOLDS
|
2189 |
C --------------------------------------------------------
|
2190 |
|
2191 |
DO 30 I=0,N+1
|
2192 |
|
2193 |
DU(I) = UP(I) - UM(I)
|
2194 |
SCRCH1(I) = (UP(I) - U(I))*(UM(I) - U(I))
|
2195 |
|
2196 |
IF (SCRCH1(I).EQ.0.D0) THEN
|
2197 |
SCRCH2(I) = UM(I)
|
2198 |
SCRCH3(I) = UP(I)
|
2199 |
ELSE
|
2200 |
SCRCH2(I) = 3.D0*U(I) - 2.D0*UP(I)
|
2201 |
SCRCH3(I) = 3.D0*U(I) - 2.D0*UM(I)
|
2202 |
END IF
|
2203 |
|
2204 |
30 CONTINUE
|
2205 |
|
2206 |
DO 40 I=0,N+1
|
2207 |
|
2208 |
IF (DU(I)*(UM(I) - SCRCH2(I)).LT.0.D0) THEN
|
2209 |
UM(I) = SCRCH2(I)
|
2210 |
END IF
|
2211 |
|
2212 |
IF (DU(I)*(SCRCH3(I) - UP(I)).LT.0.D0) THEN
|
2213 |
UP(I) = SCRCH3(I)
|
2214 |
END IF
|
2215 |
|
2216 |
40 CONTINUE
|
2217 |
|
2218 |
C -------------------------------------------
|
2219 |
C COMPUTATION OF AUXILIAR VARIABLES FOR TIME ADVANCE
|
2220 |
C -------------------------------------------
|
2221 |
|
2222 |
DO 50 I=0,N+1
|
2223 |
|
2224 |
DU(I) = UP(I) - UM(I)
|
2225 |
U6(I) = 6.D0*U(I) - 3.D0*(UM(I) + UP(I))
|
2226 |
|
2227 |
50 CONTINUE
|
2228 |
|
2229 |
RETURN
|
2230 |
END
|
2231 |
|
2232 |
C --------
|
2233 |
CN NAME: F L A T E N
|
2234 |
C --------
|
2235 |
|
2236 |
CP PURPOSE:
|
2237 |
CP THIS SUBROUTINE FLATTENS ZONE STRUCTURE IN REGIONS WHERE SHOCKS
|
2238 |
CP ARE TOO THIN
|
2239 |
C
|
2240 |
|
2241 |
CC COMMENTS:
|
2242 |
CC STEP 3 IN THE RECONSTRUCTION PROCEDURE (SEE APPENDIX I IN MARTI
|
2243 |
CC & MUELLER 1996)
|
2244 |
|
2245 |
SUBROUTINE FLATEN
|
2246 |
|
2247 |
IMPLICIT NONE
|
2248 |
|
2249 |
INCLUDE 'size'
|
2250 |
|
2251 |
C -------------
|
2252 |
C COMMON BLOCKS
|
2253 |
C -------------
|
2254 |
|
2255 |
INTEGER NEND,NOUT,ITSTP,NX
|
2256 |
COMMON /INPTI/ NEND,NOUT,ITSTP,NX
|
2257 |
|
2258 |
DOUBLEPRECISION FLATN(-4:MN5),FLATN1(-4:MN5)
|
2259 |
COMMON /FLAT/ FLATN,FLATN1
|
2260 |
|
2261 |
DOUBLEPRECISION P(-4:MN5),RHO(-4:MN5),VEL(-4:MN5),W(-4:MN5),
|
2262 |
& U(-4:MN5),CS(-4:MN5),H(-4:MN5),DPDRH(-4:MN5),
|
2263 |
& DPDU(-4:MN5),R(-4:MN5),M(-4:MN5),E(-4:MN5)
|
2264 |
COMMON /HYDRO/ P,RHO,VEL,W,U,CS,H,DPDRH,DPDU,R,M,E
|
2265 |
|
2266 |
DOUBLEPRECISION TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
2267 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
2268 |
COMMON /INPTF/ TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
2269 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
2270 |
|
2271 |
C ------------
|
2272 |
C INTERNAL VARIABLES
|
2273 |
C ------------
|
2274 |
|
2275 |
INTEGER I
|
2276 |
|
2277 |
DOUBLEPRECISION SCRCH1(-4:MN6),SCRCH2(-4:MN6),SCRCH3(-4:MN6)
|
2278 |
|
2279 |
DOUBLEPRECISION DP(-4:MN5),DVEL(-4:MN5),DP2
|
2280 |
|
2281 |
DO 20 I=-2,NX+3
|
2282 |
|
2283 |
DP(I) = P(I+1) - P(I-1)
|
2284 |
DVEL(I) = VEL(I+1) - VEL(I-1)
|
2285 |
SCRCH1(I) = EPSILN*DMIN1(P(I+1),P(I-1)) - DABS(DP(I))
|
2286 |
|
2287 |
IF (SCRCH1(I).LT.0.D0.AND.DVEL(I).LT.0.D0) THEN
|
2288 |
SCRCH1(I) = 1.D0
|
2289 |
ELSE
|
2290 |
SCRCH1(I) = 0.D0
|
2291 |
END IF
|
2292 |
|
2293 |
20 CONTINUE
|
2294 |
|
2295 |
DO 30 I=-1,NX+2
|
2296 |
|
2297 |
DP2 = P(I+2) - P(I-2)
|
2298 |
|
2299 |
IF (DP2.EQ.0.D0) THEN
|
2300 |
|
2301 |
IF (DP(I).EQ.0.D0) THEN
|
2302 |
SCRCH2(I) = -OMG1
|
2303 |
ELSE
|
2304 |
SCRCH2(I) = 1.D0 - OMG1
|
2305 |
END IF
|
2306 |
|
2307 |
ELSE
|
2308 |
SCRCH2(I) = DP(I)/DP2 - OMG1
|
2309 |
END IF
|
2310 |
|
2311 |
SCRCH3(I) = SCRCH1(I)*DMAX1(0.D0,SCRCH2(I)*OMG2)
|
2312 |
|
2313 |
30 CONTINUE
|
2314 |
|
2315 |
DO 40 I=0,NX+1
|
2316 |
|
2317 |
IF (DP(I).LT.0.D0) THEN
|
2318 |
SCRCH2(I) = SCRCH3(I+1)
|
2319 |
ELSE
|
2320 |
SCRCH2(I) = SCRCH3(I-1)
|
2321 |
END IF
|
2322 |
|
2323 |
40 CONTINUE
|
2324 |
|
2325 |
DO 45 I=0,NX+1
|
2326 |
|
2327 |
FLATN(I) = DMAX1(SCRCH2(I),SCRCH3(I))
|
2328 |
FLATN(I) = DMAX1(0.D0,DMIN1(1.D0,FLATN(I)))
|
2329 |
FLATN1(I) = 1.D0 - FLATN(I)
|
2330 |
|
2331 |
45 CONTINUE
|
2332 |
|
2333 |
RETURN
|
2334 |
END
|
2335 |
|
2336 |
|
2337 |
C --------
|
2338 |
CN NAME: S T A T 1 D
|
2339 |
C --------
|
2340 |
|
2341 |
CP PURPOSE:
|
2342 |
CP THIS SUBROUTINE CALCULATES EFFECTIVE SECOND-ORDER-ACCURATE LEFT
|
2343 |
CP AND RIGHT STATES FOR RIEMANN PROBLEMS IN ONE DIMENSIONAL
|
2344 |
CP CALCULATIONS.
|
2345 |
C
|
2346 |
|
2347 |
CC COMMENTS:
|
2348 |
CC THIS ROUTINE CLOSELY FOLLOWS THE ANALYTICAL DEVELOPMENTS DESCRIBED IN
|
2349 |
CC MARTI & MUELLER, JCP, 1996
|
2350 |
|
2351 |
SUBROUTINE STAT1D
|
2352 |
|
2353 |
IMPLICIT NONE
|
2354 |
|
2355 |
INCLUDE 'size'
|
2356 |
|
2357 |
C ---------
|
2358 |
C COMMON BLOCKS
|
2359 |
C ---------
|
2360 |
|
2361 |
INTEGER NEND,NOUT,ITSTP,NX
|
2362 |
COMMON /INPTI/ NEND,NOUT,ITSTP,NX
|
2363 |
|
2364 |
DOUBLEPRECISION TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
2365 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
2366 |
COMMON /INPTF/ TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,SMALLU,
|
2367 |
& GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
2368 |
|
2369 |
DOUBLEPRECISION P(-4:MN5),RHO(-4:MN5),VEL(-4:MN5),W(-4:MN5),
|
2370 |
& U(-4:MN5),CS(-4:MN5),H(-4:MN5),DPDRH(-4:MN5),
|
2371 |
& DPDU(-4:MN5),R(-4:MN5),M(-4:MN5),E(-4:MN5)
|
2372 |
COMMON /HYDRO/ P,RHO,VEL,W,U,CS,H,DPDRH,DPDU,R,M,E
|
2373 |
|
2374 |
DOUBLEPRECISION PM(-4:MN5),PP(-4:MN5),RHOM(-4:MN5),RHOP(-4:MN5),
|
2375 |
& VELM(-4:MN5),VELP(-4:MN5),UM(-4:MN5),UP(-4:MN5)
|
2376 |
COMMON /UMP/ PM,PP,RHOM,RHOP,VELM,VELP,UM,UP
|
2377 |
|
2378 |
DOUBLEPRECISION DP(-4:MN5),P6(-4:MN5),DRHO(-4:MN5),RHO6(-4:MN5),
|
2379 |
& DVEL(-4:MN5),VEL6(-4:MN5),DU(-4:MN5),U6(-4:MN5)
|
2380 |
COMMON /U6/ DP,P6,DRHO,RHO6,DVEL,VEL6,DU,U6
|
2381 |
|
2382 |
DOUBLEPRECISION PL(-4:MN6),PR(-4:MN6),RHOL(-4:MN6),RHOR(-4:MN6),
|
2383 |
& VELL(-4:MN6),VELR(-4:MN6),UL(-4:MN6),UR(-4:MN6),
|
2384 |
& CSL(-4:MN6),CSR(-4:MN6),RL(-4:MN6),RR(-4:MN6),
|
2385 |
& ML(-4:MN6),MR(-4:MN6),EL(-4:MN6),ER(-4:MN6)
|
2386 |
COMMON /INTERF/ PL,PR,RHOL,RHOR,VELL,VELR,UL,UR,CSL,CSR,RL,RR,ML,
|
2387 |
& MR,EL,ER
|
2388 |
|
2389 |
DOUBLEPRECISION FICT(-4:MN5)
|
2390 |
COMMON /FICT/ FICT
|
2391 |
|
2392 |
DOUBLEPRECISION TIME,DT
|
2393 |
COMMON /ZEIT/ TIME,DT
|
2394 |
|
2395 |
DOUBLEPRECISION X(-4:MN5),XL(-4:MN5),XR(-4:MN5),DX(-4:MN5)
|
2396 |
COMMON /GRD/ X,XL,XR,DX
|
2397 |
|
2398 |
DOUBLEPRECISION GB
|
2399 |
COMMON /ADIND/ GB
|
2400 |
|
2401 |
C ---------
|
2402 |
C INTERNAL VARIABLES
|
2403 |
C ---------
|
2404 |
|
2405 |
INTEGER I
|
2406 |
|
2407 |
DOUBLEPRECISION LAMB1(-4:MN5),LAMB2(-4:MN5),LAMB3(-4:MN5)
|
2408 |
|
2409 |
DOUBLEPRECISION P1L(-4:MN6),P1R(-4:MN6),P2L(-4:MN6),P2R(-4:MN6),
|
2410 |
& P3L(-4:MN6),P3R(-4:MN6),RHO1L(-4:MN6),
|
2411 |
& RHO1R(-4:MN6),RHO2L(-4:MN6),RHO2R(-4:MN6),
|
2412 |
& RHO3L(-4:MN6),RHO3R(-4:MN6),VEL1L(-4:MN6),
|
2413 |
& VEL1R(-4:MN6),VEL2L(-4:MN6),VEL2R(-4:MN6),
|
2414 |
& VEL3L(-4:MN6),VEL3R(-4:MN6)
|
2415 |
|
2416 |
DOUBLEPRECISION BETA1L(-4:MN6),BETA2L(-4:MN6),BETA3L(-4:MN6),
|
2417 |
& BETA1R(-4:MN6),BETA2R(-4:MN6),BETA3R(-4:MN6)
|
2418 |
|
2419 |
|
2420 |
DOUBLEPRECISION SCRCH1(-4:MN6),SCRCH2(-4:MN6),SCRCH3(-4:MN6),
|
2421 |
& SCRCH4(-4:MN6),SCRCH5(-4:MN6)
|
2422 |
|
2423 |
DO 10 I=0,NX+1
|
2424 |
|
2425 |
LAMB1(I) = (VEL(I) - CS(I))/(1.D0 - VEL(I)*CS(I))
|
2426 |
LAMB2(I) = VEL(I)
|
2427 |
LAMB3(I) = (VEL(I) + CS(I))/(1.D0 + VEL(I)*CS(I))
|
2428 |
|
2429 |
10 CONTINUE
|
2430 |
|
2431 |
CALL AVRG1D(NX,DT,LAMB1,PM,PP,DP,P6,RHOM,RHOP,DRHO,RHO6,
|
2432 |
& VELM,VELP,DVEL,VEL6,
|
2433 |
& P1L,P1R,RHO1L,RHO1R,VEL1L,VEL1R)
|
2434 |
|
2435 |
CALL AVRG1D(NX,DT,LAMB2,PM,PP,DP,P6,RHOM,RHOP,DRHO,RHO6,
|
2436 |
& VELM,VELP,DVEL,VEL6,
|
2437 |
& P2L,P2R,RHO2L,RHO2R,VEL2L,VEL2R)
|
2438 |
|
2439 |
CALL AVRG1D(NX,DT,LAMB3,PM,PP,DP,P6,RHOM,RHOP,DRHO,RHO6,
|
2440 |
& VELM,VELP,DVEL,VEL6,
|
2441 |
& P3L,P3R,RHO3L,RHO3R,VEL3L,VEL3R)
|
2442 |
|
2443 |
C -------------
|
2444 |
C EFFECTIVE LEFT STATES
|
2445 |
C -------------
|
2446 |
|
2447 |
DO 20 I=1,NX+1
|
2448 |
|
2449 |
SCRCH1(I) = P3L(I)/(GB - 1.D0)/RHO3L(I)
|
2450 |
SCRCH1(I) = 1.D0 + SCRCH1(I) + P3L(I)/RHO3L(I)
|
2451 |
SCRCH2(I) = DSQRT(GB*P3L(I)/RHO3L(I)/SCRCH1(I))
|
2452 |
SCRCH1(I) = SCRCH1(I)*SCRCH2(I)
|
2453 |
SCRCH3(I) = 1.D0/(1.D0 - VEL3L(I)**2)
|
2454 |
SCRCH3(I) = RHO3L(I)*SCRCH3(I)
|
2455 |
SCRCH4(I) = 0.D0
|
2456 |
SCRCH5(I) = 0.D0
|
2457 |
|
2458 |
BETA1L(I) = 0.5D0*(VEL3L(I) - VEL1L(I) - (P3L(I) - P1L(I))/
|
2459 |
& SCRCH3(I)/SCRCH1(I) - DT*SCRCH4(I))
|
2460 |
BETA2L(I) = RHO3L(I) - RHO2L(I) - (P3L(I) - P2L(I))/
|
2461 |
& SCRCH1(I)/SCRCH2(I)
|
2462 |
BETA3L(I) = -0.5D0*DT*SCRCH5(I)
|
2463 |
|
2464 |
20 CONTINUE
|
2465 |
|
2466 |
DO 25 I=1,NX+1
|
2467 |
|
2468 |
IF (LAMB3(I-1).LE.0.D0) THEN
|
2469 |
BETA3L(I) = 0.D0
|
2470 |
END IF
|
2471 |
|
2472 |
IF (LAMB2(I-1).LE.0.D0) THEN
|
2473 |
BETA2L(I) = 0.D0
|
2474 |
END IF
|
2475 |
|
2476 |
IF (LAMB1(I-1).LE.0.D0) THEN
|
2477 |
BETA1L(I) = 0.D0
|
2478 |
END IF
|
2479 |
|
2480 |
25 CONTINUE
|
2481 |
|
2482 |
DO 30 I=1,NX+1
|
2483 |
|
2484 |
PL(I) = P3L(I) + SCRCH3(I)*SCRCH1(I)*(BETA1L(I) + BETA3L(I))
|
2485 |
PL(I) = DMAX1(SMALLP,PL(I))
|
2486 |
|
2487 |
RHOL(I) = RHO3L(I) + SCRCH3(I)/SCRCH2(I)*(BETA1L(I) +
|
2488 |
& BETA3L(I)) - BETA2L(I)
|
2489 |
RHOL(I) = DMAX1(SMLRHO,RHOL(I))
|
2490 |
|
2491 |
VELL(I) = VEL3L(I) + BETA3L(I) - BETA1L(I)
|
2492 |
|
2493 |
UL(I) = PL(I)/(GB - 1.D0)/RHOL(I)
|
2494 |
|
2495 |
SCRCH1(I) = 1.D0 + UL(I) + PL(I)/RHOL(I)
|
2496 |
|
2497 |
CSL(I) = DSQRT(GB*PL(I)/RHOL(I)/SCRCH1(I))
|
2498 |
|
2499 |
30 CONTINUE
|
2500 |
|
2501 |
C ----------
|
2502 |
C EFFECTIVE RIGHT STATES
|
2503 |
C ----------
|
2504 |
|
2505 |
DO 35 I=1,NX+1
|
2506 |
|
2507 |
SCRCH1(I) = P1R(I)/(GB - 1.D0)/RHO1R(I)
|
2508 |
SCRCH1(I) = 1.D0 + SCRCH1(I) + P1R(I)/RHO1R(I)
|
2509 |
SCRCH2(I) = DSQRT(GB*P1R(I)/RHO1R(I)/SCRCH1(I))
|
2510 |
SCRCH1(I) = SCRCH1(I)*SCRCH2(I)
|
2511 |
SCRCH3(I) = 1.D0/(1.D0 - VEL1R(I)**2)
|
2512 |
SCRCH3(I) = RHO1R(I)*SCRCH3(I)
|
2513 |
SCRCH4(I) = 0.D0
|
2514 |
SCRCH5(I) = 0.D0
|
2515 |
|
2516 |
BETA1R(I) = -0.5D0*DT*SCRCH4(I)
|
2517 |
BETA2R(I) = RHO1R(I) - RHO2R(I) - (P1R(I)-P2R(I))/
|
2518 |
& SCRCH1(I)/SCRCH2(I)
|
2519 |
BETA3R(I) = -0.5D0*(VEL1R(I) - VEL3R(I) + (P1R(I) - P3R(I))/
|
2520 |
& SCRCH3(I)/SCRCH1(I) + DT*SCRCH5(I))
|
2521 |
35 CONTINUE
|
2522 |
|
2523 |
DO 40 I=1,NX+1
|
2524 |
|
2525 |
IF (LAMB3(I).GE.0.D0) THEN
|
2526 |
BETA3R(I) = 0.D0
|
2527 |
END IF
|
2528 |
|
2529 |
IF (LAMB2(I).GE.0.D0) THEN
|
2530 |
BETA2R(I) = 0.D0
|
2531 |
END IF
|
2532 |
|
2533 |
IF (LAMB1(I).GE.0.D0) THEN
|
2534 |
BETA1R(I) = 0.D0
|
2535 |
END IF
|
2536 |
|
2537 |
40 CONTINUE
|
2538 |
|
2539 |
DO 45 I=1,NX+1
|
2540 |
|
2541 |
PR(I) = P1R(I) + SCRCH3(I)*SCRCH1(I)*(BETA1R(I) + BETA3R(I))
|
2542 |
PR(I) = DMAX1(SMALLP,PR(I))
|
2543 |
|
2544 |
RHOR(I) = RHO1R(I) + SCRCH3(I)/SCRCH2(I)*(BETA1R(I) +
|
2545 |
& BETA3R(I)) - BETA2R(I)
|
2546 |
RHOR(I) = DMAX1(SMLRHO,RHOR(I))
|
2547 |
|
2548 |
VELR(I) = VEL1R(I) + BETA3R(I) - BETA1R(I)
|
2549 |
|
2550 |
UR(I) = PR(I)/(GB - 1.D0)/RHOR(I)
|
2551 |
|
2552 |
SCRCH1(I) = 1.D0 + UR(I) + PR(I)/RHOR(I)
|
2553 |
|
2554 |
CSR(I) = DSQRT(GB*PR(I)/RHOR(I)/SCRCH1(I))
|
2555 |
|
2556 |
45 CONTINUE
|
2557 |
|
2558 |
C --------------
|
2559 |
C CONSERVED VARIABLES
|
2560 |
C --------------
|
2561 |
|
2562 |
DO 60 I=1,NX+1
|
2563 |
|
2564 |
SCRCH1(I) = 1.D0/DSQRT(1.D0 - VELL(I)*VELL(I))
|
2565 |
SCRCH2(I) = 1.D0 + UL(I) + PL(I)/RHOL(I)
|
2566 |
RL(I) = RHOL(I)*SCRCH1(I)
|
2567 |
ML(I) = RL(I)*SCRCH2(I)*SCRCH1(I)*VELL(I)
|
2568 |
EL(I) = RL(I)*SCRCH2(I)*SCRCH1(I) - PL(I) - RL(I)
|
2569 |
|
2570 |
60 CONTINUE
|
2571 |
|
2572 |
DO 70 I=1,NX+1
|
2573 |
|
2574 |
SCRCH1(I) = 1.D0/DSQRT(1.D0 - VELR(I)*VELR(I))
|
2575 |
SCRCH2(I) = 1.D0 + UR(I) + PR(I)/RHOR(I)
|
2576 |
RR(I) = RHOR(I)*SCRCH1(I)
|
2577 |
MR(I) = RR(I)*SCRCH2(I)*SCRCH1(I)*VELR(I)
|
2578 |
ER(I) = RR(I)*SCRCH2(I)*SCRCH1(I) - PR(I) - RR(I)
|
2579 |
|
2580 |
70 CONTINUE
|
2581 |
|
2582 |
RETURN
|
2583 |
END
|
2584 |
|
2585 |
C --------
|
2586 |
CN NAME: A V R G 1 D
|
2587 |
C --------
|
2588 |
|
2589 |
CP PURPOSE:
|
2590 |
CP THIS SUBROUTINE CALCULATES AVERAGES OF QUANTITIES P,RHO,VEL, OVER
|
2591 |
CP THE PART OF THE DOMAIN OF DEPENDENCE FOR THE LAMBDA
|
2592 |
CP CHARACTERISTIC OF RADM(I) FOR THE TIME INTERVAL (T(N),T(N+1)).
|
2593 |
C
|
2594 |
|
2595 |
CC COMMENTS:
|
2596 |
CC THIS ROUTINE CLOSELY FOLLOWS THE ANALYTICAL DEVELOPMENTS DESCRIBED IN
|
2597 |
CC MARTI & MUELLER, JCP, 1996
|
2598 |
|
2599 |
SUBROUTINE AVRG1D(N,DT,LAMB,PM,PP,DP,P6,RHOM,RHOP,DRHO,
|
2600 |
& RHO6,VELM,VELP,DVEL,VEL6,PL,PR,RHOL,RHOR,
|
2601 |
& VELL,VELR)
|
2602 |
|
2603 |
IMPLICIT NONE
|
2604 |
|
2605 |
INCLUDE 'size'
|
2606 |
|
2607 |
C --------
|
2608 |
C ARGUMENTS
|
2609 |
C --------
|
2610 |
|
2611 |
INTEGER N
|
2612 |
|
2613 |
DOUBLEPRECISION DT
|
2614 |
|
2615 |
DOUBLEPRECISION LAMB(-4:MN5)
|
2616 |
|
2617 |
DOUBLEPRECISION PM(-4:MN5),PP(-4:MN5),DP(-4:MN5),P6(-4:MN5),
|
2618 |
& RHOM(-4:MN5),RHOP(-4:MN5),DRHO(-4:MN5),
|
2619 |
& RHO6(-4:MN5),VELM(-4:MN5),VELP(-4:MN5),
|
2620 |
& DVEL(-4:MN5),VEL6(-4:MN5)
|
2621 |
|
2622 |
DOUBLEPRECISION PL(-4:MN6),PR(-4:MN6),RHOL(-4:MN6),RHOR(-4:MN6),
|
2623 |
& VELL(-4:MN6),VELR(-4:MN6)
|
2624 |
|
2625 |
C ------
|
2626 |
C COMMON BLOCKS
|
2627 |
C ------
|
2628 |
|
2629 |
DOUBLEPRECISION X(-4:MN5),XL(-4:MN5),XR(-4:MN5),DX(-4:MN5)
|
2630 |
COMMON /GRD/ X,XL,XR,DX
|
2631 |
|
2632 |
C ----------
|
2633 |
C INTERNAL VARIABLES
|
2634 |
C ----------
|
2635 |
|
2636 |
INTEGER I
|
2637 |
|
2638 |
DOUBLEPRECISION SCRCH1(-4:MN6)
|
2639 |
|
2640 |
|
2641 |
DO 10 I=0,N+1
|
2642 |
|
2643 |
SCRCH1(I) = DMAX1(0.D0,DT*LAMB(I)/DX(I))
|
2644 |
|
2645 |
10 CONTINUE
|
2646 |
|
2647 |
DO 20 I=1,N+1
|
2648 |
|
2649 |
PL(I) = PP(I-1) - SCRCH1(I-1)/2.D0*
|
2650 |
& (DP(I-1) - (1.D0 - 2.D0*SCRCH1(I-1)/3.D0)*P6(I-1))
|
2651 |
|
2652 |
RHOL(I) = RHOP(I-1) - SCRCH1(I-1)/2.D0*
|
2653 |
& (DRHO(I-1) - (1.D0 - 2.D0*SCRCH1(I-1)/3.D0)*RHO6(I-1))
|
2654 |
|
2655 |
VELL(I) = VELP(I-1) - SCRCH1(I-1)/2.D0*
|
2656 |
& (DVEL(I-1) - (1.D0 - 2.D0*SCRCH1(I-1)/3.D0)*VEL6(I-1))
|
2657 |
|
2658 |
20 CONTINUE
|
2659 |
|
2660 |
DO 30 I=0,N+1
|
2661 |
|
2662 |
SCRCH1(I) = DMAX1(0.D0,-DT*LAMB(I)/DX(I))
|
2663 |
|
2664 |
30 CONTINUE
|
2665 |
|
2666 |
DO 40 I=1,N+1
|
2667 |
|
2668 |
PR(I) = PM(I) + SCRCH1(I)/2.D0*
|
2669 |
& (DP(I) + (1.D0 - 2.D0*SCRCH1(I)/3.D0)*P6(I))
|
2670 |
|
2671 |
RHOR(I) = RHOM(I) + SCRCH1(I)/2.D0*
|
2672 |
& (DRHO(I) + (1.D0 - 2.D0*SCRCH1(I)/3.D0)*RHO6(I))
|
2673 |
|
2674 |
VELR(I) = VELM(I) + SCRCH1(I)/2.D0*
|
2675 |
& (DVEL(I) + (1.D0 - 2.D0*SCRCH1(I)/3.D0)*VEL6(I))
|
2676 |
|
2677 |
40 CONTINUE
|
2678 |
|
2679 |
RETURN
|
2680 |
END
|
2681 |
|
2682 |
C --------
|
2683 |
CN NAME: N F L U X
|
2684 |
C --------
|
2685 |
|
2686 |
CP PURPOSE:
|
2687 |
CP COMPUTES THE NUMERICAL FLUXES
|
2688 |
C
|
2689 |
|
2690 |
CC COMMENTS:
|
2691 |
CC COMPUTES THE NUMERICAL FLUXES FROM THE EXACT SOLUTION OF THE
|
2692 |
CC RELATIVISTIC RIEMANN PROBLEM AS DESCRIBED IN MARTI AND MUELLER, JFM,
|
2693 |
CC 1994
|
2694 |
|
2695 |
SUBROUTINE NFLUX(RHOL1,RHOR1,PL1,PR1,VELL1,VELR1,UL1,UR1,
|
2696 |
& CSL1,CSR1,FR,FM,FE)
|
2697 |
|
2698 |
IMPLICIT NONE
|
2699 |
|
2700 |
C -----------
|
2701 |
C ARGUMENTS
|
2702 |
C -----------
|
2703 |
|
2704 |
DOUBLE PRECISION RHOL1, PL1, UL1, CSL1, VELL1,
|
2705 |
& RHOR1, PR1, UR1, CSR1, VELR1
|
2706 |
|
2707 |
DOUBLE PRECISION FR, FM, FE
|
2708 |
|
2709 |
C -------
|
2710 |
C COMMON BLOCKS
|
2711 |
C -------
|
2712 |
|
2713 |
DOUBLE PRECISION RHOL, PL, UL, HL, CSL, VELL, WL,
|
2714 |
& RHOR, PR, UR, HR, CSR, VELR, WR
|
2715 |
COMMON /STATES/ RHOL, PL, UL, HL, CSL, VELL, WL,
|
2716 |
& RHOR, PR, UR, HR, CSR, VELR, WR
|
2717 |
|
2718 |
DOUBLE PRECISION RHOLS, ULS, HLS, CSLS, VELLS, VSHOCKL
|
2719 |
COMMON /LS/ RHOLS, ULS, HLS, CSLS, VELLS, VSHOCKL
|
2720 |
|
2721 |
DOUBLE PRECISION RHORS, URS, HRS, CSRS, VELRS, VSHOCKR
|
2722 |
COMMON /RS/ RHORS, URS, HRS, CSRS, VELRS, VSHOCKR
|
2723 |
|
2724 |
DOUBLE PRECISION GAMMA
|
2725 |
COMMON /ADIND/ GAMMA
|
2726 |
|
2727 |
C ---------
|
2728 |
C INTERNAL VARIABLES
|
2729 |
C ---------
|
2730 |
|
2731 |
INTEGER ILOOP
|
2732 |
|
2733 |
DOUBLE PRECISION TOL, PMIN, PMAX, DVEL1, DVEL2, CHECK
|
2734 |
|
2735 |
DOUBLE PRECISION PS, VELS
|
2736 |
|
2737 |
DOUBLE PRECISION RHOA, PA, VELA, UA
|
2738 |
|
2739 |
DOUBLE PRECISION XI, XI1, XI2, XI3, XI4, XI5
|
2740 |
|
2741 |
C ------------------------------
|
2742 |
C SPECIFIC ENTHALPY AND
|
2743 |
C FLOW LORENTZ FACTORS IN THE INITIAL STATES
|
2744 |
C ------------------------------
|
2745 |
|
2746 |
RHOL = RHOL1
|
2747 |
RHOR = RHOR1
|
2748 |
|
2749 |
PL = PL1
|
2750 |
PR = PR1
|
2751 |
|
2752 |
UL = UL1
|
2753 |
UR = UR1
|
2754 |
|
2755 |
VELL = VELL1
|
2756 |
VELR = VELR1
|
2757 |
|
2758 |
CSL = CSL1
|
2759 |
CSR = CSR1
|
2760 |
|
2761 |
HL = 1.D0+UL+PL/RHOL
|
2762 |
HR = 1.D0+UR+PR/RHOR
|
2763 |
|
2764 |
WL = 1.D0/DSQRT(1.D0-VELL**2)
|
2765 |
WR = 1.D0/DSQRT(1.D0-VELR**2)
|
2766 |
|
2767 |
C -------------
|
2768 |
C TOLERANCE FOR THE SOLUTION
|
2769 |
C -------------
|
2770 |
|
2771 |
TOL = 1.D-8
|
2772 |
|
2773 |
C
|
2774 |
|
2775 |
ILOOP = 0
|
2776 |
|
2777 |
PMIN = (PL + PR)/2.D0
|
2778 |
PMAX = PMIN
|
2779 |
|
2780 |
5 ILOOP = ILOOP + 1
|
2781 |
|
2782 |
PMIN = 0.5D0*MAX(PMIN,0.D0)
|
2783 |
PMAX = 2.D0*PMAX
|
2784 |
|
2785 |
CALL GETDVEL(PMIN, DVEL1)
|
2786 |
|
2787 |
CALL GETDVEL(PMAX, DVEL2)
|
2788 |
|
2789 |
CHECK = DVEL1*DVEL2
|
2790 |
IF (CHECK.GT.0.D0) GOTO 5
|
2791 |
|
2792 |
C ---------------------------
|
2793 |
C PRESSURE AND FLOW VELOCITY IN THE INTERMEDIATE STATES
|
2794 |
C ---------------------------
|
2795 |
|
2796 |
CALL GETP(PMIN, PMAX, TOL, PS)
|
2797 |
|
2798 |
VELS = 0.5D0*(VELLS + VELRS)
|
2799 |
|
2800 |
C ---------------
|
2801 |
C SOLUTION ON THE NUMERICAL INTERFACE
|
2802 |
C ---------------
|
2803 |
|
2804 |
C -----------
|
2805 |
C POSITIONS OF THE WAVES
|
2806 |
C -----------
|
2807 |
|
2808 |
IF (PL.GE.PS) THEN
|
2809 |
|
2810 |
XI1 = (VELL - CSL)/(1.D0 - VELL*CSL)
|
2811 |
XI2 = (VELS - CSLS)/(1.D0 - VELS*CSLS)
|
2812 |
|
2813 |
ELSE
|
2814 |
|
2815 |
XI1 = VSHOCKL
|
2816 |
XI2 = XI1
|
2817 |
|
2818 |
END IF
|
2819 |
|
2820 |
XI3 = VELS
|
2821 |
|
2822 |
IF (PR.GE.PS) THEN
|
2823 |
|
2824 |
XI4 = (VELS + CSRS)/(1.D0 + VELS*CSRS)
|
2825 |
XI5 = (VELR + CSR)/(1.D0 + VELR*CSR)
|
2826 |
|
2827 |
ELSE
|
2828 |
|
2829 |
XI4 = VSHOCKR
|
2830 |
XI5 = XI4
|
2831 |
|
2832 |
END IF
|
2833 |
|
2834 |
C ----------
|
2835 |
C SOLUTION ON THE INTERFACE AT X = 0 (XI = 0)
|
2836 |
C ----------
|
2837 |
|
2838 |
XI = 0.D0
|
2839 |
|
2840 |
IF (XI1.GE.XI) THEN
|
2841 |
|
2842 |
PA = PL
|
2843 |
RHOA = RHOL
|
2844 |
VELA = VELL
|
2845 |
UA = UL
|
2846 |
|
2847 |
ELSE IF (XI2.GE.XI) THEN
|
2848 |
|
2849 |
CALL RAREF(XI,RHOL,CSL,VELL,'L',RHOA,PA,UA,VELA)
|
2850 |
|
2851 |
ELSE IF (XI3.GE.XI) THEN
|
2852 |
|
2853 |
PA = PS
|
2854 |
RHOA = RHOLS
|
2855 |
VELA = VELS
|
2856 |
UA = ULS
|
2857 |
|
2858 |
ELSE IF (XI4.GE.XI) THEN
|
2859 |
|
2860 |
PA = PS
|
2861 |
RHOA = RHORS
|
2862 |
VELA = VELS
|
2863 |
UA = URS
|
2864 |
|
2865 |
ELSE IF (XI5.GE.XI) THEN
|
2866 |
|
2867 |
CALL RAREF(XI,RHOR,CSR,VELR,'R',RHOA,PA,UA,VELA)
|
2868 |
|
2869 |
ELSE
|
2870 |
|
2871 |
PA = PR
|
2872 |
RHOA = RHOR
|
2873 |
VELA = VELR
|
2874 |
UA = UR
|
2875 |
|
2876 |
END IF
|
2877 |
|
2878 |
C -----------
|
2879 |
C NUMERICAL FLUXES
|
2880 |
C -----------
|
2881 |
|
2882 |
FR = RHOA*VELA/DSQRT(1.D0 - VELA**2)
|
2883 |
FM = RHOA*(1.D0 + UA + PA/RHOA)*VELA**2/(1.D0 - VELA**2) + PA
|
2884 |
FE = RHOA*(1.D0 + UA + PA/RHOA)*VELA/(1.D0 - VELA**2) -
|
2885 |
& RHOA*VELA/DSQRT(1.D0 - VELA**2)
|
2886 |
|
2887 |
RETURN
|
2888 |
END
|
2889 |
|
2890 |
C ----------
|
2891 |
CN NAME: G E T D V E L
|
2892 |
C ----------
|
2893 |
|
2894 |
CP PURPOSE:
|
2895 |
CP COMPUTE THE DIFFERENCE IN FLOW SPEED BETWEEN LEFT AND RIGHT INTERMEDIATE
|
2896 |
CP STATES FOR GIVEN LEFT AND RIGHT STATES AND PRESSURE
|
2897 |
C
|
2898 |
|
2899 |
CC COMMENTS:
|
2900 |
CC NONE
|
2901 |
C
|
2902 |
SUBROUTINE GETDVEL( P, DVEL)
|
2903 |
|
2904 |
IMPLICIT NONE
|
2905 |
|
2906 |
C -----
|
2907 |
C ARGUMENTS
|
2908 |
C -----
|
2909 |
|
2910 |
DOUBLEPRECISION P, DVEL
|
2911 |
|
2912 |
C -------
|
2913 |
C COMMON BLOCKS
|
2914 |
C -------
|
2915 |
|
2916 |
DOUBLE PRECISION RHOLS,ULS,HLS,CSLS,VELLS,VSHOCKL
|
2917 |
COMMON /LS/ RHOLS,ULS,HLS,CSLS,VELLS,VSHOCKL
|
2918 |
|
2919 |
DOUBLE PRECISION RHORS,URS,HRS,CSRS,VELRS,VSHOCKR
|
2920 |
COMMON /RS/ RHORS,URS,HRS,CSRS,VELRS,VSHOCKR
|
2921 |
|
2922 |
DOUBLE PRECISION RHOL, PL, UL, HL, CSL, VELL, WL,
|
2923 |
& RHOR, PR, UR, HR, CSR, VELR, WR
|
2924 |
COMMON /STATES/ RHOL, PL, UL, HL, CSL, VELL, WL,
|
2925 |
& RHOR, PR, UR, HR, CSR, VELR, WR
|
2926 |
|
2927 |
DOUBLE PRECISION GAMMA
|
2928 |
COMMON /ADIND/ GAMMA
|
2929 |
|
2930 |
C -----
|
2931 |
C LEFT WAVE
|
2932 |
C -----
|
2933 |
|
2934 |
CALL GETVEL(P, RHOL, PL, UL, HL, CSL, VELL, WL, 'L',
|
2935 |
& RHOLS, ULS, HLS, CSLS, VELLS, VSHOCKL)
|
2936 |
|
2937 |
C -----
|
2938 |
C RIGHT WAVE
|
2939 |
C -----
|
2940 |
|
2941 |
CALL GETVEL(P, RHOR, PR, UR, HR, CSR, VELR, WR, 'R',
|
2942 |
& RHORS, URS, HRS, CSRS, VELRS, VSHOCKR)
|
2943 |
|
2944 |
DVEL = VELLS - VELRS
|
2945 |
|
2946 |
RETURN
|
2947 |
END
|
2948 |
|
2949 |
C -------
|
2950 |
CN NAME: G E T P
|
2951 |
C -------
|
2952 |
|
2953 |
CP PURPOSE:
|
2954 |
CP FIND THE PRESSURE IN THE INTERMEDIATE STATE OF A RIEMANN PROBLEM IN
|
2955 |
CP RELATIVISTIC HYDRODYNAMICS
|
2956 |
C
|
2957 |
|
2958 |
CC COMMENTS:
|
2959 |
CC THIS ROUTINE USES A COMBINATION OF INTERVAL BISECTION AND INVERSE
|
2960 |
CC QUADRATIC INTERPOLATION TO FIND THE ROOT IN A SPECIFIED INTERVAL.
|
2961 |
CC IT IS ASSUMED THAT DVEL(PMIN) AND DVEL(PMAX) HAVE OPPOSITE SIGNS WITHOUT
|
2962 |
CC A CHECK.
|
2963 |
CC ADAPTED FROM "COMPUTER METHODS FOR MATHEMATICAL COMPUTATION",
|
2964 |
CC BY G. E. FORSYTHE, M. A. MALCOLM, AND C. B. MOLER,
|
2965 |
CC PRENTICE-HALL, ENGLEWOOD CLIFFS N.J.
|
2966 |
C
|
2967 |
SUBROUTINE GETP( PMIN, PMAX, TOL, PS)
|
2968 |
|
2969 |
IMPLICIT NONE
|
2970 |
|
2971 |
C -----
|
2972 |
C ARGUMENTS
|
2973 |
C -----
|
2974 |
|
2975 |
DOUBLEPRECISION PMIN, PMAX, TOL, PS
|
2976 |
|
2977 |
C -------
|
2978 |
C COMMON BLOCKS
|
2979 |
C -------
|
2980 |
|
2981 |
DOUBLEPRECISION GAMMA
|
2982 |
COMMON /ADIND/ GAMMA
|
2983 |
|
2984 |
DOUBLEPRECISION RHOL, PL, UL, HL, CSL, VELL, WL,
|
2985 |
& RHOR, PR, UR, HR, CSR, VELR, WR
|
2986 |
COMMON /STATES/ RHOL, PL, UL, HL, CSL, VELL, WL,
|
2987 |
& RHOR, PR, UR, HR, CSR, VELR, WR
|
2988 |
|
2989 |
C ---------
|
2990 |
C INTERNAL VARIABLES
|
2991 |
C ---------
|
2992 |
|
2993 |
DOUBLEPRECISION A, B, C, D, E, EPS, FA, FB, FC, TOL1,
|
2994 |
& XM, P, Q, R, S
|
2995 |
|
2996 |
C -------------
|
2997 |
C COMPUTE MACHINE PRECISION
|
2998 |
C -------------
|
2999 |
|
3000 |
EPS = 1.D0
|
3001 |
10 EPS = EPS/2.D0
|
3002 |
TOL1 = 1.D0 + EPS
|
3003 |
IF( TOL1 .GT. 1.D0) GO TO 10
|
3004 |
|
3005 |
C -------
|
3006 |
C INITIALIZATION
|
3007 |
C -------
|
3008 |
|
3009 |
A = PMIN
|
3010 |
B = PMAX
|
3011 |
CALL GETDVEL(A,FA)
|
3012 |
CALL GETDVEL(B,FB)
|
3013 |
|
3014 |
C -----
|
3015 |
C BEGIN STEP
|
3016 |
C -----
|
3017 |
|
3018 |
20 C = A
|
3019 |
FC = FA
|
3020 |
D = B - A
|
3021 |
E = D
|
3022 |
30 IF( DABS(FC) .GE. DABS(FB))GO TO 40
|
3023 |
A = B
|
3024 |
B = C
|
3025 |
C = A
|
3026 |
FA = FB
|
3027 |
FB = FC
|
3028 |
FC = FA
|
3029 |
|
3030 |
C --------
|
3031 |
C CONVERGENCE TEST
|
3032 |
C --------
|
3033 |
|
3034 |
40 TOL1 = 2.D0*EPS*DABS(B) + 0.5D0*TOL
|
3035 |
XM = 0.5D0*(C - B)
|
3036 |
IF( DABS(XM) .LE. TOL1) GO TO 90
|
3037 |
IF( FB .EQ. 0.D0) GO TO 90
|
3038 |
|
3039 |
C ------------
|
3040 |
C IS BISECTION NECESSARY?
|
3041 |
C ------------
|
3042 |
|
3043 |
IF( DABS(E) .LT. TOL1) GO TO 70
|
3044 |
IF( DABS(FA) .LE. DABS(FB)) GO TO 70
|
3045 |
|
3046 |
C ------------------
|
3047 |
C IS QUADRATIC INTERPOLATION POSSIBLE?
|
3048 |
C ------------------
|
3049 |
|
3050 |
IF( A .NE. C) GO TO 50
|
3051 |
|
3052 |
C ----------
|
3053 |
C LINEAR INTERPOLATION
|
3054 |
C ----------
|
3055 |
|
3056 |
S = FB/FA
|
3057 |
P = 2.D0*XM*S
|
3058 |
Q = 1.D0 - S
|
3059 |
GO TO 60
|
3060 |
|
3061 |
C ----------------
|
3062 |
C INVERSE QUADRATIC INTERPOLATION
|
3063 |
C ----------------
|
3064 |
|
3065 |
50 Q = FA/FC
|
3066 |
R = FB/FC
|
3067 |
S = FB/FA
|
3068 |
P = S*(2.D0*XM*Q*(Q - R) - (B - A)*(R - 1.D0))
|
3069 |
Q = (Q - 1.D0)*(R - 1.D0)*(S - 1.D0)
|
3070 |
|
3071 |
C ------
|
3072 |
C ADJUST SIGNS
|
3073 |
C ------
|
3074 |
|
3075 |
60 IF( P .GT. 0.D0) Q = -Q
|
3076 |
P = DABS(P)
|
3077 |
|
3078 |
C --------------
|
3079 |
C IS INTERPOLATION ACCEPTABLE?
|
3080 |
C --------------
|
3081 |
|
3082 |
IF( (2.D0*P) .GE. (3.D0*XM*Q-DABS(TOL1*Q))) GO TO 70
|
3083 |
IF( P .GE. DABS(0.5D0*E*Q)) GO TO 70
|
3084 |
E = D
|
3085 |
D = P/Q
|
3086 |
GO TO 80
|
3087 |
|
3088 |
C -----
|
3089 |
C BISECTION
|
3090 |
C -----
|
3091 |
|
3092 |
70 D = XM
|
3093 |
E = D
|
3094 |
|
3095 |
C -------
|
3096 |
C COMPLETE STEP
|
3097 |
C -------
|
3098 |
|
3099 |
80 A = B
|
3100 |
FA = FB
|
3101 |
IF( DABS(D) .GT. TOL1) B = B+D
|
3102 |
IF( DABS(D) .LE. TOL1) B = B+DSIGN(TOL1,XM)
|
3103 |
CALL GETDVEL(B,FB)
|
3104 |
IF( (FB*(FC/DABS(FC))) .GT. 0.D0) GO TO 20
|
3105 |
GO TO 30
|
3106 |
|
3107 |
C --
|
3108 |
C DONE
|
3109 |
C --
|
3110 |
|
3111 |
90 PS = B
|
3112 |
|
3113 |
RETURN
|
3114 |
END
|
3115 |
|
3116 |
C ---------
|
3117 |
CN NAME: G E T V E L
|
3118 |
C ---------
|
3119 |
|
3120 |
CP PURPOSE:
|
3121 |
CP COMPUTE THE FLOW VELOCITY BEHIND A RAREFACTION OR SHOCK IN TERMS OF THE
|
3122 |
CP POST-WAVE PRESSURE FOR A GIVEN STATE AHEAD THE WAVE IN A RELATIVISTIC
|
3123 |
CP FLOW
|
3124 |
C
|
3125 |
|
3126 |
CC COMMENTS:
|
3127 |
CC THIS ROUTINE CLOSELY FOLLOWS THE EXPRESSIONS IN MARTI AND MUELLER,
|
3128 |
CC J. FLUID MECH., (1994)
|
3129 |
|
3130 |
SUBROUTINE GETVEL( P, RHOA, PA, UA, HA, CSA, VELA, WA, S,
|
3131 |
& RHO, U, H, CS, VEL, VSHOCK)
|
3132 |
|
3133 |
IMPLICIT NONE
|
3134 |
|
3135 |
C -----
|
3136 |
C ARGUMENTS
|
3137 |
C -----
|
3138 |
|
3139 |
DOUBLE PRECISION P, RHOA, PA, UA, HA, CSA, VELA, WA
|
3140 |
CHARACTER*1 S
|
3141 |
DOUBLE PRECISION RHO, U, H, CS, VEL, VSHOCK
|
3142 |
|
3143 |
C -------
|
3144 |
C COMMON BLOCKS
|
3145 |
C -------
|
3146 |
|
3147 |
DOUBLE PRECISION GAMMA
|
3148 |
COMMON /ADIND/ GAMMA
|
3149 |
|
3150 |
C ---------
|
3151 |
C INTERNAL VARIABLES
|
3152 |
C ---------
|
3153 |
|
3154 |
DOUBLE PRECISION A, B, C, SIGN
|
3155 |
DOUBLE PRECISION J, WSHOCK
|
3156 |
DOUBLE PRECISION K, SQGL1
|
3157 |
|
3158 |
C ---------------
|
3159 |
C LEFT OR RIGHT PROPAGATING WAVE
|
3160 |
C ---------------
|
3161 |
|
3162 |
IF (S.EQ.'L') SIGN = -1.D0
|
3163 |
|
3164 |
IF (S.EQ.'R') SIGN = 1.D0
|
3165 |
|
3166 |
C
|
3167 |
|
3168 |
IF (P/PA - 1.D0.GT.1.D-10) THEN
|
3169 |
|
3170 |
C ---
|
3171 |
C SHOCK
|
3172 |
C ---
|
3173 |
|
3174 |
A = 1.D0+(GAMMA-1.D0)*(PA-P)/GAMMA/P
|
3175 |
B = 1.D0-A
|
3176 |
C = HA*(PA-P)/RHOA-HA**2
|
3177 |
|
3178 |
C ----------------
|
3179 |
C CHECK FOR UNPHYSICAL ENTHALPIES
|
3180 |
C ----------------
|
3181 |
|
3182 |
IF (C.GT.(B**2/4.D0/A)) STOP
|
3183 |
& 'GETVEL: UNPHYSICAL SPECIFIC ENTHALPY IN INTERMEDIATE STATE'
|
3184 |
|
3185 |
C -----------------------------
|
3186 |
C SPECIFIC ENTHALPY IN THE POST-WAVE STATE
|
3187 |
C (FROM THE EQUATION OF STATE AND THE TAUB ADIABAT,
|
3188 |
C EQ.(74), MM94)
|
3189 |
C -----------------------------
|
3190 |
|
3191 |
H = (-B+DSQRT(B**2-4.D0*A*C))/2.D0/A
|
3192 |
|
3193 |
C ---------------
|
3194 |
C DENSITY IN THE POST-WAVE STATE
|
3195 |
C (FROM EQ.(73), MM94)
|
3196 |
C ---------------
|
3197 |
|
3198 |
RHO = GAMMA*P/(GAMMA-1.D0)/(H-1.D0)
|
3199 |
|
3200 |
C ------------------------
|
3201 |
C SPECIFIC INTERNAL ENERGY IN THE POST-WAVE STATE
|
3202 |
C (FROM THE EQUATION OF STATE)
|
3203 |
C ------------------------
|
3204 |
|
3205 |
U = P/(GAMMA-1.D0)/RHO
|
3206 |
|
3207 |
C --------------------------
|
3208 |
C MASS FLUX ACROSS THE WAVE
|
3209 |
C (FROM THE RANKINE-HUGONIOT RELATIONS, EQ.(71), MM94)
|
3210 |
C --------------------------
|
3211 |
|
3212 |
J = SIGN*DSQRT((P-PA)/(HA/RHOA-H/RHO))
|
3213 |
|
3214 |
C ----------
|
3215 |
C SHOCK VELOCITY
|
3216 |
C (FROM EQ.(86), MM94
|
3217 |
C ----------
|
3218 |
|
3219 |
A = J**2+(RHOA*WA)**2
|
3220 |
B = -VELA*RHOA**2*WA**2
|
3221 |
VSHOCK = (-B+SIGN*J**2*DSQRT(1.D0+RHOA**2/J**2))/A
|
3222 |
WSHOCK = 1.D0/DSQRT(1.D0-VSHOCK**2)
|
3223 |
|
3224 |
C -------------------
|
3225 |
C FLOW VELOCITY IN THE POST-SHOCK STATE
|
3226 |
C (FROM EQ.(67), MM94)
|
3227 |
C -------------------
|
3228 |
|
3229 |
A = WSHOCK*(P-PA)/J+HA*WA*VELA
|
3230 |
B = HA*WA+(P-PA)*(WSHOCK*VELA/J+1.D0/RHOA/WA)
|
3231 |
|
3232 |
VEL = A/B
|
3233 |
|
3234 |
C ---------------------
|
3235 |
C LOCAL SOUND SPEED IN THE POST-SHOCK STATE
|
3236 |
C (FROM THE EQUATION OF STATE)
|
3237 |
C ---------------------
|
3238 |
|
3239 |
CS = DSQRT(GAMMA*P/RHO/H)
|
3240 |
|
3241 |
ELSE IF (P/PA - 1.D0.GT.0.D0) THEN
|
3242 |
|
3243 |
C --------------
|
3244 |
C ALMOST CONSTANT INTERMEDIATE STATE
|
3245 |
C --------------
|
3246 |
|
3247 |
RHO = RHOA
|
3248 |
U = UA
|
3249 |
H = 1.D0 + U + P/RHO
|
3250 |
CS = DSQRT(GAMMA*P/RHO/H)
|
3251 |
VEL = VELA
|
3252 |
VSHOCK = VELA
|
3253 |
|
3254 |
ELSE
|
3255 |
|
3256 |
C ------
|
3257 |
C RAREFACTION
|
3258 |
C ------
|
3259 |
|
3260 |
C ---------------------------
|
3261 |
C POLITROPIC CONSTANT OF THE GAS ACROSS THE RAREFACTION
|
3262 |
C ---------------------------
|
3263 |
|
3264 |
K = PA/RHOA**GAMMA
|
3265 |
|
3266 |
C ---------------
|
3267 |
C DENSITY BEHIND THE RAREFACTION
|
3268 |
C ---------------
|
3269 |
|
3270 |
RHO = (P/K)**(1.D0/GAMMA)
|
3271 |
|
3272 |
C ------------------------
|
3273 |
C SPECIFIC INTERNAL ENERGY BEHIND THE RAREFACTION
|
3274 |
C (FROM THE EQUATION OF STATE)
|
3275 |
C ------------------------
|
3276 |
|
3277 |
U = P/(GAMMA-1.D0)/RHO
|
3278 |
|
3279 |
C -----------
|
3280 |
C SPECIFIC ENTHALPY
|
3281 |
C -----------
|
3282 |
|
3283 |
H = 1.D0 + U + P/RHO
|
3284 |
C --------------------
|
3285 |
C LOCAL SOUND SPEED BEHIND THE RAREFACTION
|
3286 |
C (FROM THE EQUATION OF STATE)
|
3287 |
C --------------------
|
3288 |
|
3289 |
CS = DSQRT(GAMMA*P/RHO/H)
|
3290 |
|
3291 |
C ------------------
|
3292 |
C FLOW VELOCITY BEHIND THE RAREFACTION
|
3293 |
C ------------------
|
3294 |
|
3295 |
SQGL1 = DSQRT(GAMMA-1.D0)
|
3296 |
A = (1.D0+VELA)/(1.D0-VELA)*
|
3297 |
& ((SQGL1+CSA)/(SQGL1-CSA)*
|
3298 |
& (SQGL1-CS)/(SQGL1+CS))**(-SIGN*2.D0/SQGL1)
|
3299 |
|
3300 |
VEL = (A-1.D0)/(A+1.D0)
|
3301 |
|
3302 |
END IF
|
3303 |
END
|
3304 |
|
3305 |
C --------
|
3306 |
CN NAME: R A R E F
|
3307 |
C --------
|
3308 |
|
3309 |
CP PURPOSE:
|
3310 |
CP COMPUTE THE FLOW STATE IN A RAREFACTION FOR GIVEN PRE-WAVE STATE
|
3311 |
C
|
3312 |
|
3313 |
CC COMMENTS:
|
3314 |
CC THIS ROUTINE CLOSELY FOLLOWS THE EXPRESSIONS IN MARTI AND MUELLER,
|
3315 |
CC J. FLUID MECH., (1994)
|
3316 |
|
3317 |
SUBROUTINE RAREF( XI, RHOA, CSA, VELA, S, RHO, P, U, VEL)
|
3318 |
|
3319 |
IMPLICIT NONE
|
3320 |
|
3321 |
C -----
|
3322 |
C ARGUMENTS
|
3323 |
C -----
|
3324 |
|
3325 |
DOUBLE PRECISION XI
|
3326 |
|
3327 |
DOUBLE PRECISION RHOA, CSA, VELA
|
3328 |
|
3329 |
CHARACTER S
|
3330 |
|
3331 |
DOUBLE PRECISION RHO, P, U, VEL
|
3332 |
|
3333 |
C -------
|
3334 |
C COMMON BLOCKS
|
3335 |
C -------
|
3336 |
|
3337 |
DOUBLE PRECISION GAMMA
|
3338 |
COMMON /ADIND/ GAMMA
|
3339 |
|
3340 |
C ---------
|
3341 |
C INTERNAL VARIABLES
|
3342 |
C ---------
|
3343 |
|
3344 |
DOUBLE PRECISION B, C, D, K, L, V, OCS2, FCS2, DFDCS2, CS2, SIGN
|
3345 |
|
3346 |
C ---------------
|
3347 |
C LEFT OR RIGHT PROPAGATING WAVE
|
3348 |
C ---------------
|
3349 |
|
3350 |
IF (S.EQ.'L') SIGN = 1.D0
|
3351 |
|
3352 |
IF (S.EQ.'R') SIGN = -1.D0
|
3353 |
|
3354 |
B = DSQRT(GAMMA - 1.D0)
|
3355 |
C = (B + CSA)/(B - CSA)
|
3356 |
D = -SIGN*B/2.D0
|
3357 |
K = (1.D0 + XI)/(1.D0 - XI)
|
3358 |
L = C*K**D
|
3359 |
V = ((1.D0 - VELA)/(1.D0 + VELA))**D
|
3360 |
|
3361 |
OCS2 = CSA
|
3362 |
|
3363 |
25 FCS2 = L*V*(1.D0 + SIGN*OCS2)**D*(OCS2 - B) +
|
3364 |
& (1.D0 - SIGN*OCS2)**D*(OCS2 + B)
|
3365 |
|
3366 |
DFDCS2 = L*V*(1.D0 + SIGN*OCS2)**D*
|
3367 |
& (1.D0 + SIGN*D*(OCS2 - B)/(1.D0 + SIGN*OCS2)) +
|
3368 |
& (1.D0 - SIGN*OCS2)**D*
|
3369 |
& (1.D0 - SIGN*D*(OCS2 + B)/(1.D0 - SIGN*OCS2))
|
3370 |
|
3371 |
CS2 = OCS2 - FCS2/DFDCS2
|
3372 |
|
3373 |
IF (ABS(CS2 - OCS2)/OCS2.GT.5.E-7)THEN
|
3374 |
OCS2 = CS2
|
3375 |
GOTO 25
|
3376 |
END IF
|
3377 |
|
3378 |
VEL = (XI + SIGN*CS2)/(1.D0 + SIGN*XI*CS2)
|
3379 |
|
3380 |
RHO = RHOA*((CS2**2*(GAMMA - 1.D0 - CSA**2))/
|
3381 |
& (CSA**2*(GAMMA - 1.D0 - CS2**2)))
|
3382 |
& **(1.D0/(GAMMA - 1.D0))
|
3383 |
|
3384 |
P = CS2**2*(GAMMA - 1.D0)*RHO/(GAMMA - 1.D0 - CS2**2)/GAMMA
|
3385 |
|
3386 |
U = P/(GAMMA - 1.D0)/RHO
|
3387 |
|
3388 |
RETURN
|
3389 |
END
|
3390 |
|
3391 |
C --------
|
3392 |
CN NAME: F I L N A M
|
3393 |
C --------
|
3394 |
|
3395 |
CP PURPOSE:
|
3396 |
CP CONSTRUCTS NEW FILENAMES FOR OUTPUT AND RESTART FILES
|
3397 |
C
|
3398 |
|
3399 |
CC COMMENTS:
|
3400 |
CC NONE
|
3401 |
|
3402 |
SUBROUTINE FILNAM
|
3403 |
|
3404 |
IMPLICIT NONE
|
3405 |
|
3406 |
C ---------
|
3407 |
C COMMON BLOCKS
|
3408 |
C ---------
|
3409 |
|
3410 |
CHARACTER*7 OUTFIL
|
3411 |
CHARACTER*8 LABEL
|
3412 |
CHARACTER*4 BASENM
|
3413 |
CHARACTER*2 SUFFIX
|
3414 |
CHARACTER*1 SF1,SF2
|
3415 |
|
3416 |
COMMON /CHRC/ LABEL,OUTFIL,BASENM,SUFFIX
|
3417 |
|
3418 |
C ---------
|
3419 |
C INTERNAL VARIABLES
|
3420 |
C ---------
|
3421 |
|
3422 |
INTEGER ISF1,ISF2
|
3423 |
|
3424 |
IF (SUFFIX(2:2).EQ.'z'.OR.SUFFIX(2:2).EQ.'Z') THEN
|
3425 |
SF1 = SUFFIX(1:1)
|
3426 |
ISF1 = ICHAR(SF1)
|
3427 |
SF2 = SUFFIX(2:2)
|
3428 |
ISF2 = ICHAR(SF2)
|
3429 |
|
3430 |
ISF1 = ISF1 + 1
|
3431 |
ISF2 = ISF2 - 25
|
3432 |
SUFFIX(1:1) = CHAR(ISF1)
|
3433 |
SUFFIX(2:2) = CHAR(ISF2)
|
3434 |
ELSE
|
3435 |
SF2 = SUFFIX(2:2)
|
3436 |
ISF2 = ICHAR(SF2)
|
3437 |
ISF2 = ISF2 + 1
|
3438 |
SUFFIX(2:2) = CHAR(ISF2)
|
3439 |
END IF
|
3440 |
|
3441 |
OUTFIL = BASENM // 'O' // SUFFIX
|
3442 |
|
3443 |
RETURN
|
3444 |
END
|
3445 |
|
3446 |
C --------
|
3447 |
CN NAME: G E T P R F Q
|
3448 |
C --------
|
3449 |
|
3450 |
CP PURPOSE:
|
3451 |
CP COMPUTE THE PRIMITIVE QUANTITIES FROM THE CONSERVED ONES
|
3452 |
C
|
3453 |
|
3454 |
CC COMMENTS:
|
3455 |
CC PRIMITIVE VARIABLES ARE OBTAINED BY SOLVING AN IMPLICIT EQUATION FOR
|
3456 |
CC THE PRESSURE BY MEANS OF A NEWTON-RAPHSON METHOD. HARDWIRED FOR A
|
3457 |
CC CONSTANT-GAMMA IDEAL GAS
|
3458 |
|
3459 |
SUBROUTINE GETPRFQ(N,R,M,E,
|
3460 |
& VEL,W,RHO,U,P,H,CS,DPDRH,DPDU)
|
3461 |
|
3462 |
IMPLICIT NONE
|
3463 |
|
3464 |
INCLUDE 'size'
|
3465 |
|
3466 |
C -------
|
3467 |
C ARGUMENTS
|
3468 |
C -------
|
3469 |
|
3470 |
INTEGER N
|
3471 |
|
3472 |
DOUBLEPRECISION P(-4:MN5),RHO(-4:MN5),VEL(-4:MN5),
|
3473 |
& U(-4:MN5),CS(-4:MN5),W(-4:MN5),H(-4:MN5),
|
3474 |
& DPDRH(-4:MN5),DPDU(-4:MN5)
|
3475 |
|
3476 |
DOUBLEPRECISION R(-4:MN5),M(-4:MN5),E(-4:MN5)
|
3477 |
|
3478 |
C ---------
|
3479 |
C COMMON BLOCKS
|
3480 |
C ---------
|
3481 |
|
3482 |
INTEGER NEND,NOUT,ITSTP,NX
|
3483 |
COMMON /INPTI/ NEND,NOUT,ITSTP,NX
|
3484 |
|
3485 |
DOUBLEPRECISION TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,
|
3486 |
& SMALLU,GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
3487 |
COMMON /INPTF/ TMAX,TOUT,CFL,DTINI,SMALL,SMLRHO,SMALLP,
|
3488 |
& SMALLU,GRIDLX,EPSILN,ETA1,ETA2,EPSLN,AK0,OMG1,OMG2
|
3489 |
|
3490 |
DOUBLEPRECISION GB
|
3491 |
COMMON /ADIND/ GB
|
3492 |
|
3493 |
DOUBLEPRECISION TIME,DT
|
3494 |
COMMON /ZEIT/ TIME,DT
|
3495 |
|
3496 |
C ---------
|
3497 |
C INTERNAL VARIABLES
|
3498 |
C ---------
|
3499 |
|
3500 |
INTEGER I,COUNT
|
3501 |
|
3502 |
DOUBLEPRECISION MOMENT,VELCTY
|
3503 |
|
3504 |
DOUBLEPRECISION PMIN(-4:MN5),PMAX,OP(-4:MN5)
|
3505 |
|
3506 |
DOUBLEPRECISION FP,DFDP,ERRP
|
3507 |
|
3508 |
DO 5 I=1,N
|
3509 |
|
3510 |
R(I) = DMAX1(R(I),SMLRHO)
|
3511 |
E(I) = DMAX1(E(I),SMALLU)
|
3512 |
|
3513 |
5 CONTINUE
|
3514 |
|
3515 |
DO 9 I=1,N
|
3516 |
|
3517 |
COUNT = 0
|
3518 |
|
3519 |
MOMENT = DABS(M(I))
|
3520 |
PMIN(I) = DMAX1(MOMENT - E(I) - R(I) + MOMENT*SMALL,SMALLP)
|
3521 |
PMAX = (GB-1.D0)*E(I)
|
3522 |
IF (PMIN(I).GT.PMAX) GOTO 990
|
3523 |
|
3524 |
OP(I) = 0.5D0*(PMIN(I)+PMAX)
|
3525 |
|
3526 |
8 COUNT = COUNT + 1
|
3527 |
OP(I) = DMAX1(OP(I),PMIN(I))
|
3528 |
VELCTY = MOMENT/(E(I) + R(I) + OP(I))
|
3529 |
W(I) = 1.D0/DSQRT(1.D0 - VELCTY*VELCTY)
|
3530 |
FP = (GB - 1.D0)*(E(I) + R(I)*(1.D0 - W(I))+
|
3531 |
& OP(I)*(1.D0 - W(I)*W(I)))/W(I)/W(I) - OP(I)
|
3532 |
DFDP = (GB - 1.D0)*VELCTY*VELCTY*
|
3533 |
& (E(I) + R(I)*(1.D0 - W(I))+OP(I))/
|
3534 |
& (E(I) + R(I) + OP(I)) - 1.D0
|
3535 |
|
3536 |
P(I) = DMAX1(OP(I) - FP/DFDP,PMIN(I))
|
3537 |
|
3538 |
ERRP = DABS(1.D0 - P(I)/OP(I))
|
3539 |
|
3540 |
OP(I) = P(I)
|
3541 |
|
3542 |
IF (COUNT.GE.10000) GOTO 999
|
3543 |
|
3544 |
IF (ERRP.GT.1.D-8) GOTO 8
|
3545 |
|
3546 |
VEL(I) = M(I)/(E(I)+R(I)+OP(I))
|
3547 |
IF (DABS(VEL(I)) .LT.SMALL*SMALL) VEL(I) = 0.D0
|
3548 |
|
3549 |
RHO(I) = R(I)/W(I)
|
3550 |
|
3551 |
9 CONTINUE
|
3552 |
|
3553 |
DO 30 I=1,N
|
3554 |
|
3555 |
U(I) = P(I)/(GB - 1.D0)/RHO(I)
|
3556 |
|
3557 |
IF (P(I).EQ.PMIN(I)) THEN
|
3558 |
WRITE(6,*) 'GETPRFQ: MINIMUM PRESSURE REACHED AT POINT:'
|
3559 |
WRITE(6,*) ' I = ', I,' T = ', TIME
|
3560 |
END IF
|
3561 |
|
3562 |
30 CONTINUE
|
3563 |
|
3564 |
CALL EOS(N,RHO,U,GB,P,H,CS,DPDRH,DPDU)
|
3565 |
|
3566 |
GOTO 1000
|
3567 |
|
3568 |
990 WRITE(6,*) 'GETPRFQ: NO PHYSICAL PRESSURE AVAILABLE'
|
3569 |
WRITE(6,*) ' T = ', TIME
|
3570 |
WRITE(6,*) ' I = ', I
|
3571 |
WRITE(6,*) ' R = ', R(I), ' MOMENT = ', MOMENT
|
3572 |
WRITE(6,*) ' E = ', E(I)
|
3573 |
WRITE(6,*) ' MOMENT-E-D = ', MOMENT - R(I) - E(I)
|
3574 |
WRITE(6,*) ' (GB-1)E = ', (GB - 1.D0)*E(I)
|
3575 |
STOP
|
3576 |
|
3577 |
999 WRITE(6,*) 'GETPRFQ: NON CONVERGENCE IN PRESSURE'
|
3578 |
WRITE(6,*) ' T = ', TIME
|
3579 |
WRITE(6,*) ' I = ', I
|
3580 |
WRITE(6,*) ' P = ', P(I), ' PMIN = ', PMIN(I)
|
3581 |
WRITE(6,*) ' R = ', R(I), ' M = ', M(I)
|
3582 |
WRITE(6,*) ' E = ', E(I)
|
3583 |
WRITE(6,*) ' VEL = ', VEL(I)
|
3584 |
STOP
|
3585 |
|
3586 |
1000 CONTINUE
|
3587 |
|
3588 |
RETURN
|
3589 |
END
|