June 2018 Update

Task/Sorting-algorithms-Insertion-sort/Fortran/sorting-algorithms-insertion-sort-1.f

@@ -1,15 +1,16 @@
-PURE SUBROUTINE Insertion_Sort(a)
-  REAL, INTENT(in out), DIMENSION(:) :: a
-  REAL :: temp
-  INTEGER :: i, j
+subroutine sort(n, a)
+    implicit none
+    integer :: n, i, j
+    real :: a(n), x
 
-  DO i = 2, SIZE(a)
-     j = i - 1
-     temp = a(i)
-     DO WHILE (j>=1 .AND. a(j)>temp)
-        a(j+1) = a(j)
-        j = j - 1
-     END DO
-     a(j+1) = temp
-  END DO
-END SUBROUTINE Insertion_Sort
+    do i = 2, n
+        x = a(i)
+        j = i - 1
+        do while (j >= 1)
+            if (a(j) <= x) exit
+            a(j + 1) = a(j)
+            j = j - 1
+        end do
+        a(j + 1) = x
+    end do
+end subroutine

Task/Sorting-algorithms-Insertion-sort/Fortran/sorting-algorithms-insertion-sort-2.f

@@ -1,7 +1,16 @@
-DO i = 2, SIZE(a)
-   j = i - 1
-   DO WHILE (j>=1 .AND. a(j) > a(i))
-      j = j - 1
-   END DO
-   a(j+1:i) = cshift(a(j+1:i),-1)
-END DO
+      SUBROUTINE SORT(N,A)
+      IMPLICIT NONE
+      INTEGER N,I,J
+      DOUBLE PRECISION A(N),X
+      DO 30 I = 2,N
+        X = A(I)
+        J = I
+   10   J = J - 1
+Can't   IF (J.EQ.0 .OR. A(J).LE.X) GO TO 20 in case both sides are ALWAYS evaluated.
+        IF (J.EQ.0) GO TO 20
+        IF (A(J).LE.X) GO TO 20
+        A(J + 1) = A(J)
+        GO TO 10
+   20   A(J + 1) = X
+   30 CONTINUE
+      END