Changeset 3026 for branches/dev_2802_OBStools/NEMOGCM/TOOLS/OBSTOOLS/src

Timestamp:

2011-10-28T18:10:29+02:00 (13 years ago)

Author:

djlea

Message:

Remove unneeded sec_to_dt from dataplot. Also add obstools build instructions to documentation.

File:

• branches/dev_2802_OBStools/NEMOGCM/TOOLS/OBSTOOLS/src/index_sort.F90 (modified) (1 diff)

branches/dev_2802_OBStools/NEMOGCM/TOOLS/OBSTOOLS/src/index_sort.F90

@@ -279 +279 @@
    END SUBROUTINE index_sort_int
 
+   SUBROUTINE  index_sort_string(cdval, kindx, kvals)
+      USE toolspar_kind
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE index_sort  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for an
+      !!              integer array
+      !!
+      !! ** Method  : Heapsort
+      !!
+      !! ** Action  : 
+      !!
+      !! References : http://en.wikipedia.org/wiki/Heapsort
+      !!
+      !! History :
+      !!        !  06-05  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=*),DIMENSION(*),INTENT(IN) :: &
+         & cdval                            ! Array to be sorted
+      INTEGER,DIMENSION(*),INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+      INTEGER, INTENT(IN) :: &
+         & kvals                           ! Number of values
+
+      !! * Local variables
+      INTEGER :: ji, jj, jt, jn, jparent, jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+
+      IF (kvals > 1 ) THEN
+
+         ji = kvals/2 + 1
+         jn = kvals
+
+         main_loop : DO
+
+            IF ( ji > 1 ) THEN
+               ji = ji-1
+               jt = kindx(ji)
+            ELSE
+               jt = kindx(jn)
+               kindx(jn) = kindx(1)
+               jn = jn-1
+               IF ( jn == 1 ) THEN
+                  kindx(1) = jt
+                  EXIT main_loop
+               ENDIF
+            ENDIF
+
+            jparent = ji
+            jchild =  2*ji
+
+            inner_loop : DO
+               IF ( jchild > jn ) EXIT inner_loop
+               IF ( jchild < jn ) THEN
+                  IF ( cdval(kindx(jchild)) <  cdval(kindx(jchild+1)) ) THEN
+                     jchild = jchild+1
+                  ENDIF
+               ENDIF
+               IF  ( cdval(jt) < cdval(kindx(jchild))) THEN
+                  kindx(jparent) = kindx(jchild)
+                  jparent = jchild
+                  jchild = jchild*2
+               ELSE 
+                  jchild = jn + 1 
+               ENDIF
+            ENDDO inner_loop
+
+            kindx(jparent) = jt
+
+         END DO  main_loop
+
+      ENDIF
+
+   END SUBROUTINE index_sort_string
+
 END MODULE index_sort