- 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.
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page