5
    6
    7
    8
    9
   10
   11
   12
   13      LOGICAL            WKNOWN
   14      CHARACTER          RANGE
   15      INTEGER            IL, IU, MAXSIZE, N, VALSIZE, VECSIZE
   16      DOUBLE PRECISION   VL, VU
   17
   18
   19      INTEGER            DESCA( * ), ISEED( 4 )
   20      DOUBLE PRECISION   WIN( * )
   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      INTEGER            BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
  105     $                   MB_, NB_, RSRC_, CSRC_, LLD_
  106      parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
  107     $                   ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
  108     $                   rsrc_ = 7, csrc_ = 8, lld_ = 9 )
  109      DOUBLE PRECISION   TWENTY
  110      parameter( twenty = 20.0d0 )
  111
  112
  113
  114      INTEGER            CLUSTERSIZE, I, ILMIN, IUMAX, MAXCLUSTERSIZE,
  115     $                   MQ0, MYCOL, MYIL, MYIU, MYROW, NB, NEIG, NN,
  116     $                   NP0, NPCOL, NPROW
  117      DOUBLE PRECISION   ANORM, EPS, ORFAC, SAFMIN, VLMIN, VUMAX
  118
  119
  120
  121
  122      LOGICAL            LSAME
  123      INTEGER            ICEIL, NUMROC
  124      DOUBLE PRECISION   DLARAN, PDLAMCH
  126
  127
  128      EXTERNAL           blacs_gridinfo
  129
  130
  131      INTRINSIC          abs, dble, int, 
max 
  132
  133
  134
  135      IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
  136     $    rsrc_.LT.0 )RETURN
  137
  138      orfac = 1.0d-3
  139
  140
  141      CALL blacs_gridinfo( desca( ctxt_ ), nprow, npcol, myrow, mycol )
  142      eps = 
pdlamch( desca( ctxt_ ), 
'Precision' )
 
  143      safmin = 
pdlamch( desca( ctxt_ ), 
'Safe Minimum' )
 
  144      nb = desca( mb_ )
  146      np0 = 
numroc( nn, nb, 0, 0, nprow )
 
  147
  148      valsize = 5*n + 
max( 5*nn, nb*( np0+1 ) )
 
  149
  150      IF( wknown ) THEN
  151         anorm = safmin / eps
  152         IF( n.GE.1 )
  153     $      anorm = 
max( abs( win( 1 ) ), abs( win( n ) ), anorm )
 
  154
  155         IF( 
lsame( range, 
'I' ) ) 
THEN 
  156            IF( il.LT.0 )
  157     $         il = int( 
dlaran( iseed )*dble( n ) ) + 1
 
  158            IF( iu.LT.0 )
  159     $         iu = int( 
dlaran( iseed )*dble( n-il ) ) + il
 
  160            IF( n.EQ.0 )
  161     $         iu = 0
  162         ELSE IF( 
lsame( range, 
'V' ) ) 
THEN 
  163            IF( vl.GT.vu ) THEN
  164               myil = int( 
dlaran( iseed )*dble( n ) ) + 1
 
  165               myiu = int( 
dlaran( iseed )*dble( n-myil ) ) + myil
 
  166               vl = win( myil ) + twenty*eps*abs( win( myil ) )
  167               vu = win( myiu ) + twenty*eps*abs( win( myiu ) )
  168               vu = 
max( vu, vl+eps*twenty*abs( vl )+safmin )
 
  169            END IF
  170         END IF
  171
  172      END IF
  173      IF( 
lsame( range, 
'V' ) ) 
THEN 
  174
  175
  176
  177         IF( wknown ) THEN
  178            vlmin = vl - twenty*eps*anorm
  179            vumax = vu + twenty*eps*anorm
  180            ilmin = 1
  181            iumax = 0
  182            DO 10 i = 1, n
  183               IF( win( i ).LT.vlmin )
  184     $            ilmin = ilmin + 1
  185               IF( win( i ).LT.vumax )
  186     $            iumax = iumax + 1
  187   10       CONTINUE
  188         ELSE
  189            ilmin = 1
  190            iumax = n
  191         END IF
  192      ELSE IF( 
lsame( range, 
'I' ) ) 
THEN 
  193         ilmin = il
  194         iumax = iu
  195      ELSE IF( 
lsame( range, 
'A' ) ) 
THEN 
  196         ilmin = 1
  197         iumax = n
  198      END IF
  199
  200      neig = iumax - ilmin + 1
  201
  202      mq0 = 
numroc( 
max( neig, nb, 2 ), nb, 0, 0, npcol )
 
  203      vecsize = 5*n + 
max( 5*nn, np0*mq0+2*nb*nb ) +
 
  204     $          
iceil( neig, nprow*npcol )*nn
 
  205
  206      IF( wknown ) THEN
  207         clustersize = 1
  208         maxclustersize = 1
  209         DO 20 i = ilmin + 1, iumax
  210            IF( ( win( i )-win( i-1 ) ).LT.orfac*2*anorm ) THEN
  211               clustersize = clustersize + 1
  212               IF( clustersize.GT.maxclustersize )
  213     $            maxclustersize = clustersize
  214            ELSE
  215               clustersize = 1
  216            END IF
  217   20    CONTINUE
  218         IF( clustersize.GT.maxclustersize )
  219     $      maxclustersize = clustersize
  220      ELSE
  221         maxclustersize = n
  222      END IF
  223
  224      maxsize = vecsize + 
max( ( maxclustersize-1 ), 0 )*n
 
  225
  226
  227      RETURN
  228
  229
  230
integer function iceil(inum, idenom)
 
integer function numroc(n, nb, iproc, isrcproc, nprocs)
 
double precision function pdlamch(ictxt, cmach)