!--------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!-! MODULE MsgCapabilities USE mpi USE MsgBase USE, INTRINSIC :: iso_c_binding IMPLICIT NONE CHARACTER( len=* ), PARAMETER :: MCT_msgName = 'Capabilities' INTEGER, PARAMETER :: MCT_msgTag = 97 INTEGER :: MCT_mpiDatatype = MPI_DATATYPE_NULL TYPE, EXTENDS( MsgBaseType ) :: MsgCapabilitiesType INTEGER :: mRank INTEGER :: mSize CHARACTER( len=MPI_MAX_PROCESSOR_NAME ) :: hostname INTEGER( KIND=C_long ) :: freeRam INTEGER( KIND=C_long ) :: totalRam INTEGER( KIND=C_int ) :: cores CONTAINS PROCEDURE :: MCT_loadSysInfo PROCEDURE :: str => MCT_getStr PROCEDURE :: getMsgName => MCT_getName PROCEDURE :: getMsgTag => MCT_getTag PROCEDURE :: getMpiDatatype => MCT_getMpiDatatype PROCEDURE, PRIVATE :: MCT_loadMpiDatatype END TYPE MsgCapabilitiesType INTERFACE MsgCapabilitiesType PROCEDURE MCT_constructor END INTERFACE INTERFACE SUBROUTINE getMem( freeRam, totalRam ) BIND( C ) IMPORT :: C_long INTEGER( KIND=C_long ) :: freeRam, totalRam END SUBROUTINE SUBROUTINE getCores( cores ) BIND( C ) IMPORT :: C_int INTEGER( KIND=C_int ) :: cores END SUBROUTINE END INTERFACE CONTAINS !----!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!-! FUNCTION MCT_getName( self ) RESULT( iName ) CLASS( MsgCapabilitiesType ), INTENT( in ) :: self CHARACTER( len=132 ) :: iName iName = MCT_msgName END FUNCTION !----!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!-! FUNCTION MCT_getMpiDatatype( self ) CLASS( MsgCapabilitiesType ) :: self INTEGER :: MCT_getMpiDatatype IF( MPI_DATATYPE_NULL == MCT_mpiDatatype ) CALL self%MCT_loadMpiDatatype() MCT_getMpiDatatype = MCT_mpiDatatype END FUNCTION !----!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!-! FUNCTION MCT_getTag( self ) RESULT( response ) CLASS( MsgCapabilitiesType ) :: self INTEGER :: response response = MCT_msgTag END FUNCTION !----!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!-! SUBROUTINE MCT_loadMpiDatatype( self ) CLASS( MsgCapabilitiesType ) :: self TYPE( MpiAssistType ) :: maType maType = MpiAssistType( 7 ) CALL maType%MA_loadComponent( thisItem=self%baseId, itemNumber=1, itemCount=1, itemType=MPI_INTEGER ) CALL maType%MA_loadComponent( thisItem=self%mRank, itemNumber=2, itemCount=1, itemType=MPI_INTEGER ) CALL maType%MA_loadComponent( thisItem=self%mSize, itemNumber=3, itemCount=1, itemType=MPI_INTEGER ) CALL maType%MA_loadComponent( thisItem=self%hostname, itemNumber=4, itemCount=MPI_MAX_PROCESSOR_NAME, & itemType=MPI_CHARACTER ) CALL maType%MA_loadComponent( thisItem=self%freeRam, itemNumber=5, itemCount=1, itemType=MPI_LONG ) CALL maType%MA_loadComponent( thisItem=self%totalRam, itemNumber=6, itemCount=1, itemType=MPI_LONG ) CALL maType%MA_loadComponent( thisItem=self%cores, itemNumber=7, itemCount=1, itemType=MPI_INTEGER ) MCT_mpiDatatype = maType%MA_getType() END SUBROUTINE !----!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!-! FUNCTION MCT_getStr( self ) CLASS( MsgCapabilitiesType ), INTENT( in ) :: self CHARACTER( len=132 ) :: MCT_getStr IF( MPI_DATATYPE_NULL == MCT_mpiDatatype ) MCT_mpiDatatype = self%getMpiDatatype() WRITE( MCT_getStr, & '("MCT:: rank=", I0, " size=", I0, " datatype=", I0, " RAM free:", I0, " total:", I0, " cores:", I0)' ) & self%mRank, self%mSize, MCT_mpiDatatype, self%freeRam, self%totalRam, self%cores END FUNCTION !----!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!-! FUNCTION MCT_constructor() RESULT( self ) TYPE( MsgCapabilitiesType ) :: self INTEGER :: iErr INTEGER :: hostnameLength CALL MPI_Get_processor_name( self%hostname, hostnameLength, iErr ) CALL MPI_COMM_RANK( MPI_COMM_WORLD, self%mRank, iErr ) CALL MPI_COMM_SIZE( MPI_COMM_WORLD, self%mSize, iErr ) CALL self%MCT_loadSysInfo() END FUNCTION !----!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!-! ! I attempted to move this to a SubModule, but failed. SUBROUTINE MCT_loadSysInfo( self ) CLASS( MsgCapabilitiesType ), INTENT( inout ) :: self INTEGER( KIND=C_long ) :: freeRam INTEGER( KIND=C_long ) :: totalRam INTEGER( KIND=C_int ) :: cores CALL getMem( freeRam, totalRam ) self%freeRam = freeRam self%totalRam = totalRam CALL getcores( cores ) self%cores = cores END SUBROUTINE END MODULE !--------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!---------!-!