File: RELATIVE:/../../../mfix.git/model/interactive_mod.f
1 MODULE INTERACTIVE
2
3 use param1, only: UNDEFINED_I, UNDEFINED, UNDEFINED_C
4 use error_manager
5
6 IMPLICIT NONE
7
8 PUBLIC :: INTERACT
9 PUBLIC :: CHECK_INTERACT_ITER
10 PUBLIC :: CHECK_TIMESTEP_FAIL_RATE
11 PUBLIC :: INIT_INTERACTIVE_MODE
12
13 PRIVATE
14
15
16
17 INTEGER :: ACTION
18
19 INTEGER, PARAMETER :: NULL_ENUM=0
20
21 INTEGER, PARAMETER :: WAIT_ENUM=1
22
23 INTEGER, PARAMETER :: EXIT_ENUM=2
24
25 INTEGER, PARAMETER :: ABORT_ENUM=3
26
27
28 INTEGER, PARAMETER :: NSTEPS_ENUM=10
29
30 INTEGER, PARAMETER :: WAIT_AT_ENUM=11
31
32 INTEGER, PARAMETER :: BCKUP_RES_ENUM=20
33
34 INTEGER, PARAMETER :: WRITE_RES_ENUM=21
35
36 INTEGER, PARAMETER :: READ_RES_ENUM=22
37
38 INTEGER, PARAMETER :: REINITIALIZE_ENUM=100
39
40
41
42
43 INTEGER, PARAMETER :: ACT_DIMN=50
44
45 INTEGER :: ACTION_INT(ACT_DIMN)
46
47 DOUBLE PRECISION :: ACTION_DP(ACT_DIMN)
48
49 CHARACTER(LEN=256), DIMENSION(ACT_DIMN) :: ACTION_STR
50
51
52
53
54 INTEGER :: USER_DEFINED_STEPS = UNDEFINED_I
55 INTEGER :: USER_DEFINED_NITS = UNDEFINED_I
56 INTEGER :: STEP_CNT
57
58 DOUBLE PRECISION :: USER_WAIT_AT_TIME = UNDEFINED
59
60 INTEGER :: HISTORY_POS
61 DOUBLE PRECISION :: FAILRATE, MAX_FAILRATE
62 INTEGER, ALLOCATABLE :: TIMESTEP_HISTORY(:)
63
64 CONTAINS
65
66
67
68
69
70
71
72
73 SUBROUTINE INTERACT(pEXIT_SIGNAL, pABORT_SIGNAL)
74
75 use compar, only: myPE, PE_IO
76
77 use mpi_utility
78 use error_manager
79
80 LOGICAL :: INTERACTING
81
82 LOGICAL, INTENT(INOUT) :: pEXIT_SIGNAL
83 LOGICAL, INTENT(OUT) :: pABORT_SIGNAL
84
85 pABORT_SIGNAL = .FALSE.
86
87 write(*,*) 'In the INTERACT ROUTINE'
88
89 CALL CHECK_INTERACT_SIGNAL(INTERACTING)
90
91 DO WHILE(INTERACTING)
92
93 CALL GET_INTERACTIVE_DATA
94
95 SELECT CASE(ACTION)
96 CASE(NULL_ENUM)
97 INTERACTING = .FALSE.
98
99 CASE(WAIT_ENUM)
100 INTERACTING = .TRUE.
101
102 CASE(EXIT_ENUM)
103 pEXIT_SIGNAL = .TRUE.
104 INTERACTING = .FALSE.
105
106 CASE(ABORT_ENUM)
107 pABORT_SIGNAL = .TRUE.
108 INTERACTING = .FALSE.
109
110 CASE(NSTEPS_ENUM)
111 CALL CHECK_INTERACTIVE_NSTEPS(INTERACTING)
112
113 CASE(WAIT_AT_ENUM)
114 CALL CHECK_INTERACTIVE_WAIT_AT(INTERACTING)
115
116 CASE(BCKUP_RES_ENUM)
117 CALL CHECK_RES_ACTION
118 INTERACTING = .TRUE.
119
120 CASE(WRITE_RES_ENUM)
121 CALL CHECK_RES_ACTION
122 INTERACTING = .TRUE.
123
124 CASE(READ_RES_ENUM)
125 CALL CHECK_RES_ACTION
126 INTERACTING = .TRUE.
127
128 CASE(REINITIALIZE_ENUM)
129 CALL REINITIALIZE
130 INTERACTING = .TRUE.
131
132 CASE DEFAULT
133 CALL UNKNOWN_INTERACTIVE_CMD
134 INTERACTING = .TRUE.
135
136 END SELECT
137
138 IF(INTERACTING) CALL INTERACTIVE_WAIT
139 ENDDO
140
141 RETURN
142 END SUBROUTINE INTERACT
143
144
145
146
147
148
149
150
151
152
153 SUBROUTINE CHECK_INTERACT_SIGNAL(pINTERACT)
154
155 use compar, only: myPE, PE_IO
156 use param1, only: UNDEFINED_I, UNDEFINED
157 use run, only: INTERUPT
158 use run, only: TIME, DT
159
160 use mpi_utility
161
162 LOGICAL, INTENT(OUT) :: pINTERACT
163
164
165 IF(myPE == PE_IO) THEN
166
167 IF(INTERUPT) THEN
168 pINTERACT = .TRUE.
169 INTERUPT = .FALSE.
170 CALL INTERACTIVE_WAIT
171 ELSE
172 INQUIRE(file="interact.dat", exist=pINTERACT)
173 ENDIF
174
175 IF(.NOT.pINTERACT .AND. USER_DEFINED_STEPS /= UNDEFINED_I) THEN
176 STEP_CNT = STEP_CNT + 1
177 IF(STEP_CNT >= USER_DEFINED_STEPS) THEN
178 STEP_CNT = UNDEFINED_I
179 USER_DEFINED_STEPS = UNDEFINED_I
180 pINTERACT = .TRUE.
181 CALL INTERACTIVE_WAIT
182 ENDIF
183 ENDIF
184
185 IF(.NOT.pINTERACT .AND. USER_WAIT_AT_TIME /= UNDEFINED) THEN
186 IF(TIME + 0.1d0*DT >= USER_WAIT_AT_TIME) THEN
187 USER_WAIT_AT_TIME = UNDEFINED
188 pINTERACT = .TRUE.
189 CALL INTERACTIVE_WAIT
190 ENDIF
191 ENDIF
192
193
194 ENDIF
195
196 CALL BCAST(pINTERACT, PE_IO)
197
198 RETURN
199 END SUBROUTINE CHECK_INTERACT_SIGNAL
200
201
202
203
204
205
206
207
208
209
210 SUBROUTINE CHECK_INTERACT_ITER(iMUSTIT)
211
212 use run, only: INTERACTIVE_NITS
213
214 INTEGER, INTENT(OUT) :: iMUSTIT
215 LOGICAL :: INTERACTING
216
217 INTERACTIVE_NITS = INTERACTIVE_NITS - 1
218
219 IF(INTERACTIVE_NITS > 0) THEN
220 iMUSTIT = 1
221 RETURN
222 ENDIF
223
224 iMUSTIT = 0
225 INTERACTIVE_NITS = UNDEFINED_I
226
227 CALL INTERACTIVE_WAIT
228
229 INTERACTING = .TRUE.
230 DO WHILE(INTERACTING)
231
232 CALL GET_INTERACTIVE_DATA
233
234 SELECT CASE(ACTION)
235 CASE(NULL_ENUM)
236 INTERACTING = .FALSE.
237
238 CASE(WAIT_ENUM)
239 INTERACTING = .TRUE.
240
241 CASE(NSTEPS_ENUM)
242 CALL CHECK_INTERACTIVE_NSTEPS(INTERACTING)
243 IF(INTERACTIVE_NITS /= UNDEFINED_I) iMUSTIT = 1
244
245 CASE(WAIT_AT_ENUM)
246 CALL CHECK_INTERACTIVE_WAIT_AT(INTERACTING)
247
248 CASE DEFAULT
249 CALL UNAVAILABLE_INTERACTIVE_CMD
250 INTERACTING = .TRUE.
251
252 END SELECT
253
254 IF(INTERACTING) CALL INTERACTIVE_WAIT
255 ENDDO
256
257
258 RETURN
259 END SUBROUTINE CHECK_INTERACT_ITER
260
261
262
263
264
265
266
267
268
269 SUBROUTINE CHECK_INTERACTIVE_WAIT_AT(pINTERACT)
270
271 use compar, only: myPE, PE_IO
272
273 LOGICAL, INTENT(OUT) :: pINTERACT
274
275 IF(ACTION_DP(1) == UNDEFINED_I) THEN
276 IF(myPE == PE_IO) THEN
277 WRITE(*,*) ' '
278 WRITE(*,*) ' ACTION: WAIT_AT is not fully specified.'
279 WRITE(*,*) ' I will wait until you fix it...'
280 WRITE(*,*) ' '
281 ENDIF
282 pINTERACT = .TRUE.
283 ELSE
284 USER_WAIT_AT_TIME = ACTION_DP(1)
285 pINTERACT = .FALSE.
286 ENDIF
287
288 RETURN
289 END SUBROUTINE CHECK_INTERACTIVE_WAIT_AT
290
291
292
293
294
295
296
297
298
299
300
301 SUBROUTINE UNKNOWN_INTERACTIVE_CMD
302
303 use compar, only: myPE, PE_IO
304
305 IF(myPE == PE_IO) THEN
306 WRITE(*,*) ' '
307 WRITE(*,*) ' '
308 WRITE(*,*) ' Unknown interactive command.'
309 WRITE(*,*) ' Enter a different command.'
310 WRITE(*,*) ' '
311 ENDIF
312
313 RETURN
314 END SUBROUTINE UNKNOWN_INTERACTIVE_CMD
315
316
317
318
319
320
321
322
323
324 SUBROUTINE UNAVAILABLE_INTERACTIVE_CMD
325
326 use compar, only: myPE, PE_IO
327
328 IF(myPE == PE_IO) THEN
329 WRITE(*,*) ' '
330 WRITE(*,*) ' '
331 WRITE(*,*) ' Unavailable interactive command.'
332 WRITE(*,*) ' Enter a different command.'
333 WRITE(*,*) ' '
334 ENDIF
335
336 RETURN
337 END SUBROUTINE UNAVAILABLE_INTERACTIVE_CMD
338
339
340
341
342
343
344
345
346
347 SUBROUTINE CHECK_INTERACTIVE_NSTEPS(pINTERACT)
348
349 use run, only: INTERACTIVE_NITS
350 use compar, only: myPE, PE_IO
351
352 LOGICAL, INTENT(OUT) :: pINTERACT
353
354 IF(ACTION_INT(1) == UNDEFINED_I) THEN
355 IF(myPE == PE_IO) THEN
356 WRITE(*,*) ' '
357 WRITE(*,*) ' ACTION: NSTEPS is not fully specified.'
358 WRITE(*,*) ' I will wait until you fix it...'
359 WRITE(*,*) ' '
360 ENDIF
361 pINTERACT = .TRUE.
362 ELSE
363 USER_DEFINED_STEPS = ACTION_INT(1)
364 STEP_CNT = 0
365 pINTERACT = .FALSE.
366 ENDIF
367
368 IF(USER_DEFINED_STEPS > 0) RETURN
369
370 IF(ACTION_INT(2) == UNDEFINED_I) THEN
371 IF(myPE == PE_IO)THEN
372 WRITE(*,*) ' '
373 WRITE(*,*) ' ACTION: NSTEPS=0 is not fully specified.'
374 WRITE(*,*) ' I will wait until you fix it...'
375 WRITE(*,*) ' '
376 ENDIF
377 pINTERACT=.TRUE.
378 ELSE
379 INTERACTIVE_NITS = ACTION_INT(2)
380 ENDIF
381
382
383 RETURN
384 END SUBROUTINE CHECK_INTERACTIVE_NSTEPS
385
386
387
388
389
390
391
392
393
394 SUBROUTINE CHECK_RES_ACTION
395
396 use run, only: RUN_NAME, TIME
397
398 use compar, only: myPE, PE_IO
399
400 LOGICAL :: EXISTS
401
402 CHARACTER(LEN=128) :: tFNAME
403 CHARACTER(LEN=256) :: CMD
404
405 DOUBLE PRECISION :: lTIME
406
407 IF(ACTION_STR(1) == UNDEFINED_C) THEN
408 IF(ACTION == BCKUP_RES_ENUM .OR. &
409 ACTION == READ_RES_ENUM) THEN
410 IF(myPE == PE_IO) THEN
411 WRITE(*,*) ' '
412 WRITE(*,*) ' ACTION: BCKUP_RES is not fully specified.'
413 WRITE(*,*) ' I will wait until you fix it...'
414 WRITE(*,*) ' '
415 ENDIF
416 RETURN
417 ENDIF
418 ELSEIF(myPE == PE_IO) THEN
419 tFNAME=''; WRITE(tFNAME,"(A,'.RES')") trim(RUN_NAME)
420 WRITE(*,*) 'Create RES backup: ',trim(ACTION_STR(1))
421 CMD=''; WRITE(CMD,"('cp ',2(1x,A))") &
422 trim(tFNAME), trim(ACTION_STR(1))
423
424 write(*,*) trim(CMD)
425 CALL SYSTEM(trim(CMD))
426 ENDIF
427
428 IF(ACTION == WRITE_RES_ENUM) THEN
429 IF(myPE==PE_IO) WRITE(*,*) 'Writing RES file.'
430 CALL WRITE_RES1
431
432 ELSEIF(ACTION == READ_RES_ENUM) THEN
433 IF(ACTION_STR(2) == UNDEFINED_C) THEN
434 IF(myPE == PE_IO) THEN
435 WRITE(*,*) ' '
436 WRITE(*,*) ' ACTION: READ_RES is not fully specified.'
437 WRITE(*,*) ' I will wait until you fix it...'
438 WRITE(*,*) ' '
439 ENDIF
440 RETURN
441 ELSE
442 INQUIRE(FILE=trim(ACTION_STR(2)), EXIST=EXISTS)
443 IF(.NOT.EXISTS)THEN
444 IF(myPE == PE_IO) THEN
445 WRITE(*,*) ' '
446 WRITE(*,*) ' ACTION: READ_RES is missing.'
447 WRITE(*,*) ' I will wait until you fix it...'
448 WRITE(*,*) ' '
449 RETURN
450 ENDIF
451 ENDIF
452 ENDIF
453 IF(myPE==PE_IO) WRITE(*,*) 'Reading RES file.'
454 tFNAME=''; WRITE(tFNAME,"(A,'.RES')") trim(RUN_NAME)
455 CMD=''; WRITE(CMD,"('cp ',2(1x,A))") &
456 trim(ACTION_STR(2)), trim(tFNAME)
457 write(*,*) trim(CMD)
458 CALL SYSTEM(trim(CMD))
459
460 lTIME = TIME
461 CALL READ_RES1
462 TIME = lTIME
463 ENDIF
464
465 RETURN
466 END SUBROUTINE CHECK_RES_ACTION
467
468
469
470
471
472
473
474
475
476 SUBROUTINE GET_INTERACTIVE_DATA
477
478 CALL INTERACTIVE_DATA_INIT
479 CALL INTERACTIVE_DATA_READ
480 CALL INTERACTIVE_DATA_FINL
481
482 RETURN
483 END SUBROUTINE GET_INTERACTIVE_DATA
484
485
486
487
488
489
490
491
492
493
494 SUBROUTINE INTERACTIVE_DATA_INIT
495
496 use error_manager
497
498 ACTION = NULL_ENUM
499
500 ACTION_INT = UNDEFINED_I
501 ACTION_DP = UNDEFINED
502 ACTION_STR = UNDEFINED_C
503
504 RETURN
505 END SUBROUTINE INTERACTIVE_DATA_INIT
506
507
508
509
510
511
512
513
514
515
516 SUBROUTINE INTERACTIVE_DATA_READ
517
518 use funits, only: UNIT_DAT
519 use error_manager
520
521 INTEGER :: IOS
522 CHARACTER(LEN=512) :: LINE_STRING, STRING
523
524 NAMELIST / INTERACT_INPUT / ACTION, &
525 ACTION_INT, ACTION_DP, ACTION_STR
526
527 OPEN(UNIT=UNIT_DAT, FILE='interact.dat', STATUS='OLD', IOSTAT=IOS)
528
529 READ_LP: DO
530 READ(UNIT_DAT,"(A)",IOSTAT=IOS) LINE_STRING
531 IF(IOS < 0) EXIT READ_LP
532
533 =''; STRING = '&INTERACT_INPUT '//&
534 trim(adjustl(LINE_STRING))//'/'
535
536 READ(STRING, NML=INTERACT_INPUT, IOSTAT=IOS)
537 ENDDO READ_LP
538
539 CLOSE(UNIT_DAT)
540
541 RETURN
542 END SUBROUTINE INTERACTIVE_DATA_READ
543
544
545
546
547
548
549
550
551
552
553 SUBROUTINE INTERACTIVE_DATA_FINL
554
555 use compar, only: myPE, PE_IO
556 use mpi_utility
557
558 CALL MPI_BARRIER(MPI_COMM_WORLD,MPIERR)
559 IF(myPE == PE_IO) CALL SYSTEM('rm interact.dat')
560
561
562 RETURN
563 END SUBROUTINE INTERACTIVE_DATA_FINL
564
565
566
567
568
569
570
571
572
573 SUBROUTINE INTERACTIVE_WAIT
574
575 use compar, only: myPE, PE_IO
576 use mpi_utility
577
578 use run, only: INTERUPT
579
580 LOGICAL :: FOUND
581
582 IF(myPE == PE_IO) THEN
583 DO; INQUIRE(file="interact.dat", exist=FOUND)
584 IF(FOUND) EXIT
585 IF(.NOT.INTERUPT) EXIT
586 CALL SLEEP(1)
587 write(*,*) 'I am waiting...'
588 ENDDO
589 ENDIF
590
591 CALL MPI_BARRIER(MPI_COMM_WORLD,MPIERR)
592
593 RETURN
594 END SUBROUTINE INTERACTIVE_WAIT
595
596
597
598
599
600
601
602
603
604
605 SUBROUTINE CHECK_TIMESTEP_FAIL_RATE(IER)
606
607 use run, only: INTERUPT
608 use run, only: TIMESTEP_FAIL_RATE
609
610 INTEGER, INTENT(IN) :: IER
611 INTEGER :: WINDOW, NEW, OLD
612
613 WINDOW = TIMESTEP_FAIL_RATE(2)
614
615 NEW = merge(0,1, IER == 0)
616 OLD = TIMESTEP_HISTORY(HISTORY_POS)
617
618 TIMESTEP_HISTORY(HISTORY_POS) = NEW
619 HISTORY_POS = MOD(HISTORY_POS, WINDOW) + 1
620
621 FAILRATE = FAILRATE + DBLE(NEW-OLD)/DBLE(WINDOW)
622
623 IF(FAILRATE >= MAX_FAILRATE) THEN
624 INTERUPT = .TRUE.
625 FAILRATE = 0.0
626 WRITE(ERR_MSG, 1000) trim(iVal(TIMESTEP_FAIL_RATE(1))), &
627 trim(iVal(TIMESTEP_FAIL_RATE(2)))
628 CALL FLUSH_ERR_MSG(HEADER=.FALSE.)
629 ENDIF
630
631 1000 FORMAT(2/,70('*'),/'DT reduced ',A,' times over the last ',A,1x, &
632 'steps. The current time step was',/'reset. User action is ', &
633 'required.')
634
635 RETURN
636 END SUBROUTINE CHECK_TIMESTEP_FAIL_RATE
637
638
639
640
641
642
643
644
645
646
647 SUBROUTINE INIT_INTERACTIVE_MODE
648
649 use run, only: TIMESTEP_FAIL_RATE
650
651 ALLOCATE(TIMESTEP_HISTORY(TIMESTEP_FAIL_RATE(2)))
652 TIMESTEP_HISTORY = 0
653
654 HISTORY_POS = 1
655 FAILRATE = 0.0
656 MAX_FAILRATE = dble(TIMESTEP_FAIL_RATE(1)) / &
657 dble(TIMESTEP_FAIL_RATE(2))
658
659 RETURN
660 END SUBROUTINE INIT_INTERACTIVE_MODE
661
662
663
664 END MODULE INTERACTIVE
665