-
Notifications
You must be signed in to change notification settings - Fork 39
/
Copy pathmain.f90
1155 lines (1155 loc) · 36.5 KB
/
main.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
program GFR_main
!
use module_kind_types
!
use geovar, only : ncell,n_global_cell
use geovar, only : nnode,n_global_node
use geovar, only : nfbnd,n_global_fbnd
use geovar, only : n_solpts,n_global_solpts
use geovar, only : bface,xyz_nodes,nface
use geovar, only : cell_geom,cell_order,global_cell_order
use geovar, only : nodes_of_cell_ptr,nodes_of_cell
!
use ovar, only : metis_option,convergence_reached
use ovar, only : total_volume,local_volume,itestcase
use ovar, only : num_rk_stages,Runge_Kutta_Scheme
use ovar, only : time,time_ref,itcur,num_timesteps,rl2mx
use ovar, only : governing_equations,visc_flux_method
use ovar, only : results_interval,iter_out_interval
use ovar, only : restart_interval,output_interval
use ovar, only : dump_memory_usage,mms_opt
use ovar, only : gfr_cpu_time,this_is_final_timestep
use ovar, only : write_TaylorGreen_8s_solution
use ovar, only : write_TaylorGreen_full_solution
use ovar, only : continuous_output,completely_disable_cgns
use ovar, only : check_flux_point_coordinates
use ovar, only : cfl,cfl_beg,cfl_end,cfl_cycles
use ovar, only : adjust_cfl_cycles
use ovar, only : output_time_averaging,time_scaling_factor
use ovar, only : time_average_restart_files,ave_start_time
use ovar, only : Filtering_Interval,Limiting_Interval
!
use input_namelist_mod, only : cfl_adjustment
use input_namelist_mod, only : restart_interupt
!
use flowvar, only : usp,uoldsp
!
use quadrature_mod, only : solpts_edge
!
use io_mod, only : read_input_file
use io_mod, only : write_final_error
use io_mod, only : write_parallel_cgns
use io_mod, only : write_residual_file
use io_mod, only : check_face_flux_point_orderings
use io_mod, only : check_cell_flux_point_orderings
use io_mod, only : TaylorGreen_8s_vorticity_solution
!
use restart_mod, only : write_restart_file
!
use mappings_mod, only : get_solution_points
!
use connectivity_mod, only : get_grid_connectivity
!
use metrics_mod, only : get_metrics
!
use vandermonde_mod, only : init_vandermonde_matrices
!
use derivatives_mod, only : init_derivative_matrices
!
use correction_mod, only : init_correction_matrices
!
use interpolation_mod, only : init_interpolation_matrices
use interpolation_mod, only : init_outerpolation_matrices
!
use projection_mod, only : init_projection_matrices
!
use filter_mod, only : init_filter_matrices
!
use initialization_mod, only : initialize_flow
!
use module_bc, only : get_faceusp_bc
use module_bc, only : get_facedusp_bc
!
use generic_mod, only : init_generic_mod
use generic_mod, only : write_iter_stats
use generic_mod, only : getmaxent
use generic_mod, only : compute_residual_error
use generic_mod, only : compute_TaylorGreen_KEDR
!
use time_mod, only : get_dtsp
use time_mod, only : rresi
use time_mod, only : rupdate_Classic_RK
use time_mod, only : rupdate_CK4_RK
use time_mod, only : rupdate_TVD2_RK
use time_mod, only : rupdate_TVD3_RK
use time_mod, only : rupdate_TVD4_RK
use time_mod, only : update_time_ave
use time_mod, only : initialize_time_ave
!
use flux_mod, only : interp_cv_to_flxpts
use flux_mod, only : interp_dusp_to_flxpts
use flux_mod, only : flux_gradient_at_solpts_visc
use flux_mod, only : correct_interface_flux_visc
use flux_mod, only : discontinuous_gradient_at_solpts
use flux_mod, only : correct_gradients_at_solpts
use flux_mod, only : correct_gradients_br2
!
use parallel_mod, only : partition_grid
use parallel_mod, only : create_serial_cell_map
!
use module_limiters, only : initialize_limiters
use module_limiters, only : compute_cell_ave
!
use mms_mod, only : mms_src
use mms_mod, only : initialize_mms
!
use channel_mod, only : channel_source
!
use bnd_profiles_mod, only : init_bnd_profile_structures
use bnd_profiles_mod, only : compute_bnd_profiles
!
use postprocessor_mod, only : new_write_parallel_cgns
!
use pbs_mod, only : pbs_remaining_walltime
!
use cpu_info_mod, only : get_cpu_locality
!
use averaging_mod, only : average_restart_files
!
use, intrinsic :: iso_c_binding, only : c_long
!
implicit none
!
character(len=*), parameter :: pname = "GFR_main"
!
integer :: iter,nst,i,ierr,k,npart
integer :: completed_timesteps
integer :: newton_failures
real(wp) :: dtmin,out_time
!
character(len=50) :: memfile
!
integer :: CGNS_action
!
logical(lk) :: completed_initial_cgns_output
logical(lk) :: exit_main_loop
logical(lk) :: walltime_expiring
!
logical(ldk) :: request_stop
logical(ldk) :: request_restart
logical(ldk) :: request_solution
logical(ldk) :: request_cfl_adjustment
logical(ldk) :: request_restart_interupt
logical(ldk) :: request_time_ave
logical(ldk) :: request_array(1:6)
!
logical(lk) :: Apply_Filter
logical(lk) :: Apply_Limiter
!
!logical(lk), parameter :: ignore_errors = true
logical(lk), parameter :: ignore_errors = fals
!
real(wp) :: cfl_tmp(1:4)
!
continue
!
request_restart = .false.
request_solution = .false.
request_time_ave = .false.
request_restart_interupt = .false.
request_cfl_adjustment = .false.
request_stop = .false.
completed_initial_cgns_output = fals
!
! Initialize the overall MPI session
!
call initialize_mpi_environment
!
call get_cpu_locality
!
! Initialize the wall time
!
call gfr_cpu_time(0)
!
! Get the number of seconds allowed for this simulation
!
call pbs_remaining_walltime(walltime_expiring)
!
! Initialize all the random constants that must be initialized at run time
!
call initialize_runtime_parameters
call memory_pause("base initializations","reading input and grid files")
!
! Read in the input file
!
call read_input_file
call memory_pause("reading input and grid files","partitioning the grid")
!
! Partition the grid if using more than one processor.
! Upon entry: These arrays define the global grid
! Upon return: These arrays define the partition local
! to the respective processor along with
! connectivities for the partition boundaries
npart = ncpu
if (npart > 1) then
call partition_grid(npart,metis_option,bface,nodes_of_cell, &
nodes_of_cell_ptr,xyz_nodes,cell_geom,cell_order)
call memory_pause("partitioning the grid","getting the solution points")
else
call create_serial_cell_map(ncell)
call memory_pause("getting serial cell map","getting the solution points")
end if
!
! Get the coordinates of the solution points within each grid cell
!
call get_solution_points
call memory_pause("getting the solution points","getting grid connectivity")
!
! Get the grid connectivity and metrics
!
call get_grid_connectivity(bface,cell_geom,cell_order,xyz_nodes, &
nodes_of_cell,nodes_of_cell_ptr)
call memory_pause("getting grid connectivity", &
"initializing vandermonde matrices")
!
! Compute the remaining quadrature information
! (Vandermonde matrix, stiffness matrix, LIFT / correction function, etc.)
!
call mpi_barrier(MPI_COMM_WORLD,mpierr)
call init_vandermonde_matrices
call memory_pause("initializing vandermonde matrices", &
"initializing derivative matrices")
call mpi_barrier(MPI_COMM_WORLD,mpierr)
call init_derivative_matrices
call memory_pause("initializing derivative matrices", &
"initializing correction matrices")
call mpi_barrier(MPI_COMM_WORLD,mpierr)
call init_correction_matrices
call memory_pause("initializing correction matrices", &
"initializing interpolation matrices")
call mpi_barrier(MPI_COMM_WORLD,mpierr)
call init_interpolation_matrices
call memory_pause("initializing interpolation matrices", &
"initializing outerpolation matrices")
call mpi_barrier(MPI_COMM_WORLD,mpierr)
call init_outerpolation_matrices
call memory_pause("initializing outerpolation matrices", &
"initializing projection matrices")
call mpi_barrier(MPI_COMM_WORLD,mpierr)
call init_projection_matrices
call memory_pause("initializing projection matrices", &
"initializing filter matrices")
call mpi_barrier(MPI_COMM_WORLD,mpierr)
call init_filter_matrices
call memory_pause("initializing filter matrices", &
"initializing boundary profile stuff")
call mpi_barrier(MPI_COMM_WORLD,mpierr)
call init_bnd_profile_structures
call memory_pause("initializing boundary profile stuff", &
"initializing metrics")
!
! Get the grid metrics
!
call mpi_barrier(MPI_COMM_WORLD,mpierr)
call get_metrics
call memory_pause("initializing metrics","initializing solution")
!
! Uncomment the call to check_flux_point_orderings if you
! suspect that there is an error between the orderings of
! the flux points from the two cells on an interface
!
if (check_flux_point_coordinates) then
call check_face_flux_point_orderings
call check_cell_flux_point_orderings
end if
!
! Output information about the global grid
!
if (mypnum == glb_root) then
write (iout,11) n_global_cell, n_global_node, n_global_fbnd, &
n_global_solpts, total_volume, &
(solpts_edge(k), k=1,size(solpts_edge))
end if
call mpi_barrier(MPI_COMM_WORLD,mpierr)
!
! If requested, dump the memory usage of the advanced data types from some of
! the modules
!
if (dump_memory_usage) then
call report_memory_usage(n=1,request_stop=fals)
end if
!
! Initialize the MMS module if it is being used.
!
if (mms_opt /= 0) call initialize_mms
!
! Initialize the flow variables for all solution points or
! read in the restart values if restarting a simulation
!
call initialize_flow
if (output_time_averaging) then
call initialize_time_ave
end if
call memory_pause("initializing solution","initializing generic module")
!
! Time average the list of restart files
!
if (time_average_restart_files) then
call average_restart_files
end if
!
! If requested, dump the memory usage of the advanced data types from some of
! the modules
!
if (dump_memory_usage) then
call report_memory_usage(n=2,request_stop=true)
end if
!
if (mypnum == glb_root) then
write (iout,19) minval(global_cell_order), maxval(global_cell_order)
end if
!
! Initialize any necessary information for use in the module generic_mod
!
call init_generic_mod
if (num_timesteps > 0) then
call memory_pause("initializing generic module", &
"initial interpolation of C.V. to flux points")
else
if (dump_memory_usage) then
call memory_pause("initializing generic module","dumping memory usage")
else
call memory_pause("initializing generic module","main iteration loop")
end if
end if
!
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!%%% %%%
!%%% Beginning of main iteration loop %%%
!%%% %%%
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
! Initialize the wall time
!
call gfr_cpu_time(0)
!
call initialize_limiters
!
call reset_fp_exceptions
!
if (num_timesteps > 0) then
!
call interp_cv_to_flxpts
call memory_pause("initial interpolation of C.V. to flux points", &
"initial evaluation of boundary conditions")
call get_faceusp_bc(newton_failures)
call check_for_bad_number(__LINE__,newton_failures)
call memory_pause("initial evaluation of boundary conditions", &
"initial TGV KEDR evaluation")
!
if (itestcase == Taylor_Green_Vortex) then
call compute_TaylorGreen_KEDR(0,zero)
if (dump_memory_usage) then
call memory_pause("initial TGV KEDR evaluation","dumping memory usage")
else
call memory_pause("initial TGV KEDR evaluation", &
"writing initial CGNS file")
end if
end if
!
end if
!
#ifdef PAUSE_BETWEEN_ITERATIONS
if (mypnum == glb_root) then
write (iout,8260)
end if
8260 format (//," Pausing before starting the main iteration loop!",/, &
" Press any key to continue!",//)
read (*,*)
#endif
!
! If requested, dump the memory usage of the advanced data types from some of
! the modules
!
if (dump_memory_usage) then
call report_memory_usage(n=3,request_stop=true)
end if
!
! Output the initialized solution
!
if (continuous_output) then
call new_write_parallel_cgns
else
call write_parallel_cgns(open_CGNS)
end if
completed_initial_cgns_output = true
CGNS_action = add_to_CGNS
call memory_pause("writing initial CGNS file","main iteration loop")
!
main_loop: do iter = 1, num_timesteps
!
! Current iteration count including restart iterations
!
itcur = itcur + 1
!
! Store a copy of the solution from the previous time step
!
uoldsp(:,1:n_solpts) = usp(:,1:n_solpts)
!
! Loop over the Runge-Kutta stages
!
rk_loop: do nst = 1,num_rk_stages
!
Apply_Filter = (Filtering_Interval == 0)
Apply_Limiter = (Limiting_Interval == 0)
if (nst == num_rk_stages) then
if (Filtering_Interval > 0) then
Apply_Filter = (mod(iter,Filtering_Interval) == 0)
end if
if (Limiting_Interval > 0) then
Apply_Limiter = (mod(iter,Limiting_Interval) == 0)
end if
end if
!
call interp_cv_to_flxpts
call get_faceusp_bc(newton_failures)
call check_for_bad_number(__LINE__,newton_failures)
if (nst == 1) call get_dtsp(dtmin)
!
if (governing_equations == NavierStokes_Eqns) then
call discontinuous_gradient_at_solpts
if (visc_flux_method == visc_flux_BR2) then
call correct_gradients_br2
else if (visc_flux_method /= visc_flux_BR2) then
call correct_gradients_at_solpts
call interp_dusp_to_flxpts
end if
call get_facedusp_bc
end if
!
call flux_gradient_at_solpts_visc(iter,nst)
call correct_interface_flux_visc(iter,nst)
!
! Compute the source terms for the method of manufactured solutions (MMS)
!
if (mms_opt /= 0) call mms_src
!
! Compute the source terms for the channel flow
!
if (itestcase == Channel_Flow) call channel_source
!
! Compute the final residual for each solution point
!
call rresi
!
! Store residual in rssprk(:,:,nst) and update the solutions in usp
!
if (Runge_Kutta_Scheme == Classic_RK) then
call rupdate_Classic_RK(nst,Apply_Filter,Apply_Limiter)
else if (Runge_Kutta_Scheme == TVD2_RK) then
call rupdate_TVD2_RK(nst,Apply_Filter,Apply_Limiter)
else if (Runge_Kutta_Scheme == TVD3_RK) then
call rupdate_TVD3_RK(nst,Apply_Filter,Apply_Limiter)
else if (Runge_Kutta_Scheme == TVD4_RK) then
call rupdate_TVD4_RK(nst,Apply_Filter,Apply_Limiter)
else if (Runge_Kutta_Scheme == CK4_RK) then
call rupdate_CK4_RK(nst,Apply_Filter,Apply_Limiter)
end if
!
end do rk_loop
!
completed_timesteps = iter
!
!call check_for_bad_number(__LINE__)
!
! Update the time averaged variables
!
if (output_time_averaging) then
call update_time_ave
end if
!
! Compute and output the residual error at the specified interval
!
if ( (mod(iter,iter_out_interval) == 0 .or. this_is_final_timestep) .or. &
(mod(itcur,results_interval) == 0 .and. iter/=num_timesteps) ) then
!
! Compute the residual error
!
call compute_residual_error
!
if (mod(iter,iter_out_interval) == 0 .or. this_is_final_timestep) then
!
! Output the density residual error to stdout
!
call write_iter_stats(walltime_expiring,exit_main_loop)
!
! Exit the main loop if the convergence criteria were met
!
if (exit_main_loop) exit main_loop
!
end if
!
! Output the residual error at the specified interval
!
if (mod(itcur,results_interval)==0 .and. iter/=num_timesteps) then
!
call gfr_cpu_time(1)
!
if (mypnum == glb_root) call write_residual_file(0,itcur)
!
end if
!
end if
!
call check_for_bad_number(__LINE__)
!
! Every 50 (1000 for NAS) iterations
! 1. Compute the residual error for this time step and exit
! the main loop if the remaining wall time is almost zero
! 2. Check for a file requesting a premature stop
!
#ifdef PBS_ENV
if (mod(iter,1000) == 0) then
#else
if (mod(iter,50) == 0) then
#endif
!
! Only do the rest if this is not the last time step
!
if (iter /= num_timesteps) then
!
! Have the root processor check for various temporary files
!
if (mypnum == glb_root) then
!
! Check for a stop request
!
inquire (file="STOP_GFR",exist=request_stop)
!
! If stop was requested, delete the
! STOP_GFR file and exit the main loop
!
if (request_stop) then
!
write (iout,99)
!
! We dont care about the exit status here since we are
! going to be stopping execution after this anyways
!
open (newunit=i,file="STOP_GFR",iostat=ierr)
close (i,status="delete",iostat=ierr)
!
end if
!
! Check for a dump of a restart file
!
inquire (file="DUMP_RESTART",exist=request_restart)
!
! If restart dump was requested, delete the DUMP_RESTART file
!
if (request_restart) then
!
write (iout,96)
!
open (newunit=i,file="DUMP_RESTART",iostat=ierr)
close (i,status="delete",iostat=ierr)
!
end if
!
! Check for a dump of the solution file
!
inquire (file="DUMP_SOLUTION",exist=request_solution)
!
! If solution dump was requested, delete the DUMP_SOLUTION file
!
if (request_solution) then
!
write (iout,97)
!
open (newunit=i,file="DUMP_SOLUTION",iostat=ierr)
close (i,status="delete",iostat=ierr)
!
end if
!
! Check for a CFL adjustment file
!
inquire (file="ADJUST_CFL",exist=request_cfl_adjustment)
!
! If a CFL adjustment was requested, delete the ADJUST_CFL file
!
if (request_cfl_adjustment) then
!
write (iout,95)
!
open (newunit=i,file="ADJUST_CFL",iostat=ierr)
read (i,nml=cfl_adjustment)
close (i,status="delete",iostat=ierr)
!
cfl_tmp = [cfl,cfl_beg,cfl_end,real(cfl_cycles,kind=wp)]
!
end if
!
! Check for a start time-averaging request
!
inquire (file="START_TIME_AVERAGING",exist=request_time_ave)
!
! If stop was requested, delete the
! STOP_GFR file and exit the main loop
!
if (request_time_ave) then
!
if (output_time_averaging) then
request_time_ave = .false.
else
write (iout,94)
end if
!
! We dont care about the exit status here since we are
! going to be stopping execution after this anyways
!
open (newunit=i,file="START_TIME_AVERAGING",iostat=ierr)
close (i,status="delete",iostat=ierr)
!
end if
!!
!! Check for a file requesting an interuption of the current
!! simulation to restart it with a new restart file
!!
!inquire (file="RESTART_INTERUPT",exist=request_restart_interupt)
!!
!!
!! Delete the RESTART_INTERUPT file if restart interupt was requested
!!
!if (request_restart_interupt) then
! !
! write (iout,96)
! !
! open (newunit=i,file="RESTART_INTERUPT",iostat=ierr)
! close (i,status="delete",iostat=ierr)
! !
!end if
!
request_array(:) = [request_stop,request_restart,request_solution, &
request_cfl_adjustment,request_restart_interupt, &
request_time_ave]
!
end if
!
! Have the root processor broadcast all the request logicals to
! the other processors so they can proceed as needed
!
call mpi_bcast(request_array,size(request_array,kind=int_mpi), &
MPI_LOGICAL,0_int_mpi,MPI_COMM_WORLD,mpierr)
!
request_stop = request_array(1)
request_restart = request_array(2)
request_solution = request_array(3)
request_cfl_adjustment = request_array(4)
request_restart_interupt = request_array(5)
request_time_ave = request_array(6)
!
! Exit if the STOP_GFR file was found
!
if (request_stop) exit main_loop
!
! If a restart dump was requested, write a restart file
!
if (request_restart) then
call write_restart_file(itcur)
end if
!
! If a solution dump was requested, dump the solution and then let
! the CGNS subroutine know that the file needs to be reopened.
!
if (request_solution) then
if (continuous_output) then
call new_write_parallel_cgns
else
call write_parallel_cgns(dump_CGNS)
end if
CGNS_action = reopen_CGNS
end if
!
if (request_cfl_adjustment) then
!
call mpi_bcast(cfl_tmp,size(cfl_tmp,kind=int_mpi),mpi_flttyp, &
0_int_mpi,MPI_COMM_WORLD,mpierr)
!
cfl = cfl_tmp(1)
cfl_beg = cfl_tmp(2)
cfl_end = cfl_tmp(3)
cfl_cycles = nint(cfl_tmp(4))
!
call adjust_cfl_cycles
!
end if
!
if (request_time_ave) then
!
output_time_averaging = true
rl2mx = -huge(zero)
!
call initialize_time_ave
!
end if
!
end if
!
end if
!
! Output the restart file at specified step interval
!
if (restart_interval > 0 .and. .not.request_restart) then
if (mod(itcur,restart_interval)==0 .and. iter/=num_timesteps) then
call write_restart_file(itcur)
end if
end if
!
! Output the solution at the specified interval
!
if (output_interval > 0 .and. .not.request_solution) then
if (mod(itcur,output_interval)==0 .and. iter/=num_timesteps) then
if (continuous_output) then
call new_write_parallel_cgns
else
call write_parallel_cgns(CGNS_action)
end if
end if
end if
!
if (itestcase == Taylor_Green_Vortex) then
if (write_TaylorGreen_8s_solution) then
if (completely_disable_cgns) then
write_TaylorGreen_8s_solution = fals
else
call TaylorGreen_8s_vorticity_solution
end if
end if
if (write_TaylorGreen_full_solution) then
if (continuous_output) then
call new_write_parallel_cgns
else
call write_parallel_cgns(CGNS_action)
end if
write_TaylorGreen_full_solution = fals
end if
end if
!
! If solving the Taylor-Green Vortex problem, compute
! the various integrated quantities needed to get the
! different the kinetic energy dissipation rates
!
if (itestcase == Taylor_Green_Vortex .and. iter/=num_timesteps) then
call compute_TaylorGreen_KEDR(iter,dtmin)
end if
!
#ifdef PAUSE_BETWEEN_ITERATIONS
if (iter /= num_timesteps) then
if (mypnum == glb_root) then
write (iout,8261) iter,num_timesteps
end if
8261 format (//," Pausing after completing ",i0," of ",i0, &
" trips through the main iteration loop!",/, &
" Press any key to continue!",//)
read (*,*)
end if
#endif
!
! Reset the request options
!
request_restart = .false.
request_solution = .false.
!
end do main_loop
!
#ifdef PAUSE_BETWEEN_ITERATIONS
if (mypnum == glb_root) then
write (iout,8262)
end if
8262 format (//," Pausing after finishing the main iteration loop!",/, &
" Press any key to continue!",//)
read (*,*)
#endif
!
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!%%% %%%
!%%% End of main iteration loop %%%
!%%% %%%
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!
! Get the elapsed wall time
!
call gfr_cpu_time(1)
!
! If solving the Taylor-Green Vortex problem,
! finalize the kinetic energy dissipation rates
!
if (num_timesteps > 0) then
if (itestcase == Taylor_Green_Vortex) then
call compute_TaylorGreen_KEDR(-completed_timesteps,dtmin)
end if
end if
!
call write_restart_file(-1)
!
if (continuous_output) then
call new_write_parallel_cgns
else
call write_parallel_cgns(close_CGNS)
end if
!
if (.not. ignore_errors) then
!
call compute_residual_error
!
! Get min and max entropy value and location
call getmaxent
!
call compute_bnd_profiles
!
if (mypnum == glb_root) then
!
out_time = time*time_ref*time_scaling_factor
if (output_time_averaging) then
out_time = out_time - ave_start_time*time_ref*time_scaling_factor
end if
write (iout,40) itcur,out_time
call gfr_cpu_time(-1)
!
call write_final_error
call write_residual_file(-1,itcur)
!
end if
!
end if
!
flush (iout)
call mpi_barrier(MPI_COMM_WORLD,mpierr)
!
if (mypnum == glb_root) write (iout,50)
!
! Finalize the overall MPI session and stop execution
!
call finalize_mpi_environment
!
!
!
10 format (/,' For Processor ',i0,/,'------------------',/, &
' ncell = ',i0,' nnode = ',i0,' nfbnd = ',i0, &
' nface = ',i0,' nDOF = ',i0,/, &
' Partition Volume = ',f13.6)
11 format (/,' For the Global Grid ',/,'---------------------',/, &
' ncell = ',i0,' nnode = ',i0, &
' nfbnd = ',i0,' nDOF = ',i0,/, &
' Total Grid Volume = ',f13.6,/, &
' 1D Solution Points = ',100(6f9.5,:,/,23x))
!
19 format (/,' Lowest Cell Order = ',i4,/, &
' Highest Cell Order = ',i4,/)
!
40 format (//' Final iteration count = ',i12,/, &
' Simulation elapsed time = ',f12.3)
41 format (/,"TOTAL SIMULATION WALL TIME WAS ",f18.6," s.",/,&
"TOTAL COMPUTATIONAL COST WAS ",f18.6," work units.")
!
50 format (/'Done'/)
!
94 format (/,"*******************************************************",/, &
" FOUND FILE REQUESTING TO START TIME AVERAGING! ",/, &
"*******************************************************",/)
95 format (/,"*******************************************************",/, &
" FOUND FILE REQUESTING AN ADJUSTMENT TO THE CFL! ",/, &
"*******************************************************",/)
96 format (/,"*******************************************************",/, &
" FOUND FILE REQUESTING A DUMP OF A RESTART FILE! ",/, &
"*******************************************************",/)
97 format (/,"*******************************************************",/, &
" FOUND FILE REQUESTING A DUMP OF THE SOLUTION FILE! ",/, &
"*******************************************************",/)
98 format (/,"*******************************************************",/, &
" VORTEX HAS APPEARED TO COLLAPSE!",/, &
" THE SIMULATION WAS RUN ANOTHER 25 PERIODS", &
" PAST THE POINT OF COLLAPSE!",/, &
" GFR IS NOW STOPPING EXECUTION AND", &
" DUMPING THE FINAL RESULTS!",/, &
"*******************************************************",/)
99 format (/,"*******************************************************",/, &
" FOUND FILE REQUESTING TO STOP THE EXECUTION OF GFR! ",/, &
" STOPPING EXECUTION AND DUMPING THE FINAL RESULTS!",/, &
"*******************************************************",/)
!
contains
!
!###############################################################################
!
subroutine check_for_bad_number(line_num,newton_failures)
!
use eqn_idx, only : nq
use geovar, only : n_solpts
use flowvar, only : usp,uoldsp
#ifndef SPECIAL_FOR_GCC
use, intrinsic :: ieee_exceptions, only : ieee_usual
use, intrinsic :: ieee_exceptions, only : ieee_get_flag
#endif
!
!.. Formal Arguments ..
integer, intent(in) :: line_num
!
!.. Optional Arguments ..
integer, optional, intent(in) :: newton_failures
!
#ifndef SPECIAL_FOR_GCC
!
!.. Local Scalars ..
integer :: n,m
!
logical(lk) :: error_found
!
character(len=300) :: overflow_error
character(len=300) :: divide_by_zero_error
character(len=300) :: invalid_error
character(len=300) :: newton_error
!
!.. Local Arrays ..
integer :: bad_number_found(1:size(ieee_usual))
logical(ldk) :: signaling_exceptions(1:size(ieee_usual))
!
character(len=*), parameter :: pname = "check_for_bad_number"
!
continue
!
error_found = fals
!
overflow_error = ""
divide_by_zero_error = ""
invalid_error = ""
newton_error = ""
!
! First check to make sure that no floating-point exceptions are signaling
!
call ieee_get_flag(ieee_usual,signaling_exceptions)
!
bad_number_found = merge(1,0,signaling_exceptions)
!
if (ncpu > 1) then
call mpi_allreduce(MPI_IN_PLACE,bad_number_found, &
size(bad_number_found,kind=int_mpi), &
mpi_inttyp,MPI_MAX,MPI_COMM_WORLD,mpierr)
end if
!
if (present(newton_failures)) then
if (newton_failures > 0) then
error_found = true
write (newton_error,104) newton_failures
end if
end if
!
if (sum(bad_number_found) > 0) then
error_found = true
if (bad_number_found(1) > 0) write (overflow_error,101)
if (bad_number_found(2) > 0) write (divide_by_zero_error,102)
if (bad_number_found(3) > 0) write (invalid_error,103)
end if
!
if (error_found) then
!
! A floating-point exception was detected. Dump solution and restart
! files for the solution at the previous time step and abort the
! simulation
!
! Copy the solution from the previous time step back into
! usp so we can dump the solution and restart files before
! aborting the simulation
!
if (completed_initial_cgns_output) then
if (allocated(usp) .and. allocated(uoldsp)) then
!
do n = 1,n_solpts
do m = 1,nq
usp(m,n) = uoldsp(m,n)
end do
end do
!
if (continuous_output) then
call new_write_parallel_cgns
else
call write_parallel_cgns(-3)
end if
!
call write_restart_file(-2)
!
end if
end if
!
write (error_message,100) itcur, &
trim(adjustl(overflow_error)), &
trim(adjustl(divide_by_zero_error)), &
trim(adjustl(invalid_error)), &
trim(adjustl(newton_error))
!
call stop_gfr(stop_mpi,pname,line_num,__FILE__,error_message)
!
end if
!
100 format ("A SIGNALING FLOATING POINT EXCEPTION WAS ", &
"DETECTED AFTER UPDATING THE SOLUTION AFTER ", &
"TIME STEP # ",i0," !!! DUMPING SOLUTION AND ", &