MINICERN/mathlib/gen/d/epdsrt.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:18  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10        SUBROUTINE EPDSRT(NR,NBPR,XBPR,UBPR)
  11 C
  12 C     SORT AND REARRANGE BOUNDARY POINTS AND VALUE
  13 C
  14       DIMENSION NBPR(200),XBPR(200,20),UBPR(200,20),F(20),G(20)
  15       DO 25 IR=1,NR
  16       J=NBPR(IR)
  17       IF(2*(J/2)-J)1,2,1
  18     1 WRITE(6,100)NR,J,(XBPR(IR,K),K=1,J)
  19       STOP
  20 C---------
  21     2 K=0
  22     3 N=J
  23       IF(N-1)25,5,15
  24     5 K=K+1
  25       F(K)=XBPR(IR,1)
  26       G(K)=UBPR(IR,1)
  27       DO 10 L=1,K
  28       XBPR(IR,L)=F(L)
  29    10 UBPR(IR,L)=G(L)
  30       GO TO 25
  31    15 XMIN=XBPR(IR,1)
  32       PHI=UBPR(IR,1)
  33       DO 22 L=2,N
  34       J=L-1
  35       IF(XBPR(IR,L)-XMIN)21,20,20
  36    20 UBPR(IR,J)=UBPR(IR,L)
  37       XBPR(IR,J)=XBPR(IR,L)
  38       GO TO 22
  39    21 UBPR(IR,J)=PHI
  40       XBPR(IR,J)=XMIN
  41       PHI=UBPR(IR,L)
  42       XMIN=XBPR(IR,L)
  43    22 CONTINUE
  44       K=K+1
  45       F(K)=XMIN
  46       G(K)=PHI
  47       GO TO 3
  48    25 CONTINUE
  49       RETURN
  50   100 FORMAT('0  MESH ROW OR COLUMN NUMBER',I5,
  51      1  ' APPEARS TO INTERSECT BOUNDARY AT',I5,' POINTS,',
  52      2  ' THE NUMBER'/'0 OF POINTS BEING ODD AND SO, IMPOSSIBLE',
  53      3  '. CO-ORDINATES OF ALLEGED INTERSECTIONS ARE',//(F15.6))
  54       END