From 75e347dce28910adb2c8df8f782ae3ce1fb88463 Mon Sep 17 00:00:00 2001
From: Peter Minchin <pminchi@siue.edu>
Date: Mon, 11 Mar 2024 19:18:57 +0200
Subject: [PATCH] remove dynamic allocation: fixes issue #623

Vegan could not be built for webR/wasm because their Fortran
compiler (under development) did not handle dynamic allocation.

This needed some hand-editing as the fix was not based on the
latest github version and contained removed subroutines.
---
 src/monoMDS.f | 32 +++++++++++++++++++++-----------
 1 file changed, 21 insertions(+), 11 deletions(-)

diff --git a/src/monoMDS.f b/src/monoMDS.f
index 95f955ae8..4841321a4 100644
--- a/src/monoMDS.f
+++ b/src/monoMDS.f
@@ -14,6 +14,11 @@ SUBROUTINE monoMDS (NOBJ, NFIX, NDIM, NDIS, NGRP,
 C                        dissimilarities are correctly handled in
 C                        creating the initial partition for monotone 
 C                        regression with primary tie treatment.
+C 1.03 April 11, 2023 - changed calculation of M in ASORT4 from
+C                       exponentiation to use of ISHIFT to avoid a
+C                       problem with some optimizing compilers
+C 1.04 March 8, 2024  - removed the use of ALLOCATABLE arrays by making
+C                       IWORK, GRAD, and GRLAST permananet local arrays
 C
 C Written by Dr. Peter R. Minchin
 C            Department of Biological Sciences
@@ -137,18 +142,19 @@ SUBROUTINE monoMDS (NOBJ, NFIX, NDIM, NDIS, NGRP,
       INTEGER, INTENT(OUT) :: ITERS, ICAUSE
       DOUBLE PRECISION, INTENT(OUT) :: X(NOBJ,NDIM), DIST(NDIS), 
      .  DHAT(NDIS), STRESS, STRS(NGRP)
-C---ALLOCATABLE TEMPORARY ARRAYS
-      INTEGER, ALLOCATABLE :: IWORK(:)
-      DOUBLE PRECISION, ALLOCATABLE :: GRAD(:,:), GRLAST(:,:)
+C-Removed the use of allocatable arrays (v 1.04)
+C---TEMPORARY ARRAYS
+      INTEGER :: IWORK(NDIS)
+      DOUBLE PRECISION :: GRAD(NOBJ,NDIM), GRLAST(NOBJ,NDIM)
 C
       DOUBLE PRECISION :: STRLST, SQRTN, SRATF1, SRATF2, FNGRP,
      .  STRINC, COSAV, ACOSAV, SRATAV, STEP, FNDIM, SFGR, SRATIO,
      .  SFACT, TFACT, DMEAN, CAGRGL, SFGLST, STPNEW, SSFACB, SSFACT,
      .  PARAM(2)
-C
+C-Removed the use of allocatable arrays (v 1.04)
 C ALLOCATE THE TEMPORARY ARRAYS NEEDED
-C
-      ALLOCATE (IWORK(NDIS), GRAD(NOBJ,NDIM), GRLAST(NOBJ,NDIM))
+C 
+C      ALLOCATE (IWORK(NDIS), GRAD(NOBJ,NDIM), GRLAST(NOBJ,NDIM))
 C
 C INITIALIZE SOME PARAMETERS
 C
@@ -354,9 +360,10 @@ SUBROUTINE monoMDS (NOBJ, NFIX, NDIM, NDIS, NGRP,
 C
 C=======================================================================
 C
+C-Removed the use of allocatable arrays (v 1.04)
 C DEALLOCATE THE TEMPORARY ARRAYS AND RETURN
 C
-      DEALLOCATE (IWORK, GRAD, GRLAST)
+C      DEALLOCATE (IWORK, GRAD, GRLAST)
       RETURN
       END SUBROUTINE monoMDS
 
@@ -382,7 +389,10 @@ SUBROUTINE ASORT4 (X,N,I1,I2)
       IF (N.LT.2) RETURN
       FN=REAL(N)
       NLOOPS=MAX(NINT(LOG(FN)/LOG(2.)),1)
-      M=ISHFT(1,NLOOPS-1) ! i.e., 2^(N_LOOPS-1) using bit shifts
+C REPLACED EXPONENTIATION BY ISHFT TO AVOID A PROBLEM WITH SOME
+C   OPTIMIZING COMPILERS (v 1.03)
+C      M=2**(NLOOPS-1)
+      M=ISHFT(1, NLOOPS-1)
       DO II=1,NLOOPS
         FM=M
         DO I=1,MAX(1,N-M)
@@ -600,9 +610,9 @@ SUBROUTINE CLCSTP (STEP,IT,SFGR,STRESS,COSAV,ACOSAV,SRATIO,
 C
       ELSE
         FACTR1=4.0**COSAV
-        FACTR2=1.6/( (1.0+(MIN(1D0,SRATAV))**5) *
+        FACTR2=1.6/( (1.0+(MIN(1.0,SRATAV))**5) *
      .    (1.0+ACOSAV-ABS(COSAV)) )
-        FACTR3=SQRT(MIN(1D0,SRATIO))
+        FACTR3=SQRT(MIN(1.0,SRATIO))
         STEP=STEP*FACTR1*FACTR2*FACTR3
       ENDIF
       RETURN
@@ -761,7 +771,7 @@ SUBROUTINE MAMAS (A,MAXL,L,M,S)
       ENDDO
       RETURN
       END SUBROUTINE MAMAS
- 
+
       SUBROUTINE MONREG (DISS,DIST,DHAT,IIDX,JIDX,IWORK,N,ITIES)
 C
 C PERFORMS KRUSKAL'S MONOTONE REGRESSION OF DIST ON DISS, PLACING THE