2
    3
    4
    5
    6
    7
    8
    9      INTEGER            IX, INCX, JX, N
   10      REAL               SA
   11
   12
   13      INTEGER            DESCX( * )
   14      COMPLEX            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
  122      INTEGER            BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
  123     $                   LLD_, MB_, M_, NB_, N_, RSRC_
  124      parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
  125     $                     ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
  126     $                     rsrc_ = 7, csrc_ = 8, lld_ = 9 )
  127      REAL               ONE, ZERO
  128      parameter( one = 1.0e+0, zero = 0.0e+0 )
  129
  130
  131      LOGICAL            DONE
  132      INTEGER            ICTXT, MYCOL, MYROW, NPCOL, NPROW
  133      REAL               BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
  134
  135
  136      EXTERNAL           blacs_gridinfo, pcsscal, 
pslabad 
  137
  138
  139      REAL               PSLAMCH
  141
  142
  143      INTRINSIC          abs
  144
  145
  146
  147
  148
  149      ictxt = descx( ctxt_ )
  150      CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
  151
  152
  153
  154      IF( n.LE.0 )
  155     $   RETURN
  156
  157
  158
  160      bignum = one / smlnum
  161      CALL pslabad( ictxt, smlnum, bignum )
 
  162
  163
  164
  165      cden = sa
  166      cnum = one
  167
  168   10 CONTINUE
  169      cden1 = cden*smlnum
  170      cnum1 = cnum / bignum
  171      IF( abs( cden1 ).GT.abs( cnum ) .AND. cnum.NE.zero ) THEN
  172
  173
  174
  175
  176         mul = smlnum
  177         done = .false.
  178         cden = cden1
  179      ELSE IF( abs( cnum1 ).GT.abs( cden ) ) THEN
  180
  181
  182
  183
  184         mul = bignum
  185         done = .false.
  186         cnum = cnum1
  187      ELSE
  188
  189
  190
  191         mul = cnum / cden
  192         done = .true.
  193      END IF
  194
  195
  196
  197      CALL pcsscal( n, mul, sx, ix, jx, descx, incx )
  198
  199      IF( .NOT.done )
  200     $   GO TO 10
  201
  202      RETURN
  203
  204
  205
real function pslamch(ictxt, cmach)
 
subroutine pslabad(ictxt, small, large)