d6/d96/desc__convert_8f_source.html

00001       SUBROUTINE DESC_CONVERT( DESC_IN, DESC_OUT, INFO )
00002 *
00003 *
00004 *     .. Array Arguments ..
00005       INTEGER DESC_IN( * ), DESC_OUT( * ), INFO
00006 *     ..
00007 *
00008 *  Purpose
00009 *  =======
00010 *
00011 *  Converts descriptors from one type to another if they are compatible.
00012 *
00013 *  Supports *ONLY* an output descriptor type of 1D_horizontal (type
00014 *     number 501) or 1D_vertical (number 502).
00015 *  Supports only one-dimensional 1xP input grids if descriptor_in is 2D.
00016 *
00017 *  Arguments
00018 *  =========
00019 *
00020 *  DESC_IN: (input) input descriptor
00021 *
00022 *  DESC_OUT: (output) output descriptor (required to be 1D_horizontal
00023 *            in this release).
00024 *
00025 *  INFO: (output) return code
00026 *
00027 *  =====================================================================
00028 *
00029 *     .. Parameters ..
00030       INTEGER            BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DT_,
00031      $                   LLD_, MB_, M_, NB_, N_, RSRC_
00032       PARAMETER          ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DT_ = 1,
00033      $                     CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
00034      $                     RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
00035 *     ..
00036 *
00037 *     .. Local Scalars ..
00038       INTEGER         DESC_TYPE, DESC_TYPE_IN, ICTXT
00039       INTEGER         CSRC, RSRC, MB, NB, LLDA
00040       INTEGER         M, N, NPROW, NPCOL, IDUM1, IDUM2
00041 *
00042 *     .. External routines ..
00043 *     EXTERNAL        BLACS_GRIDINFO
00044 *     ..
00045 *     .. Executable Statements ..
00046 *
00047       INFO = 0
00048 *
00049       DESC_TYPE_IN = DESC_IN( 1 )
00050 *
00051 *     .. Initialize Variables ..
00052 *
00053         RSRC = 0
00054         NB = 0
00055         N = 0
00056         MB = 0
00057         M = 0
00058         LLDA = 0
00059         CSRC = 0
00060 *
00061       IF( DESC_TYPE_IN .EQ. BLOCK_CYCLIC_2D ) THEN
00062          ICTXT = DESC_IN( CTXT_ )
00063          RSRC = DESC_IN( RSRC_ )
00064          CSRC = DESC_IN( CSRC_ )
00065          MB = DESC_IN( MB_ )
00066          NB = DESC_IN( NB_ )
00067          LLDA = DESC_IN( LLD_ )
00068          M = DESC_IN( M_ )
00069          N = DESC_IN( N_ )
00070          CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, IDUM1, IDUM2 )
00071       ELSEIF ( DESC_TYPE_IN .EQ. 502 ) THEN
00072          ICTXT = DESC_IN( 2 )
00073          RSRC = DESC_IN( 5 )
00074          CSRC = 1
00075          MB = DESC_IN( 4 )
00076          NB = 1
00077          LLDA = DESC_IN( 6 )
00078          M = DESC_IN( 3 )
00079          N = 1
00080          NPROW = 0
00081          NPCOL = 1
00082       ELSEIF ( DESC_TYPE_IN .EQ. 501 ) THEN
00083          ICTXT = DESC_IN( 2 )
00084          RSRC = 1
00085          CSRC = DESC_IN( 5 )
00086          MB = 1
00087          NB = DESC_IN( 4 )
00088          LLDA = DESC_IN( 6 )
00089          M = 1
00090          N = DESC_IN( 3 )
00091          NPROW = 1
00092          NPCOL = 0
00093       ENDIF
00094 *
00095 *
00096       DESC_TYPE = DESC_OUT( 1 )
00097 *
00098       IF( DESC_TYPE .EQ. 501 ) THEN
00099          IF( NPROW .NE. 1 )THEN
00100             INFO = -1
00101             RETURN
00102          ENDIF
00103          DESC_OUT( 2 ) = ICTXT
00104          DESC_OUT( 5 ) = CSRC
00105          DESC_OUT( 4 ) = NB
00106          DESC_OUT( 6 ) = LLDA
00107          DESC_OUT( 3 ) = N
00108       ELSEIF( DESC_TYPE .EQ. 502 ) THEN
00109          IF( NPCOL .NE. 1 )THEN
00110             INFO = -1
00111             RETURN
00112          ENDIF
00113          DESC_OUT( 2 ) = ICTXT
00114          DESC_OUT( 5 ) = RSRC
00115          DESC_OUT( 4 ) = MB
00116          DESC_OUT( 6 ) = LLDA
00117          DESC_OUT( 3 ) = M
00118       ENDIF
00119 *
00120       RETURN
00121 *
00122 *     End of DESC_CONVERT
00123 *
00124       END