Appendix A - Example Program

The following code is intended to illustrate possible failure when a processor receives a subnormal number, but may not itself (by default) handle such numbers.

The example constructs a one by two grid with process identifiers (0,0) and (0,1), and assumes that process (0,0) is running on a processor that generates IEEE subnormal numbers. For (possible) failure to occur process (0,1) should be running on a processor that does not support subnormal numbers.

We have observed failure when (0,0) is running on a Sun4 (which handles subnormal numbers correctly), and process (0,1) is running on a DEC Alpha under Unix, which by default flushes subnormal numbers to zero. (The non-default compiler flag -fpe1 will trap to software emulation.)

The program utilizes the BLACS. See [&make_named_href('', "node12.html#DW:UTK-cs:95","[8]")] for further details on the BLACS.

      PROGRAM SUBNRM
*
*     .. Local Scalars ..
      INTEGER            IAM, ICNTXT, MYCOL, MYROW, NPCOL, NPROCS, NPROW
      REAL               TWO
*     .. Local Arrays ..
      REAL               X( 1 )
*     .. External Subroutines ..
      EXTERNAL           BLACS_EXIT, BLACS_GET, BLACS_GRIDINFO,
     $                   BLACS_GRIDINIT, BLACS_PINFO, BLACS_SETUP,
     $                   SGERV2D, SGESD2D
*     ..
*
*     Determine my process number and the number of processes in
*     machine
*
*     .. Executable Statements ..
      CALL BLACS_PINFO( IAM, NPROCS )
*
*     If underlying system needs additional setup, do it now
*
      IF( NPROCS.LT.1 ) THEN
         IF( IAM.EQ.0 ) THEN
            NPROCS = 2
         END IF
         CALL BLACS_SETUP( IAM, NPROCS )
      END IF
*
*     Set up a 1 by 2 process grid
*
      NPROW = 1
      NPCOL = 2
*
*     Get default system context, and initialize the grid
*
      CALL BLACS_GET( 0, 0, ICNTXT )
      CALL BLACS_GRIDINIT( ICNTXT, 'Row-major', NPROW, NPCOL )
      CALL BLACS_GRIDINFO( ICNTXT, NPROW, NPCOL, MYROW, MYCOL )
*
*     If I am in the grid perform some computation
*
      IF( MYROW.GE.0 .AND. MYROW.LT.NPROW ) THEN
*
         TWO = 2.0E+0
         IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
            X( 1 ) = 7.52316390E-37
            X( 1 ) = X( 1 ) / 128.0E+0
*        X(1) = 0.58774718E-38, which is subnormal on IEEE machines
*
*        This call to SGESD2D sends X(1) to process (0,1)
            CALL SGESD2D( ICNTXT, 1, 1, X, 1, 0, 1 )
            WRITE( *, FMT = '(A,E16.8)' )'X00 = ', X( 1 )
            X( 1 ) = X( 1 ) / TWO
            WRITE( *, FMT = '(A,E16.8)' )'X00 / 2 = ', X( 1 )
*
         ELSE IF( MYROW.EQ.0 .AND. MYCOL.EQ.1 ) THEN
*
*        This call to SGERV2D receives X(1) from process (0,0)
            CALL SGERV2D( ICNTXT, 1, 1, X, 1, 0, 0 )
            WRITE( *, FMT = '(A,E16.8)' )'X01 = ', X( 1 )
            X( 1 ) = X( 1 ) / TWO
            WRITE( *, FMT = '(A,E16.8)' )'X01 / 2 = ', X( 1 )
*
         END IF
      END IF
*
*     Exit the BLACS cleanly
*
      CALL BLACS_EXIT( 0 )
*
      STOP
      END