BATCH/ ASYNCHRONOUS PROCESSING WITH ABSOFT

[Mark Coxhead]

BATCH/ ASYNCHRONOUS PROCESSING WITH ABSOFT

I have a linear programming application that has to undergo multiple iterations to determine an optimum solution.   At present this is done interactively with enormous amounts of intermediate results that scroll to the screen.

Is it therefore possible within Absoft to launch such applications in batch mode to execute asynchronously using either shell or multithread processing?

Thank you.

[Jean-Claude Arbaut]

It's difficult to answer without knowing a bit more about your application : do you have the source code ? Is it in Fortran ?
In case you have the source code, you may be able to modify the input/output process, though it can be painful.

Otherwise, you have to control the application from a Fortran program. Then it depends entirely on the application : from your post I guess it's a command-line program. Does it have some facility to take input from a text file instead of keyboard (by a command-line argument) ? If there is such a thing, you have just to know the syntax of this file.

Otherwise, you will have to control the program by "simulating" keyboard entry and getting screen output. On UNIX systems, it's usually done with "popen", and on Windows there is a way to do this, see http://stackoverflow.com/questions/450865/what-is-the-equivalent-to-posix-popen-in-the-win32-api
However, it's a C function, and you will have to use Absoft's ability to communicate with C libraries (not sure it has ISO_C_BINDING, but there are other ways in Absoft, see the manual).
Now, if you are really going along this path, it may be interesting to switch to another, simpler language, to drive the whole process.
Python comes to mind, as it possesses already the tools for such tasks, see for example https://docs.python.org/3/library/subprocess.html
And you could even build Fortran DLLs to be driven by Python (using numpy, usually). I have seen a large numerical application with many parts in several languages, driven by a unique GUI in Python, and it's a very nice combination (it was based on Alliances/Salome, but I know there are others) : Python is awesome for data management and GUI, Fortran is awesome for numerical computations.

Hope this helps,

Jean-Claude Arbaut

[Frances Rose Bauckham]

A slight variant on the original question which is about launching batch jobs from Fortran.


We have several systems written in both Absoft Fortran and Visual Basic which have evolved like this mainly for historical reasons.    However, there is a much common functionality that is shared between the two technologies. 


From Visual Basic it is possible to run Absoft Fortran executables asynchronously using either the SHELL or SHELLEXECUTE commands and this has worked successfully for many years.   


My question is how do you achieve the same outcome the other way around, i.e. how do you call external Visual Basic executables from Absoft Fortran please?


Thank you.

[Mark Coxhead]

Hello  All,

I wrote my own subroutine to do this which uses several standard Windows APIs.     This has been in use now for some years and always seems to invoke the required VB6 module.  Sometimes there is a minor delay of a few milliseconds, but other than that works OK.

Code: [Select]

      SUBROUTINE SHELLEXECUTE(PROGRAM_NAME)
c       
C   New Program to handle call to Visual Basic Programs, e.g. Inspect & MNP
C   Written by Mark Coxhead
C******************************************************************************
C     Request     : MC030807                                                *
C     Date        : 03/08/07                                                  *
C     Version     : IMPACS67                                                  *
C     Programmer  : Mark Coxhead                                              *
C     Description : Conversion to Absoft version 10.0                         *
C******************************************************************************
C     Request     : MC140816                                                *
C     Date        : 14/08/16                                                  *
C     Version     : IMPACSxx                                                  *
C     Programmer  : Mark Coxhead                                              *
C     Description : Make this program generic, so allow to be called for all other VB programs  *
C******************************************************************************

        USE windows
        USE color_module !MC030807 
        IMPLICIT NONE

      CHARACTER*132 USER_DETAIL(10)                      !MC190603
      COMMON /CUSER/ USER_DETAIL                         !MC121018


        CHARACTER*20    PROGRAM_NAME !MC140818


        STRUCTURE /PROCESS_INFORMATION1/
        INTEGER*4       hProcess
        INTEGER*4       hThread
        INTEGER*4       dwProcessId
        INTEGER*4       dwThreadId
        END STRUCTURE

        STRUCTURE /STARTUPINFO1/
        INTEGER*4       cb
        INTEGER       lpReserved
        INTEGER       lpDesktop
        INTEGER       lpTitle
        INTEGER*4       dwX
        INTEGER*4       dwY
        INTEGER*4       dwXSize
        INTEGER*4       dwYSize
        INTEGER*4       dwXCountChars
        INTEGER*4       dwYCountChars
        INTEGER*4       dwFillAttribute
        INTEGER*4       dwFlags
        INTEGER*2       wShowWindow
        INTEGER*2       cbReserved2
        INTEGER       lpReserved2
        INTEGER*4       hStdInput
        INTEGER*4       hStdOutput
        INTEGER*4       hStdError
        END STRUCTURE

       record /STARTUPINFO1/ si                 !MC280705
       record /PROCESS_INFORMATION1/ pi         !MC280705

     

      integer*4 WinExec


      integer*4 RtlZeroMemory
     

      integer*4 CreateProcessA       


      integer*4 WaitForSingleObject


      integer*4 CloseHandle
 

      integer*4 GetLastError

      integer*4 FormatMessageA

      integer*4 wsprintf

      integer*4 LocalFree


 


      CHARACTER*200  s1,s2, s3, s4
      POINTER (ps3, s3)
     
      CHARACTER*96  FILE_NAME
      LOGICAL EXISTFLAG
      integer    Iret, qs3, ILen, L, I
     
      integer*4  mb, MessageBeep




      FILE_NAME = TRIM(USER_DETAIL(6))//PROGRAM_NAME                   !mc140818           
      ILen = LEN(TRIM(FILE_NAME))       !MC140818


      INQUIRE (FILE=FILE_NAME(:ILen),EXIST=EXISTFLAG)                 !MC140818
     
     
      IF (EXISTFLAG) THEN

     
            s1 = TRIM(FILE_NAME)//char(0)     


            si.lpTitle = loc(s1)
            si.dwX = 15
            si.dwY = 15
            si.dwXSize = 300
            si.dwYSize = 150
            si.dwFlags = STARTF_USEPOSITION .OR. STARTF_USESIZE
     +                                   .OR. STARTF_USESHOWWINDOW
            si.wShowWindow = SW_SHOWDEFAULT
            si.cb = sizeof(si)                                                       


            If (  CreateProcessA(val(NULL),                       !lpApplicationName
     +                               val(loc(s1)),               !lpCommandLine
     +                               val(NULL),                  !lpProcessAttributes
     +                               val(NULL),                  !lpThreadAttributes
     +                               val(.FALSE.),               !lpInheritHandles

     +         val(IOR(DETACHED_PROCESS, NORMAL_PRIORITY_CLASS)),  !dwCreationFlags       

     +                               val(NULL),                  !lpEnvironment 
     +                               val(NULL),                  !lpCurrentDirectory
     +                               val(loc(si)),               !lpStartupInfo
     +                               val(loc(pi)))               !lpProcessInformation
     +                                              ) then


                Iret = WaitForSingleObject(val(pi.hProcess),
     +                                     val(50000) )  !was 5000
                 If (Iret .EQ. WAIT_FAILED) then

                 Iret = GetLastError()

           If ( FormatMessageA(val(IOR(FORMAT_MESSAGE_ALLOCATE_BUFFER,   !MC030807   
     +                            IOR(FORMAT_MESSAGE_IGNORE_INSERTS,    !MC030807
     +                                FORMAT_MESSAGE_FROM_SYSTEM))),    !MC030807
     +                                 val(NULL),
     +                                 val(Iret),
     +                                 val(0),
     +                                 val(loc(qs3)),
     +                                 val(0),
     +                                 val(NULL) )    ) then                                                                 


                  ps3 = qs3

                  DO L = 200,1,-1
                      IF ((ichar(s3(L:L)) .GE. 0) .AND.
     +                     (ichar(s3(L:L)) .LE. 31)) then
                        ILen = L
                      ENDIF
                    ENDDO       

                   TEXT_COLOR = 19
                TYPE *, 'WAIT FAILED trying to run ',TRIM(s1),
     +               '  Error code ',Iret,' ',s3(:(ILen-1))
                          TYPE *,' Press < ENTER > to continue'   
                          pause
                        TEXT_COLOR = 1                 
                     ENDIF
                   endif
               else             

                   Iret = GetLastError()

           If ( FormatMessageA(val(IOR(FORMAT_MESSAGE_ALLOCATE_BUFFER,   !MC030807   
     +                            IOR(FORMAT_MESSAGE_IGNORE_INSERTS,    !MC030807
     +                                FORMAT_MESSAGE_FROM_SYSTEM))),    !MC030807
     +                                 val(NULL),
     +                                 val(Iret),
     +                                 val(0),
     +                                 val(loc(qs3)),
     +                                 val(0),
     +                                 val(NULL) )    ) then                                                                 


                  ps3 = qs3

                  DO L = 200,1,-1
                     IF ((ichar(s3(L:L)) .GE. 0) .AND.
     +                     (ichar(s3(L:L)) .LE. 31)) then
                        ILen = L
                      ENDIF
                   ENDDO       

                   TEXT_COLOR = 19
                   TYPE *, 'Unable to run ',TRIM(s1),
     +               '  Error code ',Iret,' ',s3(:(ILen-1))
                   TYPE *,' Press < ENTER > to continue'   
                   Iret = LocalFree(val(loc(s3))) !MC030807
                     ENDIF

                   PAUSE
                   TEXT_COLOR = 1
                 endif                   
                   
          Iret = CloseHandle(val(pi.hProcess))                !MC030807
          Iret = CloseHandle(val(pi.hThread))                 !MC030807

C          CALL mrwe_CheckMenuItem(4,13,MF_CHECKED)            !MC030807    !MC140818del   
      ELSE
          TEXT_COLOR = 19
          TYPE *, 'Unable to run ',TRIM(FILE_NAME),
     +             ' as the file does not exist at this location.'
          TYPE *, '  Press < ENTER > to continue '
          PAUSE
          TEXT_COLOR = 1
      ENDIF
     
      RETURN
      END