2
    3
    4
    5
    6
    7
    8
    9      INTEGER            IX, INCX, JX, N
   10      REAL               SA
   11
   12
   13      INTEGER            DESCX( * )
   14      REAL               SX( * )
   15
   16
   17
   18
   19
   20
   21
   22
   23
   24
   25
   26
   27
   28
   29
   30
   31
   32
   33
   34
   35
   36
   37
   38
   39
   40
   41
   42
   43
   44
   45
   46
   47
   48
   49
   50
   51
   52
   53
   54
   55
   56
   57
   58
   59
   60
   61
   62
   63
   64
   65
   66
   67
   68
   69
   70
   71
   72
   73
   74
   75
   76
   77
   78
   79
   80
   81
   82
   83
   84
   85
   86
   87
   88
   89
   90
   91
   92
   93
   94
   95
   96
   97
   98
   99
  100
  101
  102
  103
  104
  105
  106
  107
  108
  109
  110
  111
  112
  113
  114
  115
  116
  117
  118
  119
  120
  121      INTEGER            BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
  122     $                   LLD_, MB_, M_, NB_, N_, RSRC_
  123      parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
  124     $                     ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
  125     $                     rsrc_ = 7, csrc_ = 8, lld_ = 9 )
  126      REAL               ONE, ZERO
  127      parameter( one = 1.0e+0, zero = 0.0e+0 )
  128
  129
  130      LOGICAL            DONE
  131      INTEGER            ICTXT, MYCOL, MYROW, NPCOL, NPROW
  132      REAL               BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
  133
  134
  135      EXTERNAL           blacs_gridinfo, 
pslabad, psscal
 
  136
  137
  138      REAL               PSLAMCH
  140
  141
  142      INTRINSIC          abs
  143
  144
  145
  146
  147
  148      ictxt = descx( ctxt_ )
  149      CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
  150
  151
  152
  153      IF( n.LE.0 )
  154     $   RETURN
  155
  156
  157
  159      bignum = one / smlnum
  160      CALL pslabad( ictxt, smlnum, bignum )
 
  161
  162
  163
  164      cden = sa
  165      cnum = one
  166
  167   10 CONTINUE
  168      cden1 = cden*smlnum
  169      cnum1 = cnum / bignum
  170      IF( abs( cden1 ).GT.abs( cnum ) .AND. cnum.NE.zero ) THEN
  171
  172
  173
  174
  175         mul = smlnum
  176         done = .false.
  177         cden = cden1
  178      ELSE IF( abs( cnum1 ).GT.abs( cden ) ) THEN
  179
  180
  181
  182
  183         mul = bignum
  184         done = .false.
  185         cnum = cnum1
  186      ELSE
  187
  188
  189
  190         mul = cnum / cden
  191         done = .true.
  192      END IF
  193
  194
  195
  196      CALL psscal( n, mul, sx, ix, jx, descx, incx )
  197
  198      IF( .NOT.done )
  199     $   GO TO 10
  200
  201      RETURN
  202
  203
  204
real function pslamch(ictxt, cmach)
 
subroutine pslabad(ictxt, small, large)