- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
[originally posted on OpenMP Forum with no response]
I'm using OpenMP5 with Intel Fortran (XE 2020.1.216), running under 64-bit Windows 7, and using Visual studio 2019 16.6.1.
When I run my executable, it hangs at the beginning of a parallel region, but only the second time. I cannot understand why this should be.
The main program (Main) is C++. It calls a Fortran subroutine Compute directly (in the main thread), then starts a worker thread to call a second Fortran subroutine, Wide. When Wide has finished, the worker thread terminates.
Both Fortran subroutines contain a single parallel DO
All this works as expected the first time I run it. But the second time, it hangs at the start of the parallel DO in Compute.
The code looks like this:
Main C++ thread:
Compute(...)
Fortran Compute:
!$OMP PARALLEL DEFAULT(NONE) & !$OMP SHARED(...) !$OMP DO & !$OMP PRIVATE(iWavelengthF,... ) DO iWavelengthF=1, nWavelengthsAlloc ... END DO ! wavelength !$OMP END DO !$OMP END PARALLEL
Fortran Wide:
!$OMP PARALLEL DEFAULT(NONE) & !$OMP SHARED(...) !$OMP DO & !$OMP PRIVATE(iWavelengthF, ... ) DO iWavelengthF=1, nWavelengths ... END DO ! iWavelengthF !$OMP END DO !$OMP END PARALLEL
Here are the threads, as shown by the debugger; the initial column is the Windows thread ID. As is evident, OpenMP is not using the set of 7 parallel worker threads it created for the Compute parallel DO, but instead has created a second team of 7. It looks like the second time thru Compute, the first team of worker threads has been activated, but OpenMP is waiting for an event which never happens. This is a 4-core hyper-threaded Intel processor, so there are 8 logical CPUs.
Compute prior to parallel DO
2496 0 Main Thread Main Thread CppMain!Compute(, , , , , , , , , , , , , , , )
Compute after parallel DO
2496 0 Main Thread Main Thread CppMain!Compute(, , , , , , , , , , , , , , , )
9544 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_hyper_barrier_release
8052 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
5432 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
8236 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
9712 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
4112 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
6996 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_hyper_barrier_release
Wide prior to loop
2496 0 Main Thread Main Thread gdi32.dll!NtGdiGetRandomRgn
9544 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
8052 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
5432 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
8236 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9712 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
4112 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
6996 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
Wide after parallel region
2496 0 Main Thread Main Thread CppMain!AfxInternalPumpMessage
9544 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
8052 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
5432 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
8236 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9712 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
4112 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
6996 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
2328 0 Worker Thread CppMain!thread_start<unsigned int (__cdecl*)(void *),1> CppMain!Wide(, , , )
9836 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_hyper_barrier_release
6584 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
9220 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
5216 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
1904 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
9656 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
9872 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
Main after Wide thread terminated
2496 0 Main Thread Main Thread CppMain!AfxInternalPumpMessage
9544 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
8052 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
5432 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
8236 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9712 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
4112 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
6996 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9836 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
6584 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9220 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
5216 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
1904 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9656 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9872 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
Behavior OK to here, although it's a mystery why OpenMP started a second team of threads. I am guessing OpenMP cannot see the first team of threads, because Wide is in a different thread.
Compute before parallel DO:
2496 0 Main Thread Main Thread CppMain!Compute(, , , , , , , , , , , , , , , )
9544 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
8052 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
5432 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
8236 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9712 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
4112 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
6996 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9836 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
6584 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9220 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
5216 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
1904 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9656 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9872 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
Compute hanging at start of parallel DO:
2496 0 Main Thread Main Thread libiomp5md.dll!__kmp_suspend_64
9544 0 Worker Thread libiomp5md.dll!__kmp_launch_worker CppMain!L_Compute.V_176__par_region0_2.1()
8052 0 Worker Thread libiomp5md.dll!__kmp_launch_worker CppMain!L_Compute.V_176__par_region0_2.1()
5432 0 Worker Thread libiomp5md.dll!__kmp_launch_worker CppMain!L_Compute.V_176__par_region0_2.1()
8236 0 Worker Thread libiomp5md.dll!__kmp_launch_worker CppMain!L_Compute.V_176__par_region0_2.1()
9712 0 Worker Thread libiomp5md.dll!__kmp_launch_worker CppMain!L_Compute.V_176__par_region0_2.1()
4112 0 Worker Thread libiomp5md.dll!__kmp_launch_worker CppMain!L_Compute.V_176__par_region0_2.1()
6996 0 Worker Thread libiomp5md.dll!__kmp_launch_worker CppMain!L_Compute.V_176__par_region0_2.1()
9836 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
6584 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9220 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
5216 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
1904 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9656 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9872 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The following may be a reason, and in any event, your code structure is not doing what you intend.
>>It calls a Fortran subroutine Compute directly (in the main thread),
OK
>>then starts a worker thread to call a second Fortran subroutine, Wide.
Not recommended. The spawned thread, when entering its parallel region, will instantiate an independent OpenMP thread pool. Thus generally over-subscribing the system.
>>When Wide has finished, the worker thread terminates.
This leaves the ancillary OpenMP threads of the 2nd thread pool active (each may be in Spin-Wait or suspended).
Then when the main thread enters Compute, this should be OK excepting for CPU competition with Spin-Waiting threads from the 2nd OpenMP thread pool.
Then when the main thread spawns another thread, and it subsequently enters its parallel region, will instantiate an independent (3rd) OpenMP thread pool.
etc...
The proper way to code this (C++ main, Fortran subroutines) is to assure only one OpenMP thread pool is created....
.OR.
Have the ancillary thread be created once, and then use a means of synchronization, perhaps a mutex for it to start/finish each run. Note, with two OpenMP thread pools, you may need to specify a lesser number of threads than all logical processors.
Also, include calls to initialize the Fortran runtime system.
Jim Dempsey
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
@jimdempseyatthecove:
I understand that OpenMP is creating two thread pools. After I wrote the original post this did occur to me, so I changed the code to eliminate the separate worker thread I created. But the pgm hung in exactly the same way, although with only 7 OpenMP threads.
In fact, a separate worker thread is necessary, because the C++ UI needs to be showing progress of the lengthy Fortran calculations. I am not worried about competition among threads for CPU time, because this will be taken into account by suspending the OpenMP threads.
I see your point about continuing to spawn threads, but I don't see any way to prevent this. I cannot execute the entire app in the same thread. What is needed is either (1) a way to tell OpenMP to terminate a team of threads, which would be executed just before the worker thread terminates, or (2) a way to re-establish connection to the orphaned set of threads left when the thread terminates.
I don't know why you are suggesting I need to initialize the Fortran run-time. Surely this is already being done when execution starts. My pgm has lots of calls to Fortran from the C++ main, and I haven't had any difficulties. So the pgm must already be doing the initialization.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
>>I changed the code to eliminate the separate worker thread I created. But the pgm hung in exactly the same way, although with only 7 OpenMP threads.
Then one of your threads, within the parallel region, terminated. There is an implicit barrier on !$omp end do, as well as !$omp end parallel.
All threads of a parallel region must enter (and will exit) barriers. One of your threads is somehow exiting/terminating within the parallel region.
>>I don't see any way to prevent this. I cannot execute the entire app in the same thread.
Without knowing about your application's requirements, it will be hard to give you complete advice. I can sketch it for you to use as a starting point.
================== Plan A ======================= int main(int argc, char** argv) { for_rtl_init_(&argc, argv); // Fortran pre-PROGRAM initialization (no PROGRAM procedure) ... omp_set_nested(true); #pragma omp parallel { #pragma omp master { for(int interval=0; interval<nTimes; ++interval) { ... Compute(); #pragma omp task shared(...) private(...) { // runs concurrent with enclosing for(...) loop // IOW next interval, this task may be running through next Compute() ... // you are responsible to avoid data usage conflicts between // Compute and Wide Wide(); ... } ... // task still running } // for } // master } // parallel ... for_rtl_finish(&argc, argv); // Fortran pre-PROGRAM initialization (no PROGRAM procedure) ... } // main ! Compute.f90 ... variables ! nested parallel region !$OMP PARALLEL DEFAULT(NONE) & !$OMP SHARED(...) !$OMP DO & !$OMP PRIVATE(iWavelengthF,... ) DO iWavelengthF=1, nWavelengthsAlloc ... END DO ! wavelength !$OMP END DO !$OMP END PARALLEL ... ! end Compute.f90 ---------------------- ! Wide.f90 ... variables ! code ! nested parallel region !$OMP PARALLEL DEFAULT(NONE) & !$OMP SHARED(...) !$OMP DO & !$OMP PRIVATE(iWavelengthF, ... ) DO iWavelengthF=1, nWavelengths ... END DO ! iWavelengthF !$OMP END DO !$OMP END PARALLEL ! end Wide.f90 ================== Plan B ======================= int main(int argc, char** argv) { for_rtl_init_(&argc, argv); // Fortran pre-PROGRAM initialization (no PROGRAM procedure) ... #pragma omp parallel { #pragma omp master { int dependVar; // address of this is used for dependency for(int interval=0; interval<nTimes; ++interval) { ... #pragma omp task shared(...) private(...) depend(out: dependVar) { ... Compute(); ... } #pragma omp task shared(...) private(...) depend(in: dependVar) { // runs concurrent with enclosing for(...) loop // IOW next interval, this task may be running through next Compute() ... // you are responsible to avoid data usage conflicts between // Compute and Wide Wide(); ... } ... // task with Wide still running } // for } // master } // parallel ... for_rtl_finish(&argc, argv); // Fortran pre-PROGRAM initialization (no PROGRAM procedure) ... } // main ! Compute.f90 ... DO iWavelengthF=1, nWavelengthsAlloc !$OMP TASK FIRSTPRIVATE(iWavelengthF) PRIVATE(...) SHARED(...) ... !$OMP END TASK END DO ! wavelength ... ! end Compute.f90 ---------------------- ! Wide.f90 ... DO iWavelengthF=1, nWavelengths !$OMP TASK FIRSTPRIVATE(iWavelengthF) PRIVATE(...) SHARED(...) ... !$OMP END TASK END DO ! iWavelengthF ... ! end Wide.f90
>>I don't know why you are suggesting I need to initialize the Fortran run-time. Surely this is already being done when execution starts.
Fortran run-time initialization/finalization is part of the Fortran PROGRAM procedure. Applications with a C/C++/C#/??? main do not have a Fortran PROGRAM procedure, and thus do not have calls to initialization/finalization
Jim Dempsey
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I have checked that no thread leaves a parallel region anywhere other than the DO termination. The compiler gives an error if you try to do this, anyways. I had to replace RETURNs and EXITs in the parallel DOs to get the pgm to compile in the first place.
I believe OpenMP is using 7 threads because the main thread already "uses" one of the logical processors. This is not optimal, but doesn't really matter in this case.
I redid the pgm to remove the worker thread, so all Fortran execution is from the same thread. Below are the list of threads at each point. You can see that there is only a single team of threads, and they are the same at everyplace, once we get past the initial parallel region.
Again, the second invocation of Compute hangs at the start of the parallel region. However, I just thought to look at the stack of the hung OpenMP threads, and they all look like
user32.dll!NtUserMessageCall() Unknown
user32.dll!SendMessageWorker() Unknown
user32.dll!SendMessageA() Unknown
CppMain!L_Compute.V_176__par_region0_2.1() Line 185 Fortran
libiomp5md.dll!__kmp_invoke_microtask() Unknown
libiomp5md.dll!__kmp_invoke_task_func(int gtid) Line 7516 C++
libiomp5md.dll!__kmp_launch_thread(kmp_info * this_thr) Line 6109 C++
libiomp5md.dll!__kmp_launch_worker(void * arg) Line 1039 C++
kernel32.dll!BaseThreadInitThunk() Unknown
ntdll.dll!RtlUserThreadStart() Unknown
Compute contains, within the parallel region, the line
messageResult = SENDMESSAGE(hWnd, WM_APP_Progress, 2, fractX10000Complete)
This is just supposed to update the C++ UI on the progress of the computation. But since Compute is not in a separate thread, the SendMessage never gets processed, and hence, deadlock. I should have used PostMessage, which returns immediately. I made this change, and now it does not hang, when everything is running in the same thread. Now I need to deal with the multiple teams of threads issue.
Start Compute
6408 0 Main Thread Main Thread CppMain!Compute(, , , , , , , , , , , , , , , )
End Compute
6408 0 Main Thread Main Thread CppMain!Compute(, , , , , , , , , , , , , , , )
7292 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_hyper_barrier_release
9576 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
9668 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_hyper_barrier_release
4064 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
10036 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_hyper_barrier_release
10132 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_hyper_barrier_release
5584 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_hyper_barrier_release
End Wide
6408 0 Main Thread Main Thread CppMain!Wide(, , , )
7292 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
9576 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_hyper_barrier_release
9668 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
4064 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
10036 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
10132 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
5584 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_yield
Start Compute
6408 0 Main Thread Main Thread CppMain!Compute(, , , , , , , , , , , , , , , )
7292 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9576 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
9668 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
4064 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
10036 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
10132 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
5584 0 Worker Thread libiomp5md.dll!__kmp_launch_worker libiomp5md.dll!__kmp_suspend_64
Hang in Compute
6408 0 Main Thread Main Thread libiomp5md.dll!__kmp_suspend_64
7292 0 Worker Thread libiomp5md.dll!__kmp_launch_worker CppMain!L_Compute.V_176__par_region0_2.1()
9576 0 Worker Thread libiomp5md.dll!__kmp_launch_worker CppMain!L_Compute.V_176__par_region0_2.1()
9668 0 Worker Thread libiomp5md.dll!__kmp_launch_worker CppMain!L_Compute.V_176__par_region0_2.1()
4064 0 Worker Thread libiomp5md.dll!__kmp_launch_worker CppMain!L_Compute.V_176__par_region0_2.1()
10036 0 Worker Thread libiomp5md.dll!__kmp_launch_worker CppMain!L_Compute.V_176__par_region0_2.1()
10132 0 Worker Thread libiomp5md.dll!__kmp_launch_worker CppMain!L_Compute.V_176__par_region0_2.1()
5584 0 Worker Thread libiomp5md.dll!__kmp_launch_worker CppMain!L_Compute.V_176__par_region0_2.1()
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
>>This is just supposed to update the C++ UI on the progress of the computation.
Run the UI as a Modal Dialog. Here is a cut/edited version of some Fortran code that I use:
! First time, or in event that Control Pannel terminated for some reason if(.not. ControlPannelRunning) then ! before creating the dialog box insert values that may be examined/modified ! by the dialog box vIntegrationStepsize = DLHOST IntegrationStepsize = DLHOST ! Create seperate thread to run the Modal Dialog control pannel ControlPanelHandle = CreateThread(& & NULL, ControlPanelStack, loc(ControlPanel), loc(ControlPanelArg), ControlPanelFlags, loc(ControlPanelThread_ID)) ! ** before proceeding, wait for the new thread to complete initialization do while(.not. ControlPannelRunning) milliseconds = 500 call sleepqq(milliseconds) end do endif
*** The Control Panel Dialog box does not perform significant computations - deffinately no OpenMP parallel regions. It is simply a button/control/dialog display function. Here is my control panel code.
! ControlPanel.f90 #ifndef _AvFRT #error *-*-*- Must compile with _AvFRT defined #endif #define SPIN_INTEGRATION_STEPSIZE_RANGEMIN 1 #define SPIN_INTEGRATION_STEPSIZE_SMALLSTEP 1 #define SPIN_INTEGRATION_STEPSIZE_BIGSTEP 100 #define SPIN_INTEGRATION_STEPSIZE_RANGEMAX 30000 SUBROUTINE ControlPanelCallBack( dlg, id, callbacktype ) !DEC$ ATTRIBUTES DEFAULT :: ControlPanelCallBack USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' TYPE (dialog) dlg INTEGER id, callbacktype, iStat CHARACTER(256), automatic :: text LOGICAL retlog INTEGER cel, far, retint real(8), automatic :: xyz(3) text = 'undefined' ControlPanelPauseRefresh = .true. NextDisplayTime = 0 ! update now SELECT CASE (id) CASE (IDC_RADIO1) ! Radio button 1 selected by user so ! change display accordingly vIavDisplayFrame = 0 ! vIavDisplayFrame = 0 Inertial Frame ! vIavDisplayFrame = 1 Orbital Frame CASE (IDC_RADIO2) ! Radio button 2 selected by user so ! change display accordingly vIavDisplayFrame = 1 ! vIavDisplayFrame = 1 Orbital Frame CASE (IDC_SLIDER1) call ControlPanelSliderDeltaTime ! should pass dlg, slider uses ControlPanelDlg (should be same) CASE (IDC_SLIDER2) call ControlPanelSliderAnnealRate CASE (IDC_SLIDER3) call ControlPanelStretchX CASE (IDC_SLIDER4) call ControlPanelStretchY CASE (IDC_SLIDER5) call ControlPanelStretchZ CASE (IDC_SLIDER6) call ControlPanelStretchCharts CASE (IDC_SLIDER7) call ControlPanelIntegrationStepsizeMultiplierGain CASE (IDC_BUTTON_TENSION) call PokeFiveStateButton(IDC_BUTTON_TENSION, vButtonTension) CASE (IDC_BUTTON_ELASTIC_AREA) call PokeFiveStateButton(IDC_BUTTON_ELASTIC_AREA, vButtonElasticArea) if(vButtonElasticArea .eq. 0) then ! Elastic Area, Bead Mass, Ballast Mass, Elastic Area, Bead Mass, Ballast Mass, ... if(DisplayBeadMassInPlaceOfElasticArea) then ! transition to Ballast Mass DisplayBeadMassInPlaceOfElasticArea = .false. DisplayBallastMassInPlaceOfElasticArea = .true. retlog = DLGSET( ControlPanelDlg, IDC_ElasticAreaOrMass, 'Ballast Mass' ) elseif(DisplayBallastMassInPlaceOfElasticArea) then ! transition to Elastic Area DisplayBallastMassInPlaceOfElasticArea = .false. DisplayExternalForceInPlaceOfElasticArea = .true. retlog = DLGSET( ControlPanelDlg, IDC_ElasticAreaOrMass, 'External Force' ) elseif(DisplayExternalForceInPlaceOfElasticArea) then ! transition to Elastic Area DisplayExternalForceInPlaceOfElasticArea = .false. retlog = DLGSET( ControlPanelDlg, IDC_ElasticAreaOrMass, 'Elastic Area' ) else ! Elastic Area transitions to Bead Mass DisplayBeadMassInPlaceOfElasticArea = .true. retlog = DLGSET( ControlPanelDlg, IDC_ElasticAreaOrMass, 'Bead Mass' ) endif endif CASE (IDC_BUTTON_STRESS) call PokeFiveStateButton(IDC_BUTTON_STRESS, vButtonStress) CASE (IDC_BUTTON_STRAIN) call PokeFiveStateButton(IDC_BUTTON_STRAIN, vButtonStrain) CASE (IDC_CHECK_ANNEAL) retlog = DLGGETLOG (dlg, IDC_CHECK_ANNEAL, vCheckAnneal) CASE (IDC_CHECK_HONE) retlog = DLGGETLOG (dlg, IDC_CHECK_HONE, vCheckHone) CASE (IDC_CHECK_DAMPER) retlog = DLGGETLOG (dlg, IDC_CHECK_DAMPER, vCheckDamper) CASE (IDC_CHECK_RIGHTEN) retlog = DLGGETLOG (dlg, IDC_CHECK_RIGHTEN, vCheckRighten) CASE (IDC_CHECK_GENISIS) retlog = DLGGETLOG (dlg, IDC_CHECK_GENISIS, vCheckGenisis) CASE (IDC_CHECK_FLIP_X) retlog = DLGGETLOG (dlg, IDC_CHECK_FLIP_X, vCheckFlipX) CASE (IDC_CHECK_FLIP_Y) retlog = DLGGETLOG (dlg, IDC_CHECK_FLIP_Y, vCheckFlipY) CASE (IDC_CHECK_FLIP_Z) retlog = DLGGETLOG (dlg, IDC_CHECK_FLIP_Z, vCheckFlipZ) CASE (IDC_CHECK_MKS) retlog = DLGGETLOG (dlg, IDC_CHECK_MKS, vCheckMKS) CASE (IDC_CHECK_REV) retlog = DLGGETLOG (dlg, IDC_CHECK_REV, vCheckReverseBeads) CASE (IDC_CHECK_ALT) retlog = DLGGETLOG (dlg, IDC_CHECK_ALT, vCheckAltitude) CASE (IDC_CHECK_TELLTAILS) retlog = DLGGETLOG (dlg, IDC_CHECK_TELLTAILS, vCheckTelltails) CASE (IDC_CHECK_EARTH) retlog = DLGGETLOG (dlg, IDC_CHECK_EARTH, vCheckEarth) CASE (IDC_CHECK_CROSSHAIRS) retlog = DLGGETLOG (dlg, IDC_CHECK_CROSSHAIRS, vCheckCrossHairs) CASE (IDC_ADVANCETETHERSINCRIMENTALLY) retlog = DLGGETLOG (dlg, IDC_ADVANCETETHERSINCRIMENTALLY, vCheckAdvanceTethersIncrimentally) CASE (IDC_PAUSE_RESUME) if(ControlPanelPause .eq. .true.) then ControlPanelPause = .false. text = 'Pause' else ControlPanelPause = .true. text = 'Resume' endif retlog = DLGSET( dlg, IDC_PAUSE_RESUME, text ) CASE (IDC_PANX) call ControlPanelPanX CASE (IDC_PANY) call ControlPanelPanY CASE (IDC_PANZ) call ControlPanelPanZ CASE(IDC_SPIN_INTEGRATION_STEPSIZE) call ControlPanelSpinIntegrationStepsize CASE(IDC_BUTTON_AVRESET) vButtonArrayVisualizerReset = .true. CASE(IDC_BUTTON_SNAPSHOT) vButtonSnapShot = .true. CASE(IDC_BUTTON_RESET_REGION_HISTORY) vButtonResetRegionHistory = .true. CASE(IDC_RADIO_STOP) vElevatorActionState = ElevatorActionStateStop CASE(IDC_RADIO_RELEASE) vElevatorActionState = ElevatorActionStateRelease CASE(IDC_RADIO_UP) vElevatorActionState = ElevatorActionStateUp CASE(IDC_RADIO_DOWN) vElevatorActionState = ElevatorActionStateDown CASE(IDC_RADIO_PUMP) vElevatorActionState = ElevatorActionStatePump CASE(IDC_BUTTON_VIEW) vButtonView = .true. END SELECT END SUBROUTINE ControlPanelCallBack integer(4) FUNCTION ControlPanel(arg) !DEC$ ATTRIBUTES STDCALL, ALIAS:"_controlpanel" :: ControlPanel USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' integer(4),POINTER :: arg integer(4) returnVal, ns CHARACTER(256) text LOGICAL retlog external ControlPanelCallBack retlog = DLGINIT( IDD_DIALOG1, ControlPanelDlg ) if(.not. retlog) write(*,*) "Dialog error for IDD_DIALOG1" call DlgSetTitle( ControlPanelDlg, ControlPanelTitle ) retlog = DlgSetSub( ControlPanelDlg, IDC_RADIO1, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_RADIO1" retlog = DlgSetSub( ControlPanelDlg, IDC_RADIO2, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_RADIO2" retlog = DlgSetSub( ControlPanelDlg, IDC_SLIDER1, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_SLIDER1" retlog = DlgSetSub( ControlPanelDlg, IDC_SLIDER2, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_SLIDER2" retlog = DlgSetSub( ControlPanelDlg, IDC_SLIDER3, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_SLIDER3" retlog = DlgSetSub( ControlPanelDlg, IDC_SLIDER4, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_SLIDER4" retlog = DlgSetSub( ControlPanelDlg, IDC_SLIDER5, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_SLIDER5" retlog = DlgSetSub( ControlPanelDlg, IDC_SLIDER6, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_SLIDER6" retlog = DlgSetSub( ControlPanelDlg, IDC_SLIDER7, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_SLIDER7" retlog = DlgSetSub( ControlPanelDlg, IDC_PANX, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_PANX" retlog = DlgSetSub( ControlPanelDlg, IDC_PANY, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_PANY" retlog = DlgSetSub( ControlPanelDlg, IDC_PANZ, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_PANZ" retlog = DlgSetSub( ControlPanelDlg, IDC_PAUSE_RESUME, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_PAUSE_RESUME" retlog = DlgSetSub( ControlPanelDlg, IDC_BUTTON_TENSION, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_BUTTON_TENSION" vButtonTension = vButtonTension - 1 call PokeFiveStateButton(IDC_BUTTON_TENSION, vButtonTension) retlog = DlgSetSub( ControlPanelDlg, IDC_BUTTON_ELASTIC_AREA, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_BUTTON_ELASTIC_AREA" vButtonElasticArea = vButtonElasticArea - 1 call PokeFiveStateButton(IDC_BUTTON_ELASTIC_AREA, vButtonElasticArea) retlog = DlgSetSub( ControlPanelDlg, IDC_BUTTON_STRESS, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_BUTTON_STRESS" vButtonStress = vButtonStress - 1 call PokeFiveStateButton(IDC_BUTTON_STRESS, vButtonStress) retlog = DlgSetSub( ControlPanelDlg, IDC_BUTTON_STRAIN, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_BUTTON_STRAIN" vButtonStrain = vButtonStrain - 1 call PokeFiveStateButton(IDC_BUTTON_STRAIN, vButtonStrain) retlog = DlgSetSub( ControlPanelDlg, IDC_CHECK_ANNEAL, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_ANNEAL" retlog = DlgSetSub( ControlPanelDlg, IDC_CHECK_HONE, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_HONE" retlog = DlgSetSub( ControlPanelDlg, IDC_CHECK_DAMPER, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_DAMPER" retlog = DlgSetSub( ControlPanelDlg, IDC_CHECK_RIGHTEN, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_RIGHTEN" retlog = DlgSetSub( ControlPanelDlg, IDC_CHECK_FLIP_X, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_FLIP_X" retlog = DlgSetSub( ControlPanelDlg, IDC_CHECK_FLIP_Y, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_FLIP_Y" retlog = DlgSetSub( ControlPanelDlg, IDC_CHECK_FLIP_Z, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_FLIP_Z" retlog = DlgSetSub( ControlPanelDlg, IDC_CHECK_MKS, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_MKS" retlog = DlgSetSub( ControlPanelDlg, IDC_CHECK_REV, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_REV" retlog = DlgSetSub( ControlPanelDlg, IDC_CHECK_ALT, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_ALT" retlog = DlgSetSub( ControlPanelDlg, IDC_CHECK_TELLTAILS, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_TELLTAILS" retlog = DlgSetSub( ControlPanelDlg, IDC_CHECK_EARTH, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_EARTH" retlog = DlgSetSub( ControlPanelDlg, IDC_CHECK_CROSSHAIRS, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_CROSSHAIRS" retlog = DlgSetSub( ControlPanelDlg, IDC_ADVANCETETHERSINCRIMENTALLY, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_ADVANCETETHERSINCRIMENTALLY" call ControlPanelSliderDeltaTime call ControlPanelSliderAnnealRate call ControlPanelStretchX call ControlPanelStretchY call ControlPanelStretchZ retlog = DLGSETLOG( ControlPanelDlg, IDC_RADIO1, (vIavDisplayFrame .eq. 0)) if(.not. retlog) write(*,*) "Dialog error for IDC_RADIO1" retlog = DLGSETLOG( ControlPanelDlg, IDC_RADIO2, (vIavDisplayFrame .eq. 1)) if(.not. retlog) write(*,*) "Dialog error for IDC_RADIO2" IavDisplayFrame = vIavDisplayFrame oIavDisplayFrame = vIavDisplayFrame retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_ANNEAL, vCheckAnneal) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_ANNEAL" retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_HONE, vCheckHone) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_HONE" retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_DAMPER, vCheckDamper) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_DAMPER" retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_RIGHTEN, vCheckRighten) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_RIGHTEN" retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_GENISIS, vCheckGenisis) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_GENISIS" retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_FLIP_X, vCheckFlipX) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_FLIP_X" retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_FLIP_Y, vCheckFlipY) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_FLIP_Y" retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_FLIP_Z, vCheckFlipZ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_FLIP_Z" retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_MKS, vCheckMKS) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_MKS" retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_REV, vCheckReverseBeads) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_REV" retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_ALT, vCheckAltitude) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_ALT" retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_TELLTAILS, vCheckTelltails) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_TELLTAILS" retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_EARTH, vCheckEarth) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_EARTH" retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_CROSSHAIRS, vCheckCrossHairs) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_CROSSHAIRS" retlog = DLGSETLOG (ControlPanelDlg, IDC_ADVANCETETHERSINCRIMENTALLY, vCheckAdvanceTethersIncrimentally) if(.not. retlog) write(*,*) "Dialog error for IDC_ADVANCETETHERSINCRIMENTALLY" retlog = DlgSetSub( ControlPanelDlg, IDC_CHECK_GENISIS, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_CHECK_GENISIS" ! retlog = DlgSetSub( ControlPanelDlg, IDC_BUTTON_AVRESET, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_BUTTON_AVRESET" retlog = DlgSetSub( ControlPanelDlg, IDC_BUTTON_SNAPSHOT, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_BUTTON_SNAPSHOT" retlog = DlgSetSub( ControlPanelDlg, IDC_BUTTON_RESET_REGION_HISTORY, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_BUTTON_RESET_REGION_HISTORY" retlog = DlgSetSub( ControlPanelDlg, IDC_RADIO_STOP, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_RADIO_STOP" retlog = DlgSetSub( ControlPanelDlg, IDC_RADIO_RELEASE, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_RADIO_RELEASE" retlog = DlgSetSub( ControlPanelDlg, IDC_RADIO_UP, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_RADIO_UP" retlog = DlgSetSub( ControlPanelDlg, IDC_RADIO_DOWN, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_RADIO_DOWN" retlog = DlgSetSub( ControlPanelDlg, IDC_RADIO_PUMP, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_RADIO_PUMP" call ControlPanelSetIntegrationStepsize(IntegrationStepsize) retlog = DLGSET( ControlPanelDlg, IDC_SPIN_INTEGRATION_STEPSIZE, SPIN_INTEGRATION_STEPSIZE_RANGEMIN, DLG_RANGEMIN) if(.not. retlog) write(*,*) "Dialog error for IDC_SPIN_INTEGRATION_STEPSIZE_RANGEMIN" retlog = DLGSET( ControlPanelDlg, IDC_SPIN_INTEGRATION_STEPSIZE, SPIN_INTEGRATION_STEPSIZE_SMALLSTEP, DLG_SMALLSTEP) if(.not. retlog) write(*,*) "Dialog error for IDC_SPIN_INTEGRATION_STEPSIZE_SMALLSTEP" retlog = DLGSET( ControlPanelDlg, IDC_SPIN_INTEGRATION_STEPSIZE, SPIN_INTEGRATION_STEPSIZE_BIGSTEP, DLG_BIGSTEP) if(.not. retlog) write(*,*) "Dialog error for IDC_SPIN_INTEGRATION_STEPSIZE_BIGSTEP" retlog = DLGSET( ControlPanelDlg, IDC_SPIN_INTEGRATION_STEPSIZE, SPIN_INTEGRATION_STEPSIZE_RANGEMAX, DLG_RANGEMAX) if(.not. retlog) write(*,*) "Dialog error for IDC_SPIN_INTEGRATION_STEPSIZE_RANGEMAX" retlog = DlgSetSub( ControlPanelDlg, IDC_SPIN_INTEGRATION_STEPSIZE, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_SPIN_INTEGRATION_STEPSIZE" retlog = DLGSET( ControlPanelDlg, IDC_PANX, vPanX, DLG_POSITION) if(.not. retlog) write(*,*) "Dialog error for IDC_PANX" retlog = DLGSET( ControlPanelDlg, IDC_PANY, vPanY, DLG_POSITION) if(.not. retlog) write(*,*) "Dialog error for IDC_PANY" retlog = DLGSET( ControlPanelDlg, IDC_PANZ, vPanZ, DLG_POSITION) if(.not. retlog) write(*,*) "Dialog error for IDC_PANZ" retlog = DlgSetSub( ControlPanelDlg, IDC_BUTTON_VIEW, ControlPanelCallBack ) if(.not. retlog) write(*,*) "Dialog error for IDC_BUTTON_VIEW" call ControlPanelSetSliderDeltaTime(DeltaTime) ControlPannelRunning = .true. returnVal = DlgModal( ControlPanelDlg ) ! Doesn't return unless cancled (or IDC_event not specified) ControlPanelExit = .TRUE. ControlPanelPause = .FALSE. ControlPanel = returnVal end FUNCTION ControlPanel recursive subroutine ControlPanelNewDamper(NewDamper) USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' logical :: NewDamper logical :: retlog vCheckDamper = NewDamper CheckDamper = NewDamper retlog = DLGSETLOG (ControlPanelDlg, IDC_CHECK_DAMPER, vCheckDamper) end subroutine ControlPanelNewDamper recursive subroutine ControlPanelPauseSub use GlobalData implicit none do while(ControlPanelPause .eq. .true.) ! wait 100 miliseconds (1/10 second) call sleepqq(100) if(ControlPanelPauseRefresh .eq. .true.) then ControlPanelPauseRefresh = .false. ! Make sure display is refreshed to reflect changes made call Update_AVFRT(' ') endif end do end subroutine ControlPanelPauseSub ! Display desired stepsize recursive subroutine ControlPanelDisplay_vIntegrationStepsize USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' CHARACTER(256) text LOGICAL retlog write(text, '(F16.12)') vIntegrationStepsize text = ADJUSTL(text) retlog = DLGSET( ControlPanelDlg, IDC_INTEGRATION_STEPSIZE, text ) end subroutine ControlPanelDisplay_vIntegrationStepsize ! Display current stepsize recursive subroutine ControlPanelDisplay_IntegrationStepsize USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' CHARACTER(256) text LOGICAL retlog write(text, '(F16.12)') IntegrationStepsize text = ADJUSTL(text) retlog = DLGSET( ControlPanelDlg, IDC_INTEGRATION_STEPSIZE2, text ) end subroutine ControlPanelDisplay_IntegrationStepsize recursive subroutine ControlPanelDisplayTime(T) #ifdef _OPENMP use omp_lib #endif USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' real :: T CHARACTER(256) text LOGICAL retlog integer :: iTimeHH, iTimeMM, iTimeSS real :: TimeFraction #ifdef _OPENMP real, save :: Tlast = 0.0 real, save :: wTimeLast = 0.0 real :: wTimeNow, virtualTimeInteral, realTimeInterval wTimeNow = omp_get_wtime() virtualTimeInteral = T - Tlast Tlast = T realTimeInterval = wTimeNow - wTimeLast wTimeLast = wTimeNow if(T .eq. 0.0) then virtualTimeInteral = 1.0 ! avoid first time divide by 0 realTimeInterval = 1.0 endif #endif iTimeHH = INT(T / 60 / 60) iTimeMM = INT((T - (iTimeHH * 60 * 60)) / 60) iTimeSS = INT(T - (iTimeHH * 60 * 60) - (iTimeMM * 60)) TimeFraction = T - (iTimeHH * 60 * 60) - (iTimeMM * 60) - iTimeSS #ifdef _OPENMP write(text, '(I8,A1,I2.2,A1,I2.2,F13.12,A1,F15.12)') iTimeHH, ':', iTimeMM, ':', iTimeSS, TimeFraction, ' ', virtualTimeInteral / realTimeInterval #else write(text, '(I8,A1,I2.2,A1,I2.2,F13.12)') iTimeHH, ':', iTimeMM, ':', iTimeSS, TimeFraction #endif DisplayTime = text retlog = DLGSET( ControlPanelDlg, IDC_RUNTIME, text ) ! Display desired stepsize call ControlPanelDisplay_vIntegrationStepsize ! Display current stepsize call ControlPanelDisplay_IntegrationStepsize end subroutine ControlPanelDisplayTime recursive subroutine ControlPanelSliderAnnealRate USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' CHARACTER(25) text LOGICAL retlog retlog = DLGGET (ControlPanelDlg, IDC_SLIDER2, & slide2_position, DLG_POSITION) CheckAnnealAnnealRate = dble(slide2_position + 1) / 100. ! Never 0, bias by 1 write(text, '(A2,F7.2)') 'ar',CheckAnnealAnnealRate retlog = DLGSET( ControlPanelDlg, IDC_ar, text ) end subroutine ControlPanelSliderAnnealRate recursive subroutine ControlPanelSetSliderAnnealRate(Rate) USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' real :: Rate CHARACTER(25) text LOGICAL retlog slide2_position = INT(Rate*100) slide2_position = MIN(slide2_position, 100) slide2_position = MAX(slide2_position, 0) retlog = DLGSET (ControlPanelDlg, IDC_SLIDER2, slide2_position, DLG_POSITION) CheckAnnealAnnealRate = dble(slide2_position + 1) / 100. ! Never 0, bias by 1 write(text, '(A2,F7.2)') 'ar',CheckAnnealAnnealRate retlog = DLGSET( ControlPanelDlg, IDC_ar, text ) end subroutine ControlPanelSetSliderAnnealRate recursive subroutine ControlPanelSliderDeltaTime USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' CHARACTER(25) text LOGICAL retlog retlog = DLGGET (ControlPanelDlg, IDC_SLIDER1, & slide1_position, DLG_POSITION) if(slide1_position < 10) then DeltaTime = .0000001 * dble(slide1_position + 1) elseif(slide1_position < 20) then DeltaTime = .000001 * dble(slide1_position - 10 + 1) elseif(slide1_position < 30) then DeltaTime = .00001 * dble(slide1_position - 20 + 1) elseif(slide1_position < 40) then DeltaTime = .0001 * dble(slide1_position - 30 + 1) elseif(slide1_position < 50) then DeltaTime = .001 * dble(slide1_position - 40 + 1) elseif(slide1_position < 60) then DeltaTime = .01 * dble(slide1_position - 50 + 1) elseif(slide1_position < 70) then DeltaTime = .1 * dble(slide1_position - 60 + 1) elseif(slide1_position < 80) then DeltaTime = 1. * dble(slide1_position - 70 + 1) elseif(slide1_position < 90) then DeltaTime = 100. * dble(slide1_position - 80 + 1) else DeltaTime = 50000. * dble(slide1_position - 90 + 1) endif write(text, '(A2,F14.6)') 'dt',DeltaTime retlog = DLGSET( ControlPanelDlg, IDC_dt, text ) end subroutine ControlPanelSliderDeltaTime recursive subroutine ControlPanelSetSliderDeltaTime(dt) USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' real :: dt CHARACTER(25) text LOGICAL retlog DeltaTime = dt if(DeltaTime < .000001) then slide1_position = DeltaTime / .0000001 + 1 elseif(DeltaTime < .00001) then slide1_position = (DeltaTime / .000001) + 10 + 1 elseif(DeltaTime < .0001) then slide1_position = (DeltaTime / .00001) + 20 + 1 elseif(DeltaTime < .001) then slide1_position = (DeltaTime / .0001) + 30 + 1 elseif(DeltaTime < .01) then slide1_position = (DeltaTime / .001) + 40 + 1 elseif(DeltaTime < .1) then slide1_position = (DeltaTime / .01) + 50 + 1 elseif(DeltaTime < 1.0) then slide1_position = (DeltaTime / .1) + 60 + 1 elseif(DeltaTime < 10.0) then slide1_position = (DeltaTime / 1.0) + 70 + 1 elseif(DeltaTime < 1000.0) then slide1_position = (DeltaTime / 100.0) + 80 + 1 else slide1_position = (DeltaTime / 50000.0) + 90 + 1 endif if(slide1_position .lt. 0) slide1_position = 0 if(slide1_position .gt. 100) slide1_position = 100 retlog = DLGSET (ControlPanelDlg, IDC_SLIDER1, & slide1_position, DLG_POSITION) write(text, '(A2,F14.6)') 'dt',DeltaTime retlog = DLGSET( ControlPanelDlg, IDC_dt, text ) end subroutine ControlPanelSetSliderDeltaTime recursive subroutine ControlPanelStretchX USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' CHARACTER(25) text LOGICAL retlog retlog = DLGGET (ControlPanelDlg, IDC_SLIDER3, & slide3_position, DLG_POSITION) vStretchX = MAX(dble(slide3_position)*1., 1.) end subroutine ControlPanelStretchX recursive subroutine ControlPanelStretchXtext USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' CHARACTER(25) text LOGICAL retlog write(text, '(A4,F14.3)') 'X * ',oStretchX text = ADJUSTL(text) text(5:) = ADJUSTL(text(5:)) retlog = DLGSET( ControlPanelDlg, IDC_STRETCHX, text ) end subroutine ControlPanelStretchXtext recursive subroutine ControlPanelStretchY USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' CHARACTER(25) text LOGICAL retlog retlog = DLGGET (ControlPanelDlg, IDC_SLIDER4, & slide4_position, DLG_POSITION) vStretchY = MAX(dble(slide4_position)*1., 1.) end subroutine ControlPanelStretchY recursive subroutine ControlPanelStretchYtext USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' CHARACTER(25) text LOGICAL retlog write(text, '(A4,F14.3)') 'Y * ',oStretchY text = ADJUSTL(text) text(5:) = ADJUSTL(text(5:)) retlog = DLGSET( ControlPanelDlg, IDC_STRETCHY, text ) end subroutine ControlPanelStretchYtext recursive subroutine ControlPanelStretchZ USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' CHARACTER(25) text LOGICAL retlog retlog = DLGGET (ControlPanelDlg, IDC_SLIDER5, & slide5_position, DLG_POSITION) vStretchZ = MAX(dble(slide5_position)*1., 1.) end subroutine ControlPanelStretchZ recursive subroutine ControlPanelStretchZtext USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' CHARACTER(25) text LOGICAL retlog write(text, '(A4,F14.3)') 'Z * ',oStretchZ text = ADJUSTL(text) text(5:) = ADJUSTL(text(5:)) retlog = DLGSET( ControlPanelDlg, IDC_STRETCHZ, text ) end subroutine ControlPanelStretchZtext recursive subroutine ControlPanelStretchCharts USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' CHARACTER(25) text LOGICAL retlog retlog = DLGGET (ControlPanelDlg, IDC_SLIDER6, & slide6_position, DLG_POSITION) ! ChartJiggle = ScaleRange / 10. StretchCharts = (dble(slide6_position) / ((ScaleRange / ChartJiggle)* 3.)) + 1. end subroutine ControlPanelStretchCharts recursive subroutine ControlPanelIntegrationStepsizeMultiplierGain USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' CHARACTER(25) text LOGICAL retlog retlog = DLGGET (ControlPanelDlg, IDC_SLIDER7, & vIntegrationStepsizeMultiplierGain, DLG_POSITION) end subroutine ControlPanelIntegrationStepsizeMultiplierGain recursive subroutine TweekDisplaySoon use GlobalData use MOD_HOST implicit none NextDisplayTime = HOST%rT + 1. end subroutine TweekDisplaySoon recursive subroutine ControlPanelPanX USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' LOGICAL retlog retlog = DLGGET (ControlPanelDlg, IDC_PANX, & vPanX, DLG_POSITION) call TweekDisplaySoon end subroutine ControlPanelPanX recursive subroutine ControlPanelPanY USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' LOGICAL retlog retlog = DLGGET (ControlPanelDlg, IDC_PANY, & vPanY, DLG_POSITION) call TweekDisplaySoon end subroutine ControlPanelPanY recursive subroutine ControlPanelPanZ USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' LOGICAL retlog retlog = DLGGET (ControlPanelDlg, IDC_PANZ, & vPanZ, DLG_POSITION) call TweekDisplaySoon end subroutine ControlPanelPanZ recursive subroutine PokeFiveStateButton(id, vButton) USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' CHARACTER(25) text LOGICAL retlog INTEGER id, vButton select case (vButton) case (0) vButton = 1 text = 'i/r' case (1) vButton = 2 text = 'i/d' case (2) vButton = 3 text = 'a/r' case (3) vButton = 4 text = 't/r' case default vButton = 0 text = '0' end select ! retlog = DLGSET( dlg, IDC_PAUSE_RESUME, text ) retlog = DLGSET( ControlPanelDlg, id, text ) end subroutine PokeFiveStateButton recursive subroutine ControlPanelSpinIntegrationStepsize USE IFLOGM use GlobalData use MOD_HOST implicit none INCLUDE 'RESOURCE.FD' CHARACTER(25) text LOGICAL retlog integer(4) :: us, iValue, usPerTick real :: TickWeight retlog = DLGGET (ControlPanelDlg, IDC_SPIN_INTEGRATION_STEPSIZE, & iValue , DLG_POSITION) ! Convert iValue to being relative to midpoint iValue = iValue - (SPIN_INTEGRATION_STEPSIZE_RANGEMAX / 2) TickWeight = vIntegrationStepsize * 10.0 / dble(SPIN_INTEGRATION_STEPSIZE_RANGEMAX) vIntegrationStepsize = vIntegrationStepsize + (TickWeight * dble(iValue)) call ControlPanelDisplay_vIntegrationStepsize end subroutine ControlPanelSpinIntegrationStepsize recursive subroutine ControlPanelSetGenisisMessage(iPhase, iStep) USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' CHARACTER(25) text LOGICAL retlog integer(4) :: iPhase, iStep write(text, '(I6, A3, I6)') iPhase, ' - ', iStep retlog = DLGSET( ControlPanelDlg, IDC_STATIC_GENISIS_MESSAGE, text ) end subroutine ControlPanelSetGenisisMessage recursive subroutine ControlPanelSetIntegrationStepsize(StepSize) USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' real :: StepSize CHARACTER(25) text LOGICAL retlog integer(4) :: iValue, nsPerTick vIntegrationStepsize = StepSize iValue = SPIN_INTEGRATION_STEPSIZE_RANGEMAX / 2 retlog = DLGSET( ControlPanelDlg, IDC_SPIN_INTEGRATION_STEPSIZE, iValue, DLG_POSITION) ! Display desired stepsize call ControlPanelDisplay_vIntegrationStepsize ! Display current stepsize call ControlPanelDisplay_IntegrationStepsize end subroutine ControlPanelSetIntegrationStepsize recursive subroutine LaunchViewDialog USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' INTERFACE integer(4) FUNCTION ViewPanel(arg) !DEC$ ATTRIBUTES STDCALL, ALIAS:"_viewpanel" :: ViewPanel integer(4),POINTER :: arg END FUNCTION END INTERFACE if(oButtonView) return oButtonView = .true. if(.not. ViewPannelRunning) then ! Create seperate thread to run the Modal Dialog control pannel ViewPanelHandle = CreateThread(& & NULL, ViewPanelStack, loc(ViewPanel), loc(ViewPanelArg), ViewPanelFlags, loc(ViewPanelThread_ID)) ViewPannelRunning = .true. endif end subroutine LaunchViewDialog SUBROUTINE ViewPanelCallBack( dlg, id, callbacktype ) !DEC$ ATTRIBUTES DEFAULT :: ViewPanelCallBack USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' TYPE (dialog) dlg INTEGER :: id, callbacktype, iStat LOGICAL :: retlog, retCheck INTEGER cel, far, retint ControlPanelPauseRefresh = .true. NextDisplayTime = 0 ! update now SELECT CASE (id) CASE (IDC_RADIO_SBS) vFocusOn = FocusOnSBS CASE (IDC_RADIO_SUN) vFocusOn = FocusOnSun CASE (IDC_RADIO_MERCURY) vFocusOn = FocusOnMercury CASE (IDC_RADIO_VENUS) vFocusOn = FocusOnVenus CASE (IDC_RADIO_EARTH) vFocusOn = FocusOnEarth CASE (IDC_RADIO_MARS) vFocusOn = FocusOnMars CASE (IDC_RADIO_JUPITER) vFocusOn = FocusOnJupiter CASE (IDC_RADIO_SATURN) vFocusOn = FocusOnSaturn CASE (IDC_RADIO_URANUS) vFocusOn = FocusOnUranus CASE (IDC_RADIO_NEPTUNE) vFocusOn = FocusOnNeptune CASE (IDC_RADIO_PLUTO) vFocusOn = FocusOnPluto CASE (IDC_CHECK_SUN) call CheckViewSub(dlg, IDC_CHECK_SUN, bitCheckViewSun) CASE (IDC_CHECK_MERCURY) call CheckViewSub(dlg, IDC_CHECK_MERCURY, bitCheckViewMercury) CASE (IDC_CHECK_VENUS) call CheckViewSub(dlg, IDC_CHECK_VENUS, bitCheckViewVenus) CASE (IDC_CHECK_EARTH) call CheckViewSub(dlg, IDC_CHECK_EARTH, bitCheckViewEarth) CASE (IDC_CHECK_EARTHMOON) call CheckViewSub(dlg, IDC_CHECK_EARTHMOON, bitCheckViewEarthMoon) CASE (IDC_CHECK_MARS) call CheckViewSub(dlg, IDC_CHECK_MARS, bitCheckViewMars) CASE (IDC_CHECK_JUPITER) call CheckViewSub(dlg, IDC_CHECK_JUPITER, bitCheckViewJupiter) CASE (IDC_CHECK_SATURN) call CheckViewSub(dlg, IDC_CHECK_SATURN, bitCheckViewSaturn) CASE (IDC_CHECK_URANUS) call CheckViewSub(dlg, IDC_CHECK_URANUS, bitCheckViewUranus) CASE (IDC_CHECK_NEPTUNE) call CheckViewSub(dlg, IDC_CHECK_NEPTUNE, bitCheckViewNeptune) CASE (IDC_CHECK_PLUTO) call CheckViewSub(dlg, IDC_CHECK_PLUTO, bitCheckViewPluto) CASE (IDC_CHECK_ASTEROIDS) call CheckViewSub(dlg, IDC_CHECK_ASTEROIDS, bitCheckViewAsteroids) CASE (IDC_CHECK_COMETS) call CheckViewSub(dlg, IDC_CHECK_COMETS, bitCheckViewComets) CASE (IDC_CHECK_SPACECRAFT) call CheckViewSub(dlg, IDC_CHECK_SPACECRAFT, bitCheckViewSpacecraft) END SELECT END SUBROUTINE ViewPanelCallBack recursive subroutine CheckViewSub(dlg, id, bitCheckViewBit) USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' TYPE (dialog) dlg INTEGER :: id, bitCheckViewBit LOGICAL :: retlog, retCheck retlog = DLGGETLOG (dlg, id, retCheck) if(retCheck) then vCheckViewMask = IOR(vCheckViewMask, bitCheckViewBit) else vCheckViewMask = IAND(vCheckViewMask, NOT(bitCheckViewBit)) endif end subroutine CheckViewSub integer(4) FUNCTION ViewPanel(arg) !DEC$ ATTRIBUTES STDCALL, ALIAS:"_viewpanel" :: ViewPanel USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' integer(4),POINTER :: arg integer(4) returnVal, us CHARACTER(256) text LOGICAL retlog external ViewPanelCallBack retlog = DLGINIT( IDD_DIALOG2, ViewPanelDlg ) ! call DlgSetTitle( ViewPanelDlg, ViewPanelTitle ) retlog = DlgSetSub( ViewPanelDlg, IDC_RADIO_SBS, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_RADIO_SUN, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_RADIO_MERCURY, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_RADIO_VENUS, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_RADIO_EARTH, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_RADIO_MARS, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_RADIO_JUPITER, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_RADIO_SATURN, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_RADIO_URANUS, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_RADIO_NEPTUNE, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_RADIO_PLUTO, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_CHECK_SUN, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_CHECK_MERCURY, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_CHECK_VENUS, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_CHECK_EARTH, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_CHECK_EARTHMOON, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_CHECK_MARS, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_CHECK_JUPITER, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_CHECK_SATURN, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_CHECK_URANUS, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_CHECK_NEPTUNE, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_CHECK_PLUTO, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_CHECK_ASTEROIDS, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_CHECK_COMETS, ViewPanelCallBack ) retlog = DlgSetSub( ViewPanelDlg, IDC_CHECK_SPACECRAFT, ViewPanelCallBack ) call ViewPanelSetFocus retlog = DLGSETLOG (ViewPanelDlg, IDC_CHECK_SUN, (IAND(vCheckViewMask, bitCheckViewSun) .ne. 0)) retlog = DLGSETLOG (ViewPanelDlg, IDC_CHECK_MERCURY, (IAND(vCheckViewMask, bitCheckViewMercury) .ne. 0)) retlog = DLGSETLOG (ViewPanelDlg, IDC_CHECK_VENUS, (IAND(vCheckViewMask, bitCheckViewVenus) .ne. 0)) retlog = DLGSETLOG (ViewPanelDlg, IDC_CHECK_EARTH, (IAND(vCheckViewMask, bitCheckViewEarth) .ne. 0)) retlog = DLGSETLOG (ViewPanelDlg, IDC_CHECK_EARTHMOON, (IAND(vCheckViewMask, bitCheckViewEarthMoon) .ne. 0)) retlog = DLGSETLOG (ViewPanelDlg, IDC_CHECK_MARS, (IAND(vCheckViewMask, bitCheckViewMars) .ne. 0)) retlog = DLGSETLOG (ViewPanelDlg, IDC_CHECK_JUPITER, (IAND(vCheckViewMask, bitCheckViewJupiter) .ne. 0)) retlog = DLGSETLOG (ViewPanelDlg, IDC_CHECK_SATURN, (IAND(vCheckViewMask, bitCheckViewSaturn) .ne. 0)) retlog = DLGSETLOG (ViewPanelDlg, IDC_CHECK_URANUS, (IAND(vCheckViewMask, bitCheckViewUranus) .ne. 0)) retlog = DLGSETLOG (ViewPanelDlg, IDC_CHECK_NEPTUNE, (IAND(vCheckViewMask, bitCheckViewNeptune) .ne. 0)) retlog = DLGSETLOG (ViewPanelDlg, IDC_CHECK_PLUTO, (IAND(vCheckViewMask, bitCheckViewPluto) .ne. 0)) retlog = DLGSETLOG (ViewPanelDlg, IDC_CHECK_ASTEROIDS, (IAND(vCheckViewMask, bitCheckViewAsteroids) .ne. 0)) retlog = DLGSETLOG (ViewPanelDlg, IDC_CHECK_COMETS, (IAND(vCheckViewMask, bitCheckViewComets) .ne. 0)) retlog = DLGSETLOG (ViewPanelDlg, IDC_CHECK_SPACECRAFT, (IAND(vCheckViewMask, bitCheckViewSpacecraft) .ne. 0)) returnVal = DlgModal( ViewPanelDlg ) ! Doesn't return unless cancled (or IDC_event not specified) ViewPanel = returnVal ViewPannelRunning = .FALSE. oButtonView = .FALSE. vButtonView = .FALSE. ViewPanelHandle = 0 end FUNCTION ViewPanel recursive subroutine ViewPanelSetFocus USE IFLOGM use GlobalData implicit none INCLUDE 'RESOURCE.FD' integer(4),POINTER :: arg integer(4) returnVal, us CHARACTER(256) text LOGICAL retlog retlog = DLGSETLOG( ViewPanelDlg, IDC_RADIO_SBS, (vFocusOn .eq. FocusOnSBS)) retlog = DLGSETLOG( ViewPanelDlg, IDC_RADIO_SUN, (vFocusOn .eq. FocusOnSun)) retlog = DLGSETLOG( ViewPanelDlg, IDC_RADIO_MERCURY, (vFocusOn .eq. FocusOnMercury)) retlog = DLGSETLOG( ViewPanelDlg, IDC_RADIO_VENUS, (vFocusOn .eq. FocusOnVenus)) retlog = DLGSETLOG( ViewPanelDlg, IDC_RADIO_EARTH, (vFocusOn .eq. FocusOnEarth)) retlog = DLGSETLOG( ViewPanelDlg, IDC_RADIO_MARS, (vFocusOn .eq. FocusOnMars)) retlog = DLGSETLOG( ViewPanelDlg, IDC_RADIO_JUPITER, (vFocusOn .eq. FocusOnJupiter)) retlog = DLGSETLOG( ViewPanelDlg, IDC_RADIO_SATURN, (vFocusOn .eq. FocusOnSaturn)) retlog = DLGSETLOG( ViewPanelDlg, IDC_RADIO_URANUS, (vFocusOn .eq. FocusOnUranus)) retlog = DLGSETLOG( ViewPanelDlg, IDC_RADIO_NEPTUNE, (vFocusOn .eq. FocusOnNeptune)) retlog = DLGSETLOG( ViewPanelDlg, IDC_RADIO_PLUTO, (vFocusOn .eq. FocusOnPluto)) end subroutine ViewPanelSetFocus
Jim Dempsey
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
@jimdempseyatthecove: I am using a modal dialog for the UI, but, unlike yours, it's written in C++. My project does all the UI in C++, and almost all of the computations in Fortran.
After replacing the SendMessage with PostMessage, my app does not hang, so OpenMP is blameless. As far as the second team of threads, this still happens, but repeat computations use the same two teams, even though Wide is called from a different thread each time. I have no explanation for this, but it does what I need.
I'm impressed with your control panel code. It must have been a lot of work. Are you by any chance using a planetary ephemeris?
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
>>but repeat computations use the same two teams, even though Wide is called from a different thread each time.
Then the behavior has changed since I first observed this about 3 years ago with a C# main, spawning/terminating a thread that eventually called a Fortran DLL that used OpenMP. It is likely that Intel has inserted code into the (Windows) TerminateThread function that disbands its OpenMP thread pool. Note, this being the case, your application is encountering excessive overhead in creating and disbanding thread pools on each iteration. It would be much better to create this ancillary thread once, then synchronize its start on each iteration.
Jim Dempsey
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
@jimdempseyatthecove
>>but repeat computations use the same two teams, even though Wide is called from a different thread each time.
>It is likely that Intel has inserted code into the (Windows) TerminateThread function that disbands its OpenMP thread pool. Note, this being the case, your application is encountering excessive overhead in creating and disbanding thread pools on each iteration. It would be much better to create this ancillary thread once, then synchronize its start on each iteration.
I checked this, and the Windows thread IDs (handles) are unchanged, so threads aren't being created and destroyed. I also verified that after thread termination of the worker thread on the final return of the thread in C++, the second team of OpenMP threads were still there.
Even if threads were being destroyed and created, though, the overhead is negligible in comparison to the Fortran computation's time. Somehow, it seems that OpenMP has managed to keep their thread team intact over worker thread boundaries.
![](/skins/images/7B0AB6865064EAE32B30EC9A4E94B48A/responsive_peak/images/icon_anonymous_message.png)
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page