{"id":227,"date":"2017-09-13T11:20:57","date_gmt":"2017-09-13T14:20:57","guid":{"rendered":"http:\/\/www.professores.uff.br\/diomarcesarlobao\/?page_id=227"},"modified":"2017-09-13T11:20:57","modified_gmt":"2017-09-13T14:20:57","slug":"sorthalf-f","status":"publish","type":"page","link":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/sorthalf-f\/","title":{"rendered":"sorthalf.f"},"content":{"rendered":"<pre>      SUBROUTINE SSORT (X, Y, N, KFLAG)\r\nC***BEGIN PROLOGUE  SSORT\r\nC***PURPOSE  Sort an array and optionally make the same interchanges in\r\nC            an auxiliary array.  The array may be sorted in increasing\r\nC            or decreasing order.  A slightly modified QUICKSORT\r\nC            algorithm is used.\r\nC***LIBRARY   SLATEC\r\nC***CATEGORY  N6A2B\r\nC***TYPE      SINGLE PRECISION (SSORT-S, DSORT-D, ISORT-I)\r\nC***KEYWORDS  SINGLETON QUICKSORT, SORT, SORTING\r\nC***AUTHOR  Jones, R. E., (SNLA)\r\nC           Wisniewski, J. A., (SNLA)\r\nC***DESCRIPTION\r\nC\r\nC   SSORT sorts array X and optionally makes the same interchanges in\r\nC   array Y.  The array X may be sorted in increasing order or\r\nC   decreasing order.  A slightly modified quicksort algorithm is used.\r\nC\r\nC   Description of Parameters\r\nC      X - array of values to be sorted   (usually abscissas)\r\nC      Y - array to be (optionally) carried along\r\nC      N - number of values in array X to be sorted\r\nC      KFLAG - control parameter\r\nC            =  2  means sort X in increasing order and carry Y along.\r\nC            =  1  means sort X in increasing order (ignoring Y)\r\nC            = -1  means sort X in decreasing order (ignoring Y)\r\nC            = -2  means sort X in decreasing order and carry Y along.\r\nC\r\nC***REFERENCES  R. C. Singleton, Algorithm 347, An efficient algorithm\r\nC                 for sorting with minimal storage, Communications of\r\nC                 the ACM, 12, 3 (1969), pp. 185-187.\r\nC***REVISION HISTORY  (YYMMDD)\r\nC   761101  DATE WRITTEN\r\nC   761118  Modified to use the Singleton quicksort algorithm.  (JAW)\r\nC   890531  Changed all specific intrinsics to generic.  (WRB)\r\nC   890831  Modified array declarations.  (WRB)\r\nC   891009  Removed unreferenced statement labels.  (WRB)\r\nC   891024  Changed category.  (WRB)\r\nC   891024  REVISION DATE from Version 3.2\r\nC   891214  Prologue converted to Version 4.0 format.  (BAB)\r\nC   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)\r\nC   901012  Declared all variables; changed X,Y to SX,SY. (M. McClain)\r\nC   920501  Reformatted the REFERENCES section.  (DWL, WRB)\r\nC   920519  Clarified error messages.  (DWL)\r\nC   920801  Declarations section rebuilt and code restructured to use\r\nC           IF-THEN-ELSE-ENDIF.  (RWC, WRB)\r\nC***END PROLOGUE  SSORT\r\nC     .. Scalar Arguments ..\r\n      INTEGER KFLAG, N\r\nC     .. Array Arguments ..\r\n      REAL X(*), Y(*)\r\nC     .. Local Scalars ..\r\n      REAL R, T, TT, TTY, TY\r\n      INTEGER I, IJ, J, K, KK, L, M, NN\r\nC     .. Local Arrays ..\r\n      INTEGER IL(21), IU(21)\r\nC     .. External Subroutines ..\r\nC     None\r\nC     .. Intrinsic Functions ..\r\n      INTRINSIC ABS, INT\r\nC***FIRST EXECUTABLE STATEMENT  SSORT\r\n      NN = N\r\n      IF (NN .LT. 1) THEN\r\n         PRINT *,\r\n     +      'The number of values to be sorted is not positive.'\r\n         RETURN\r\n      ENDIF\r\nC\r\n      KK = ABS(KFLAG)\r\n      IF (KK.NE.1 .AND. KK.NE.2) THEN\r\n         PRINT *,\r\n     +      'The sort control parameter, K, is not 2, 1, -1, or -2.'\r\n         RETURN\r\n      ENDIF\r\nC\r\nC     Alter array X to get decreasing order if needed\r\nC\r\n      IF (KFLAG .LE. -1) THEN\r\n         DO 10 I=1,NN\r\n            X(I) = -X(I)\r\n   10    CONTINUE\r\n      ENDIF\r\nC\r\n      IF (KK .EQ. 2) GO TO 100\r\nC\r\nC     Sort X only\r\nC\r\n      M = 1\r\n      I = 1\r\n      J = NN\r\n      R = 0.375E0\r\nC\r\n   20 IF (I .EQ. J) GO TO 60\r\n      IF (R .LE. 0.5898437E0) THEN\r\n         R = R+3.90625E-2\r\n      ELSE\r\n         R = R-0.21875E0\r\n      ENDIF\r\nC\r\n   30 K = I\r\nC\r\nC     Select a central element of the array and save it in location T\r\nC\r\n      IJ = I + INT((J-I)*R)\r\n      T = X(IJ)\r\nC\r\nC     If first element of array is greater than T, interchange with T\r\nC\r\n      IF (X(I) .GT. T) THEN\r\n         X(IJ) = X(I)\r\n         X(I) = T\r\n         T = X(IJ)\r\n      ENDIF\r\n      L = J\r\nC\r\nC     If last element of array is less than than T, interchange with T\r\nC\r\n      IF (X(J) .LT. T) THEN\r\n         X(IJ) = X(J)\r\n         X(J) = T\r\n         T = X(IJ)\r\nC\r\nC        If first element of array is greater than T, interchange with T\r\nC\r\n         IF (X(I) .GT. T) THEN\r\n            X(IJ) = X(I)\r\n            X(I) = T\r\n            T = X(IJ)\r\n         ENDIF\r\n      ENDIF\r\nC\r\nC     Find an element in the second half of the array which is smaller\r\nC     than T\r\nC\r\n   40 L = L-1\r\n      IF (X(L) .GT. T) GO TO 40\r\nC\r\nC     Find an element in the first half of the array which is greater\r\nC     than T\r\nC\r\n   50 K = K+1\r\n      IF (X(K) .LT. T) GO TO 50\r\nC\r\nC     Interchange these elements\r\nC\r\n      IF (K .LE. L) THEN\r\n         TT = X(L)\r\n         X(L) = X(K)\r\n         X(K) = TT\r\n         GO TO 40\r\n      ENDIF\r\nC\r\nC     Save upper and lower subscripts of the array yet to be sorted\r\nC\r\n      IF (L-I .GT. J-K) THEN\r\n         IL(M) = I\r\n         IU(M) = L\r\n         I = K\r\n         M = M+1\r\n      ELSE\r\n         IL(M) = K\r\n         IU(M) = J\r\n         J = L\r\n         M = M+1\r\n      ENDIF\r\n      GO TO 70\r\nC\r\nC     Begin again on another portion of the unsorted array\r\nC\r\n   60 M = M-1\r\n      IF (M .EQ. 0) GO TO 190\r\n      I = IL(M)\r\n      J = IU(M)\r\nC\r\n   70 IF (J-I .GE. 1) GO TO 30\r\n      IF (I .EQ. 1) GO TO 20\r\n      I = I-1\r\nC\r\n   80 I = I+1\r\n      IF (I .EQ. J) GO TO 60\r\n      T = X(I+1)\r\n      IF (X(I) .LE. T) GO TO 80\r\n      K = I\r\nC\r\n   90 X(K+1) = X(K)\r\n      K = K-1\r\n      IF (T .LT. X(K)) GO TO 90\r\n      X(K+1) = T\r\n      GO TO 80\r\nC\r\nC     Sort X and carry Y along\r\nC\r\n  100 M = 1\r\n      I = 1\r\n      J = NN\r\n      R = 0.375E0\r\nC\r\n  110 IF (I .EQ. J) GO TO 150\r\n      IF (R .LE. 0.5898437E0) THEN\r\n         R = R+3.90625E-2\r\n      ELSE\r\n         R = R-0.21875E0\r\n      ENDIF\r\nC\r\n  120 K = I\r\nC\r\nC     Select a central element of the array and save it in location T\r\nC\r\n      IJ = I + INT((J-I)*R)\r\n      T = X(IJ)\r\n      TY = Y(IJ)\r\nC\r\nC     If first element of array is greater than T, interchange with T\r\nC\r\n      IF (X(I) .GT. T) THEN\r\n         X(IJ) = X(I)\r\n         X(I) = T\r\n         T = X(IJ)\r\n         Y(IJ) = Y(I)\r\n         Y(I) = TY\r\n         TY = Y(IJ)\r\n      ENDIF\r\n      L = J\r\nC\r\nC     If last element of array is less than T, interchange with T\r\nC\r\n      IF (X(J) .LT. T) THEN\r\n         X(IJ) = X(J)\r\n         X(J) = T\r\n         T = X(IJ)\r\n         Y(IJ) = Y(J)\r\n         Y(J) = TY\r\n         TY = Y(IJ)\r\nC\r\nC        If first element of array is greater than T, interchange with T\r\nC\r\n         IF (X(I) .GT. T) THEN\r\n            X(IJ) = X(I)\r\n            X(I) = T\r\n            T = X(IJ)\r\n            Y(IJ) = Y(I)\r\n            Y(I) = TY\r\n            TY = Y(IJ)\r\n         ENDIF\r\n      ENDIF\r\nC\r\nC     Find an element in the second half of the array which is smaller\r\nC     than T\r\nC\r\n  130 L = L-1\r\n      IF (X(L) .GT. T) GO TO 130\r\nC\r\nC     Find an element in the first half of the array which is greater\r\nC     than T\r\nC\r\n  140 K = K+1\r\n      IF (X(K) .LT. T) GO TO 140\r\nC\r\nC     Interchange these elements\r\nC\r\n      IF (K .LE. L) THEN\r\n         TT = X(L)\r\n         X(L) = X(K)\r\n         X(K) = TT\r\n         TTY = Y(L)\r\n         Y(L) = Y(K)\r\n         Y(K) = TTY\r\n         GO TO 130\r\n      ENDIF\r\nC\r\nC     Save upper and lower subscripts of the array yet to be sorted\r\nC\r\n      IF (L-I .GT. J-K) THEN\r\n         IL(M) = I\r\n         IU(M) = L\r\n         I = K\r\n         M = M+1\r\n      ELSE\r\n         IL(M) = K\r\n         IU(M) = J\r\n         J = L\r\n         M = M+1\r\n      ENDIF\r\n      GO TO 160\r\nC\r\nC     Begin again on another portion of the unsorted array\r\nC\r\n  150 M = M-1\r\n      IF (M .EQ. 0) GO TO 190\r\n      I = IL(M)\r\n      J = IU(M)\r\nC\r\n  160 IF (J-I .GE. 1) GO TO 120\r\n      IF (I .EQ. 1) GO TO 110\r\n      I = I-1\r\nC\r\n  170 I = I+1\r\n      IF (I .EQ. J) GO TO 150\r\n      T = X(I+1)\r\n      TY = Y(I+1)\r\n      IF (X(I) .LE. T) GO TO 170\r\n      K = I\r\nC\r\n  180 X(K+1) = X(K)\r\n      Y(K+1) = Y(K)\r\n      K = K-1\r\n      IF (T .LT. X(K)) GO TO 180\r\n      X(K+1) = T\r\n      Y(K+1) = TY\r\n      GO TO 170\r\nC\r\nC     Clean up\r\nC\r\n  190 IF (KFLAG .LE. -1) THEN\r\n         DO 200 I=1,NN\r\n            X(I) = -X(I)\r\n  200    CONTINUE\r\n      ENDIF\r\n      RETURN\r\n      END<\/pre>\n","protected":false},"excerpt":{"rendered":"<p>SUBROUTINE SSORT (X, Y, N, KFLAG) C***BEGIN PROLOGUE SSORT C***PURPOSE Sort an array and optionally make the same interchanges in C an auxiliary array. The array may be sorted in increasing C or decreasing order. A slightly modified QUICKSORT C algorithm is used. C***LIBRARY SLATEC C***CATEGORY N6A2B C***TYPE SINGLE PRECISION (SSORT-S, DSORT-D, ISORT-I) C***KEYWORDS SINGLETON [&hellip;]<\/p>\n","protected":false},"author":22,"featured_media":0,"parent":0,"menu_order":0,"comment_status":"closed","ping_status":"closed","template":"","meta":{"_exactmetrics_skip_tracking":false,"_exactmetrics_sitenote_active":false,"_exactmetrics_sitenote_note":"","_exactmetrics_sitenote_category":0,"footnotes":""},"categories":[],"tags":[],"class_list":["post-227","page","type-page","status-publish","hentry"],"_links":{"self":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/227","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages"}],"about":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/types\/page"}],"author":[{"embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/users\/22"}],"replies":[{"embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/comments?post=227"}],"version-history":[{"count":1,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/227\/revisions"}],"predecessor-version":[{"id":228,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/pages\/227\/revisions\/228"}],"wp:attachment":[{"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/media?parent=227"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/categories?post=227"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.professores.uff.br\/diomarcesarlobao\/wp-json\/wp\/v2\/tags?post=227"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}