diff --git a/ChangeLog b/ChangeLog index e7be9648..1180f7cd 100644 --- 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 index b6fcf777..c94d55df 100644 --- 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 index b7200ec8..c97b366f 100644 --- a/libglimmer-solve/SLAP/dlapqc.f +++ b/libglimmer-solve/SLAP/dlapqc.f @@ -574,7 +574,7 @@ 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 @@ -582,7 +582,7 @@ SUBROUTINE DRMGEN( NELTMX, FACTOR, IERR, N, NELT, ISYM, 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 index 78e8049a..c9062eb4 100644 --- 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