*********************************************************************sdk ************************************************************************ * * Subroutine NSORTA * * Function: * Sort N columns on values in given column, acending * * Method: * Sorting by straight insertion * * Arguments: * MaxC (i) fast dimension of sort matrix * MaxR (i) slow dimension of sort matrix * NC (i) number of columns * NR (i) number of rows * Key (i) pointer to sort-column * Srtmtx (i/o) nc x nr integer matrix to sort * Errcod (o) error code * errcod = 0 - no error * errcod = 1 - illegal key value * errcod = 2 - too many columns * * History: * Modified from ISORT october 6 - S. Knight ************************************************************************ subroutine nsorta ( maxc , maxr , nc , nr , key , srtmtx , & errcod ) implicit none * Arguments integer maxc , maxr integer nc , nr integer key integer srtmtx( maxc,maxr ) integer errcod * Local variables integer i , j , k integer maxcol parameter ( maxcol = 40 ) integer isave( maxcol ) *----------------------------------------------------------------------- * Init errcod = 0 * Check input if ( key .lt. 1 .or. key .gt. nc ) then errcod = 1 return endif if ( nc .gt. maxcol ) then errcod = 2 return endif * Sort acending do 70 i = 1 , nr - 1 do 10 j = 1 , nc isave( j ) = srtmtx( j,i+1 ) 10 continue do 40 j = i , 1 , -1 if ( isave( key ) .ge. srtmtx( key,j ) ) then goto 50 else do 20 k = 1 , nc srtmtx( k,j+1 ) = srtmtx( k,j ) 20 continue endif 40 continue 50 do 60 k = 1 , nc srtmtx( k,j+1 ) = isave( k ) 60 continue 70 continue return end