!-----------------------------------------------------------------------
!
!  PROGRAM   : GMXMBK
!
!  AUTHOR    :
!
!  FUNCTION  : FIND SIZE OF LARGEST AVAILABLE MEMORY BLOCK.
!
!  ARGUMENTS :
!
!  |------------------------------------------------------------------|
!  | NAME   | DESCRIPTION                                             |
!  |------------------------------------------------------------------|
!  |        |                                                         |
!  | MYMBYT | LARGEST BLOCK IN BYTES                                  |
!  |        |                                                         |
!  | MYMMMB | LARGEST BLOCK IN MB                                     |
!  |        |                                                         |
!  | IYRETU | ERROR RETURN CODE.                                      |
!  |        |                                                         |
!  |------------------------------------------------------------------|
!
!-----------------------------------------------------------------------

      MODULE SGMXMBI

      CONTAINS

      SUBROUTINE GMXMBI(IYFUNC,MYMBYT,MYMMMB,MYNFRE,IYRETU)

!-----------------------------------------------------------------------
! **** MODULES ****
!-----------------------------------------------------------------------

      USE KERNEL32

!-----------------------------------------------------------------------
! **** SUBROUTINES/FUNCTIONS ****
!-----------------------------------------------------------------------


!-----------------------------------------------------------------------
! **** ALL NAMES MUST BE DECLARED ****
!-----------------------------------------------------------------------

      IMPLICIT NONE

!-----------------------------------------------------------------------
! **** ARGUMENTS ****
!-----------------------------------------------------------------------

      INTEGER(4),   INTENT(OUT)  :: MYMBYT
      INTEGER(4),   INTENT(OUT)  :: MYMMMB
      INTEGER(4),   INTENT(OUT)  :: MYNFRE
      INTEGER(2),   INTENT(IN)   :: IYFUNC
      INTEGER(2),   INTENT(OUT)  :: IYRETU

!-----------------------------------------------------------------------
! **** PARAMETERS ****
!-----------------------------------------------------------------------

      INTEGER(DWORD), PARAMETER  :: DXMBYT=1024*1024
      INTEGER(2),     PARAMETER  :: IXWRIT=99
      INTEGER(4),     PARAMETER  :: MXFILF=21
      INTEGER(4),     PARAMETER  :: MXFILU=22

!-----------------------------------------------------------------------
! **** VARIABLES ****
!-----------------------------------------------------------------------

      TYPE (T_MEMORY_BASIC_INFORMATION) :: TXSTAT
      TYPE (T_SYSTEM_INFO)              :: SYSINFO
      INTEGER(BOOL)                     :: MXRETU

      INTEGER(LPCVOID)                  :: MXMADR
      INTEGER(DWORD)                    :: DXSTRL

      INTEGER (SIZE_T)                  :: MXMAXL
      INTEGER(4)                        :: MXIOST
      INTEGER(4)                        :: MXTOTF,MXTOTU
      INTEGER(4)                        :: MXCOMM,MXRESV,MXDCOM,MXRELE
      INTEGER(4)                        :: MXPRIM,MXMAPM,MXRESE,MXTOPD
      INTEGER(4)                        :: MXWRIR,MXPHYS,MX4PAG,MXWRIW
      CHARACTER(20)                     :: CXTYPE

!-----------------------------------------------------------------------
! INITIALIZE
!-----------------------------------------------------------------------

      MXMAXL=0
      MYNFRE=0
      MXTOTF=0
      MXTOTU=0
      MXCOMM=0
      MXRESV=0
      MXDCOM=0
      MXRELE=0
      MXPRIM=0
      MXMAPM=0
      MXRESE=0
      MXTOPD=0
      MXWRIR=0
      MXPHYS=0
      MX4PAG=0
      MXWRIW=0

!-----------------------------------------------------------------------
! SET THE LENGTH FIELD IN STRUCTURE STAT
!-----------------------------------------------------------------------

      DXSTRL=SIZEOF(TXSTAT)

!-----------------------------------------------------------------------
! GET SYSTEM INFO
!-----------------------------------------------------------------------

      CALL GETSYSTEMINFO(SYSINFO)

!-----------------------------------------------------------------------
! IF WRITE MODE, THE OPEN FILE
!-----------------------------------------------------------------------

      IF (IYFUNC.EQ.IXWRIT) THEN
          OPEN(MXFILF,FILE="APS_MEMORY_FREEBLOCK_LIST.TXT",STATUS='UNKNOWN',ACCESS='APPEND',  &
               SHARE='DENYNONE',IOSTAT=MXIOST,FORM='FORMATTED',ERR=9102)
      ENDIF

!-----------------------------------------------------------------------
! LOOP OVER ALL MEMORY BLOXKS
!-----------------------------------------------------------------------

      MXMADR=0

      DO WHILE ( MXMADR.LE.SYSINFO%LPMAXIMUMAPPLICATIONADDRESS)

        MXRETU=VIRTUALQUERY(MXMADR,TXSTAT,DXSTRL)

         IF (MXRETU.EQ.0) THEN
            GOTO 9101
         END IF

         SELECT CASE (TXSTAT%STATE)
            CASE (MEM_COMMIT)
               CXTYPE='MEM_COMMIT'
               MXCOMM=MXCOMM+TXSTAT%REGIONSIZE
               MXTOTU=MXTOTU+TXSTAT%REGIONSIZE

            CASE (MEM_RESERVE)
               CXTYPE='MEM_RESERVE'
               MXRESV=MXRESV+TXSTAT%REGIONSIZE
               MXTOTU=MXTOTU+TXSTAT%REGIONSIZE

            CASE (MEM_DECOMMIT)
               CXTYPE='MEM_DECOMMIT'
               MXDCOM=MXDCOM+TXSTAT%REGIONSIZE
               MXTOTU=MXTOTU+TXSTAT%REGIONSIZE

            CASE (MEM_RELEASE)
               CXTYPE='MEM_RELEASE'
               MXRELE=MXRELE+TXSTAT%REGIONSIZE
               MXTOTU=MXTOTU+TXSTAT%REGIONSIZE

            CASE (MEM_FREE)
               CXTYPE='MEM_FREE'
               MXTOTF=MXTOTF+TXSTAT%REGIONSIZE

            CASE (MEM_PRIVATE)
               CXTYPE='MEM_PRIVATE'
               MXPRIM=MXPRIM+TXSTAT%REGIONSIZE
               MXTOTU=MXTOTU+TXSTAT%REGIONSIZE

            CASE (MEM_MAPPED)
               CXTYPE='MEM_MAPPED'
               MXMAPM=MXMAPM+TXSTAT%REGIONSIZE
               MXTOTU=MXTOTU+TXSTAT%REGIONSIZE

            CASE (MEM_RESET)
               CXTYPE='MEM_RESET'
               MXRESE=MXRESE+TXSTAT%REGIONSIZE
               MXTOTU=MXTOTU+TXSTAT%REGIONSIZE

            CASE (MEM_TOP_DOWN)
               CXTYPE='MEM_TOP_DOWN'
               MXTOPD=MXTOPD+TXSTAT%REGIONSIZE
               MXTOTU=MXTOTU+TXSTAT%REGIONSIZE

            CASE (MEM_WRITE_WATCH)
               CXTYPE='MEM_WRITE_WATCH'
               MXWRIR=MXWRIW+TXSTAT%REGIONSIZE
               MXTOTU=MXTOTU+TXSTAT%REGIONSIZE

            CASE (MEM_PHYSICAL)
               CXTYPE='MEM_PHYSICAL'
               MXPHYS=MXPHYS+TXSTAT%REGIONSIZE
               MXTOTU=MXTOTU+TXSTAT%REGIONSIZE

            CASE (MEM_4MB_PAGES)
               CXTYPE='MEM_4MB_PAGES'
               MX4PAG=MX4PAG+TXSTAT%REGIONSIZE
               MXTOTU=MXTOTU+TXSTAT%REGIONSIZE
         END SELECT

         IF ( IAND(TXSTAT%STATE,MEM_FREE).EQ.MEM_FREE) THEN
            IF (MXMAXL.LT.TXSTAT%REGIONSIZE) THEN
               MXMAXL=TXSTAT%REGIONSIZE
            ENDIF
            MYNFRE=MYNFRE+1
         ENDIF

         IF (IYFUNC.EQ.IXWRIT) THEN
            WRITE (MXFILF,'(A20,Z0,A,I0,A,I0)') CXTYPE,TXSTAT%BASEADDRESS,' ',TXSTAT%REGIONSIZE/1024,' ',TXSTAT%REGIONSIZE
         ENDIF

         MXMADR = MXMADR+TXSTAT%REGIONSIZE
      ENDDO

!-----------------------------------------------------------------------
! SET RETURN VALUES
!-----------------------------------------------------------------------

      MYMBYT=MXMAXL
      MYMMMB=MXMAXL/DXMBYT

      IF (IYFUNC.EQ.IXWRIT) THEN
         WRITE (MXFILF,*) '  '
         WRITE (MXFILF,'(A,I0,A,I0)') 'Number Free blocks: ',MYNFRE, ' Largest block: ',MYMMMB
         WRITE (MXFILF,*) '  '
         WRITE (MXFILF,*) '---------------------------------------------------------------------------------------'
         WRITE (MXFILF,*) '  '

         WRITE (MXFILF,*) 'MEM_COMMIT :     ',MXCOMM,'  ',MXCOMM/DXMBYT
         WRITE (MXFILF,*) 'MEM_RESERVE:     ',MXRESV,'  ',MXRESV/DXMBYT
         WRITE (MXFILF,*) 'MEM_DECOMMIT:    ',MXDCOM,'  ',MXDCOM/DXMBYT
         WRITE (MXFILF,*) 'MEM_RELEASE:     ',MXRELE,'  ',MXRELE/DXMBYT
         WRITE (MXFILF,*) 'MEM_FREE:        ',MXTOTF,'  ',MXTOTF/DXMBYT
         WRITE (MXFILF,*) 'MEM_PRIVATE:     ',MXPRIM,'  ',MXPRIM/DXMBYT
         WRITE (MXFILF,*) 'MEM_MAPPED:      ',MXMAPM,'  ',MXMAPM/DXMBYT
         WRITE (MXFILF,*) 'MEM_RESET:       ',MXRESE,'  ',MXRESE/DXMBYT
         WRITE (MXFILF,*) 'MEM_TOP_DOWN:    ',MXTOPD,'  ',MXTOPD/DXMBYT
         WRITE (MXFILF,*) 'MEM_WRITE_WATCH: ',MXWRIW,'  ',MXWRIW/DXMBYT
         WRITE (MXFILF,*) 'MEM_PHYSICAL:    ',MXPHYS,'  ',MXPHYS/DXMBYT
         WRITE (MXFILF,*) 'MEM_4MB_PAGES:   ',MX4PAG,'  ',MX4PAG/DXMBYT

         CLOSE(MXFILF)
      ENDIF

      MYNFRE=MXTOTF

!-----------------------------------------------------------------------
! NO ERRORS OR WARNINGS.
!-----------------------------------------------------------------------

 9000 CONTINUE
      IYRETU=0
      GOTO 9999

!-----------------------------------------------------------------------
! ERROR IN VIRTUALQUERY.
!-----------------------------------------------------------------------

 9101 CONTINUE
      IYRETU=-1
      GOTO 9999

!-----------------------------------------------------------------------
! ERROR IN IO.
!-----------------------------------------------------------------------

 9102 CONTINUE
      IYRETU=-2
      GOTO 9999

!-----------------------------------------------------------------------
! RETURN.
!-----------------------------------------------------------------------

 9999 CONTINUE

      RETURN

      END SUBROUTINE

      END MODULE