Merge pull request #48 from ESCOMP/ktc/fixin_slap

Ktc/fixin slap
ESCOMP · Oct 18, 2023 · 85b34fc · 85b34fc
2 parents 62dc787 + 8ecd0a5
commit 85b34fc
Show file tree

Hide file tree

Showing 4 changed files with 29 additions and 24 deletions.
diff --git a/ChangeLog b/ChangeLog
@@ -1,6 +1,11 @@
 CISM Changelog
 
-Changes in CISM tag cism_main_2.01.002
+Changes in CISM tag cism_main_2.01.011
+======================================
+
+Changes to update old SLAP code and make it slightly nicer for modern compilers. Plus add in one missing use statement and update the dome python scripts to python3.
+
+Changes in CISM tag cism_main_2.01.003
 ======================================
 ESCOMP/cism/main 792e43f and 410b384
 

diff --git a/builds/cheyenne-intel/cheyenne-intel-cmake.sh b/builds/cheyenne-intel/cheyenne-intel-cmake.sh
@@ -16,7 +16,7 @@ else
 fi
 
 echo CISM: "${cism_top}"
-
+source /etc/profile.d/modules.sh
 
 module purge
 module load ncarenv/1.2

diff --git a/libglimmer-solve/SLAP/dlapqc.f b/libglimmer-solve/SLAP/dlapqc.f
@@ -574,15 +574,15 @@ SUBROUTINE DRMGEN( NELTMX, FACTOR, IERR, N, NELT, ISYM,
       DOUBLE PRECISION FACTOR, A(NELTMX)
       DOUBLE PRECISION F(N), SOLN(N), DSUM(N)
       INTEGER DUMMY
-      REAL, EXTERNAL :: RAND
+      REAL, EXTERNAL :: SLRAND
 C
 C         Start by setting the random number generator seed.
 C         This is done for reproducablility in debuggin.  Remove
 C         the seed seeting call for production testing.
 C
 C***FIRST EXECUTABLE STATEMENT  DRMGEN
       DUMMY = 16381
-      ISEED = RAND( DUMMY )
+      ISEED = SLRAND( DUMMY )
       IERR = 0
       DO 10 I = 1, N
          IDIAG(I) = 0
@@ -599,7 +599,7 @@ SUBROUTINE DRMGEN( NELTMX, FACTOR, IERR, N, NELT, ISYM,
 C
 C         To keep things sparse divide by two, three or four or ...
 C
-         INUM = (IFIX( RAND(DUMMY)*NL ) + 1)/3
+         INUM = (IFIX( SLRAND(DUMMY)*NL ) + 1)/3
          CALL DMPL( NL, INUM, ITMP )
 C
 C         Set up this column (and row, if non-sym structure).
@@ -616,7 +616,7 @@ SUBROUTINE DRMGEN( NELTMX, FACTOR, IERR, N, NELT, ISYM,
             IF( IA(NELT).EQ.ICOL ) THEN
                IDIAG(ICOL) = NELT
             ELSE
-               A(NELT) = -RAND(DUMMY)
+               A(NELT) = -SLRAND(DUMMY)
                DSUM(ICOL) = DSUM(ICOL) + A(NELT)
                IF( ISYM.EQ.0 ) THEN
 C
@@ -666,7 +666,7 @@ SUBROUTINE DRMGEN( NELTMX, FACTOR, IERR, N, NELT, ISYM,
 CVD$ NOVECTOR
 CVD$ NOCONCUR
       DO 50 I = 1, N
-         SOLN(I) = RAND(DUMMY)
+         SOLN(I) = SLRAND(DUMMY)
          F(I) = 0.0D0
  50   CONTINUE
 C
@@ -702,7 +702,7 @@ SUBROUTINE DMPL( N, M, INDX )
 C***ROUTINES CALLED  RAND
 C***END PROLOGUE
       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
-      REAL, EXTERNAL :: RAND
+      REAL, EXTERNAL :: SLRAND
       INTEGER DUMMY
       INTEGER N, M, INDX(M)
 C
@@ -712,10 +712,10 @@ SUBROUTINE DMPL( N, M, INDX )
       IF( N*M.LT.0 .OR. M.GT.N ) RETURN
 C
 C..       Set the indeicies.      
-      INDX(1) = IFIX( RAND(DUMMY)*N ) + 1
+      INDX(1) = IFIX( SLRAND(DUMMY)*N ) + 1
 CVD$ NOCONCUR
       DO 30 I = 2, M
- 10      ID = IFIX( RAND(DUMMY)*N ) + 1
+ 10      ID = IFIX( SLRAND(DUMMY)*N ) + 1
 C
 C..       Check to see if id has already been chosen.
 CVD$ NOVECTOR

diff --git a/libglimmer-solve/SLAP/xersla.f b/libglimmer-solve/SLAP/xersla.f
@@ -29,7 +29,7 @@ subroutine xerabt(messg,nmessg)
 c                 1982.
 c***routines called  (none)
 c***end prologue  xerabt
-      dimension messg(nmessg)
+      character*(*) messg
 c***first executable statement  xerabt
       stop 1
       end
@@ -300,7 +300,7 @@ subroutine xerrwv(messg,nmessg,nerr,level,ni,i1,i2,nr,r1,r2)
             if (lkntrl.le.0) go to 40
 c              error number
                write (iunit,30) lerr
-   30          format (15h error number =,i10)
+   30          format ('15h error number =',i10)
    40       continue
    50    continue
 c        trace-back
@@ -380,8 +380,8 @@ subroutine xersav(messg,nmessg,nerr,level,icount)
             if (iunit.eq.0) iunit = i1mach(4)
 c           print table header
             write (iunit,10)
-   10       format (32h0          error message summary/
-     1      51h message start             nerr     level     count)
+   10       format ('32h0          error message summary'/
+     1      '51h message start            , nerr,   level,   count')
 c           print body of table
             do 20 i=1,10
                if (kount(i).eq.0) go to 30
@@ -391,7 +391,7 @@ subroutine xersav(messg,nmessg,nerr,level,icount)
    30       continue
 c           print number of other errors
             if (kountx.ne.0) write (iunit,40) kountx
-   40       format (41h0other errors not individually tabulated=,i10)
+   40       format ('41h0other errors not individually tabulated=',i10)
             write (iunit,50)
    50       format (1x)
    60    continue
@@ -811,8 +811,8 @@ subroutine xsetun(iunit)
       junk = j4save(5,1,.true.)
       return
       end
-      FUNCTION RAND(R)
-C***BEGIN PROLOGUE  RAND
+      FUNCTION SLRAND(R)
+C***BEGIN PROLOGUE  SLRAND
 C***DATE WRITTEN   770401   (YYMMDD)
 C***REVISION DATE  861211   (YYMMDD)
 C***CATEGORY NO.  L6A21
@@ -823,7 +823,7 @@ FUNCTION RAND(R)
 C***DESCRIPTION
 C
 C      This pseudo-random number generator is portable among a wide
-C variety of computers.  RAND(R) undoubtedly is not as good as many
+C variety of computers.  SLRAND(R) undoubtedly is not as good as many
 C readily available installation dependent versions, and so this
 C routine is not recommended for widespread usage.  Its redeeming
 C feature is that the exact same random numbers (to within final round-
@@ -887,18 +887,18 @@ FUNCTION RAND(R)
 C          possible use in a restart procedure.
 C        If R .GT. 0., the sequence of random numbers will start with
 C          the seed R mod 1.  This seed is also returned as the value of
-C          RAND provided the arithmetic is done exactly.
+C          SLRAND provided the arithmetic is done exactly.
 C
 C             Output Value --
-C RAND   a pseudo-random number between 0. and 1.
+C SLRAND   a pseudo-random number between 0. and 1.
 C***REFERENCES  (NONE)
 C***ROUTINES CALLED  (NONE)
-C***END PROLOGUE  RAND
+C***END PROLOGUE  SLRAND
       SAVE IA1, IA0, IA1MA0, IC, IX1, IX0
       DATA IA1, IA0, IA1MA0 /1536, 1029, 507/
       DATA IC /1731/
       DATA IX1, IX0 /0, 0/
-C***FIRST EXECUTABLE STATEMENT  RAND
+C***FIRST EXECUTABLE STATEMENT  SLRAND
       IF (R.LT.0.) GO TO 10
       IF (R.GT.0.) GO TO 20
 C
@@ -912,8 +912,8 @@ FUNCTION RAND(R)
       IY1 = IY1 + (IY0-IX0)/2048
       IX1 = MOD (IY1, 2048)
 C
- 10   RAND = IX1*2048 + IX0
-      RAND = RAND / 4194304.
+ 10   SLRAND = IX1*2048 + IX0
+      SLRAND = SLRAND / 4194304.
       RETURN
 C
  20   IX1 = AMOD(R,1.)*4194304. + 0.5