Community
cancel
Showing results for 
Search instead for 
Did you mean: 
Highlighted
Beginner
29 Views

OpenMP parallel DO hangs 2nd time thru

[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

0 Kudos
8 Replies
Highlighted
29 Views

The following may be a reason

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.

See: https://www.intel.com/content/www/us/en/develop/documentation/fortran-compiler-developer-guide-and-r...

https://software.intel.com/content/www/us/en/develop/documentation/fortran-compiler-developer-guide-...

Jim Dempsey

0 Kudos
Highlighted
Beginner
29 Views

@jimdempseyatthecove

@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.

0 Kudos
Highlighted
29 Views

>>I changed the code to

>>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

0 Kudos
Highlighted
Beginner
29 Views

I have checked that no thread

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()

0 Kudos
Highlighted
29 Views

>>This is just supposed to

>>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

0 Kudos
Highlighted
Beginner
29 Views

@jimdempseyatthecove: I  am

@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?

0 Kudos
Highlighted
29 Views

>>but repeat computations use

>>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

0 Kudos
Highlighted
Beginner
29 Views

@jimdempseyatthecove

@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.

0 Kudos