Cloned SEACAS for EXODUS library with extra build files for internal package management.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

60 lines
1.9 KiB

2 years ago
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
C NTESS, the U.S. Government retains certain rights in this software.
C
C See packages/seacas/LICENSE for details
SUBROUTINE MKRNK(N,NTOTAL,NDIM,X,IND,IRNK,IRNK2)
C***********************************************************************
C DESCRIPTION: THIS ROUTINE CONVERTS THE IRNK VECTORS IN THE SWEGLE
C SEARCH FROM AN INDIRECT GATHER TO A DIRECT GATHER
C N INTEGER NUMBER OF ENTITIES THAT WAS SORTED
C NDIM INTEGER NUMBER OF DIMENSIONS
C X REAL ENTITIES TO BE SORTED
C IND INTEGER INDEX VECTOR
C IRNK INTEGER RANK VECTOR (INDIRECT)
C IRNK2 INTEGER RANK VECTOR (DIRECT)
C***********************************************************************
include 'tapes.blk'
DIMENSION X(NTOTAL,NDIM),IND(N,NDIM)
DIMENSION IRNK(N,NDIM),IRNK2(N,NDIM,*)
DO 11 IDM = 1, NDIM
CALL INDEXX(X(1,IDM),IND(1,IDM),N,.true.)
CALL RANK(N,IND(1,IDM),IRNK(1,IDM),N)
11 CONTINUE
C CONSTRUCT DIRECT LISTS INTO ORDERED LIST OF POINTS
IF(NDIM .EQ. 1)THEN
DO 113 I = 1, N
IRNK2(I,1,1) = IRNK(I,1)
113 CONTINUE
ELSE IF( NDIM .EQ. 2)THEN
DO 213 I = 1, N
IRNK2(I,1,1) = IRNK(IND(I,1),2)
IRNK2(I,2,1) = IRNK(IND(I,2),1)
213 CONTINUE
ELSE IF( NDIM .EQ. 3)THEN
DO 313 I=1,N
IRNK2(I,1,1) = IRNK(IND(I,1),2)
IRNK2(I,1,2) = IRNK(IND(I,1),3)
IRNK2(I,2,1) = IRNK(IND(I,2),1)
IRNK2(I,2,2) = IRNK(IND(I,2),3)
IRNK2(I,3,1) = IRNK(IND(I,3),1)
IRNK2(I,3,2) = IRNK(IND(I,3),2)
313 CONTINUE
ELSE
PRINT*,'WRONG NUMBER OF DIMENSIONS IN MKRNK'
STOP
ENDIF
RETURN
END