diff --git a/src/appl/dchdc.f b/src/appl/dchdc.f index dcd5ab3b2f..93c37ef181 100644 --- a/src/appl/dchdc.f +++ b/src/appl/dchdc.f @@ -78,7 +78,7 @@ subroutine dchdc(a,lda,p,work,jpvt,job,info) c c c blas daxpy,dswap -c fortran dsqrt +c fortran sqrt c c internal variables c @@ -205,7 +205,7 @@ subroutine dchdc(a,lda,p,work,jpvt,job,info) c c reduction step. pivoting is contained across the rows. c - work(k) = dsqrt(a(k,k)) + work(k) = sqrt(a(k,k)) a(k,k) = work(k) if (p .lt. kp1) go to 260 do 250 j = kp1, p diff --git a/src/appl/dpbfa.f b/src/appl/dpbfa.f index 3c22a86094..b19a327e1c 100644 --- a/src/appl/dpbfa.f +++ b/src/appl/dpbfa.f @@ -45,7 +45,7 @@ subroutine dpbfa(abd,lda,n,m,info) c c m = (band width above diagonal) c do 20 j = 1, n -c i1 = max0(1, j-m) +c i1 = max(1, j-m) c do 10 i = i1, j c k = i-j+m+1 c abd(k,j) = a(i,j) @@ -58,7 +58,7 @@ subroutine dpbfa(abd,lda,n,m,info) c subroutines and functions c c blas ddot -c fortran max0,sqrt +c fortran max,sqrt c c internal variables c @@ -72,8 +72,8 @@ subroutine dpbfa(abd,lda,n,m,info) info = j s = 0.0d0 ik = m + 1 - jk = max0(j-m,1) - mu = max0(m+2-j,1) + jk = max(j-m,1) + mu = max(m+2-j,1) if (m .lt. mu) go to 20 do 10 k = mu, m diff --git a/src/appl/dpbsl.f b/src/appl/dpbsl.f index d910deef88..7728e68bc0 100644 --- a/src/appl/dpbsl.f +++ b/src/appl/dpbsl.f @@ -50,7 +50,7 @@ subroutine dpbsl(abd,lda,n,m,b) c subroutines and functions c c blas daxpy,ddot -c fortran min0 +c fortran min c c internal variables c @@ -60,7 +60,7 @@ subroutine dpbsl(abd,lda,n,m,b) c solve trans(r)*y = b c do 10 k = 1, n - lm = min0(k-1,m) + lm = min(k-1,m) la = m + 1 - lm lb = k - lm t = ddot(lm,abd(la,k),1,b(lb),1) @@ -71,7 +71,7 @@ subroutine dpbsl(abd,lda,n,m,b) c do 20 kb = 1, n k = n + 1 - kb - lm = min0(k-1,m) + lm = min(k-1,m) la = m + 1 - lm lb = k - lm b(k) = b(k)/abd(m+1,k) diff --git a/src/appl/dpoco.f b/src/appl/dpoco.f index 7cf7902593..7e8e4832f0 100644 --- a/src/appl/dpoco.f +++ b/src/appl/dpoco.f @@ -58,7 +58,7 @@ c c linpack dpofa c blas daxpy,ddot,dscal,dasum -c fortran dabs,dmax1,dreal,dsign +c fortran abs,max,sign c subroutine dpoco(a,lda,n,rcond,z,info) integer lda,n,info @@ -79,13 +79,13 @@ subroutine dpoco(a,lda,n,rcond,z,info) jm1 = j - 1 if (jm1 .lt. 1) go to 20 do 10 i = 1, jm1 - z(i) = z(i) + dabs(a(i,j)) + z(i) = z(i) + abs(a(i,j)) 10 continue 20 continue 30 continue anorm = 0.0d0 do 40 j = 1, n - anorm = dmax1(anorm,z(j)) + anorm = max(anorm,z(j)) 40 continue c c factor @@ -106,24 +106,24 @@ subroutine dpoco(a,lda,n,rcond,z,info) z(j) = 0.0d0 50 continue do 110 k = 1, n - if (z(k) .ne. 0.0d0) ek = dsign(ek,-z(k)) - if (dabs(ek-z(k)) .le. a(k,k)) go to 60 - s = a(k,k)/dabs(ek-z(k)) + if (z(k) .ne. 0.0d0) ek = sign(ek,-z(k)) + if (abs(ek-z(k)) .le. a(k,k)) go to 60 + s = a(k,k)/abs(ek-z(k)) call dscal(n,s,z,1) ek = s*ek 60 continue wk = ek - z(k) wkm = -ek - z(k) - s = dabs(wk) - sm = dabs(wkm) + s = abs(wk) + sm = abs(wkm) wk = wk/a(k,k) wkm = wkm/a(k,k) kp1 = k + 1 if (kp1 .gt. n) go to 100 do 70 j = kp1, n - sm = sm + dabs(z(j)+wkm*a(k,j)) + sm = sm + abs(z(j)+wkm*a(k,j)) z(j) = z(j) + wk*a(k,j) - s = s + dabs(z(j)) + s = s + abs(z(j)) 70 continue if (s .ge. sm) go to 90 t = wkm - wk @@ -142,8 +142,8 @@ subroutine dpoco(a,lda,n,rcond,z,info) c do 130 kb = 1, n k = n + 1 - kb - if (dabs(z(k)) .le. a(k,k)) go to 120 - s = a(k,k)/dabs(z(k)) + if (abs(z(k)) .le. a(k,k)) go to 120 + s = a(k,k)/abs(z(k)) call dscal(n,s,z,1) 120 continue z(k) = z(k)/a(k,k) @@ -159,8 +159,8 @@ subroutine dpoco(a,lda,n,rcond,z,info) c do 150 k = 1, n z(k) = z(k) - ddot(k-1,a(1,k),1,z(1),1) - if (dabs(z(k)) .le. a(k,k)) go to 140 - s = a(k,k)/dabs(z(k)) + if (abs(z(k)) .le. a(k,k)) go to 140 + s = a(k,k)/abs(z(k)) call dscal(n,s,z,1) ynorm = s*ynorm 140 continue @@ -174,8 +174,8 @@ subroutine dpoco(a,lda,n,rcond,z,info) c do 170 kb = 1, n k = n + 1 - kb - if (dabs(z(k)) .le. a(k,k)) go to 160 - s = a(k,k)/dabs(z(k)) + if (abs(z(k)) .le. a(k,k)) go to 160 + s = a(k,k)/abs(z(k)) call dscal(n,s,z,1) ynorm = s*ynorm 160 continue diff --git a/src/appl/dqrdc.f b/src/appl/dqrdc.f index f11aa55fa0..eef24a03ed 100644 --- a/src/appl/dqrdc.f +++ b/src/appl/dqrdc.f @@ -76,7 +76,7 @@ c dqrdc uses the following functions and subprograms. c c blas daxpy,ddot,dscal,dswap,dnrm2 -c fortran dabs,dmax1,min0,dsqrt +c fortran abs,max,min,sqrt c subroutine dqrdc(x,ldx,n,p,qraux,jpvt,work,job) integer ldx,n,p,job @@ -137,7 +137,7 @@ subroutine dqrdc(x,ldx,n,p,qraux,jpvt,work,job) c c perform the householder reduction of x. c - lup = min0(n,p) + lup = min(n,p) do 200 l = 1, lup if (l .lt. pl .or. l .ge. pu) go to 120 c @@ -182,12 +182,12 @@ subroutine dqrdc(x,ldx,n,p,qraux,jpvt,work,job) call daxpy(n-l+1,t,x(l,l),1,x(l,j),1) if (j .lt. pl .or. j .gt. pu) go to 150 if (qraux(j) .eq. 0.0d0) go to 150 - tt = 1.0d0 - (dabs(x(l,j))/qraux(j))**2 - tt = dmax1(tt,0.0d0) + tt = 1.0d0 - (aabs(x(l,j))/qraux(j))**2 + tt = max(tt,0.0d0) t = tt tt = 1.0d0 + 0.05d0*tt*(qraux(j)/work(j))**2 if (tt .eq. 1.0d0) go to 130 - qraux(j) = qraux(j)*dsqrt(t) + qraux(j) = qraux(j)*sqrt(t) go to 140 130 continue qraux(j) = dnrm2(n-l,x(l+1,j),1) diff --git a/src/appl/dqrdc2.f b/src/appl/dqrdc2.f index 523252ee5b..12ac3fa591 100644 --- a/src/appl/dqrdc2.f +++ b/src/appl/dqrdc2.f @@ -81,7 +81,7 @@ c dqrdc2 uses the following functions and subprograms. c c blas daxpy,ddot,dscal,dnrm2 -c fortran dabs,dmax1,min0,dsqrt +c fortran abs,max,min,sqrt c subroutine dqrdc2(x,ldx,n,p,tol,k,qraux,jpvt,work) integer ldx,n,p diff --git a/src/appl/dqrsl.f b/src/appl/dqrsl.f index 3c7ac53a6f..2964e8c2ec 100644 --- a/src/appl/dqrsl.f +++ b/src/appl/dqrsl.f @@ -135,7 +135,7 @@ c dqrsl uses the following functions and subprograms. c c BLAS daxpy,dcopy,ddot -c Fortran dabs,min0,mod +c Fortran min,mod c subroutine dqrsl(x,ldx,n,k,qraux,y,qy,qty,b,rsd,xb,job,info) integer ldx,n,k,job,info @@ -160,7 +160,7 @@ subroutine dqrsl(x,ldx,n,k,qraux,y,qy,qty,b,rsd,xb,job,info) cb = mod(job,1000)/100 .ne. 0 cr = mod(job,100)/10 .ne. 0 cxb = mod(job,10) .ne. 0 - ju = min0(k,n-1) + ju = min(k,n-1) c c special action when n=1. c diff --git a/src/appl/dsvdc.f b/src/appl/dsvdc.f index 8e24cc2643..77c74f6847 100644 --- a/src/appl/dsvdc.f +++ b/src/appl/dsvdc.f @@ -100,7 +100,7 @@ c c external drot c blas daxpy,ddot,dscal,dswap,dnrm2,drotg -c fortran dabs,dmax1,max0,min0,mod,dsqrt +c fortran abs,max,min,mod,sqrt c subroutine dsvdc(x,ldx,n,p,s,e,u,ldu,v,ldv,work,job,info) integer ldx,n,p,ldu,ldv,job,info @@ -132,7 +132,7 @@ subroutine dsvdc(x,ldx,n,p,s,e,u,ldu,v,ldv,work,job,info) wantv = .false. jobu = mod(job,100)/10 ncu = n - if (jobu .gt. 1) ncu = min0(n,p) + if (jobu .gt. 1) ncu = min(n,p) if (jobu .ne. 0) wantu = .true. if (mod(job,10) .ne. 0) wantv = .true. c @@ -140,9 +140,9 @@ subroutine dsvdc(x,ldx,n,p,s,e,u,ldu,v,ldv,work,job,info) c in s and the super-diagonal elements in e. c info = 0 - nct = min0(n-1,p) - nrt = max0(0,min0(p-2,n)) - lu = max0(nct,nrt) + nct = min(n-1,p) + nrt = max(0,min(p-2,n)) + lu = max(nct,nrt) if (lu .lt. 1) go to 170 do 160 l = 1, lu lp1 = l + 1 @@ -226,7 +226,7 @@ subroutine dsvdc(x,ldx,n,p,s,e,u,ldu,v,ldv,work,job,info) c c set up the final bidiagonal matrix or order m. c - m = min0(p,n+1) + m = min(p,n+1) nctp1 = nct + 1 nrtp1 = nrt + 1 if (nct .lt. p) s(nctp1) = x(nctp1,nctp1) @@ -329,9 +329,9 @@ subroutine dsvdc(x,ldx,n,p,s,e,u,ldu,v,ldv,work,job,info) l = m - ll c ...exit if (l .eq. 0) go to 400 - test = dabs(s(l)) + dabs(s(l+1)) - ztest = test + dabs(e(l)) - acc = dabs(test - ztest)/(1.0d-100 + test) + test = abs(s(l)) + abs(s(l+1)) + ztest = test + abs(e(l)) + acc = abs(test - ztest)/(1.0d-100 + test) if (acc .gt. 1.d-15) goto 380 c if (ztest .ne. test) go to 380 e(l) = 0.0d0 @@ -351,11 +351,11 @@ subroutine dsvdc(x,ldx,n,p,s,e,u,ldu,v,ldv,work,job,info) c ...exit if (ls .eq. l) go to 440 test = 0.0d0 - if (ls .ne. m) test = test + dabs(e(ls)) - if (ls .ne. l + 1) test = test + dabs(e(ls-1)) - ztest = test + dabs(s(ls)) + if (ls .ne. m) test = test + abs(e(ls)) + if (ls .ne. l + 1) test = test + abs(e(ls-1)) + ztest = test + abs(s(ls)) c 1.0d-100 is to guard against a zero matrix, hence zero test - acc = dabs(test - ztest)/(1.0d-100 + test) + acc = abs(test - ztest)/(1.0d-100 + test) if (acc .gt. 1.d-15) goto 420 c if (ztest .ne. test) go to 420 s(ls) = 0.0d0 @@ -432,8 +432,8 @@ subroutine dsvdc(x,ldx,n,p,s,e,u,ldu,v,ldv,work,job,info) c c calculate the shift. c - scale = dmax1(dabs(s(m)),dabs(s(m-1)),dabs(e(m-1)), - * dabs(s(l)),dabs(e(l))) + scale = max(abs(s(m)),abs(s(m-1)),abs(e(m-1)), + * abs(s(l)),dabs(e(l))) sm = s(m)/scale smm1 = s(m-1)/scale emm1 = e(m-1)/scale @@ -443,7 +443,7 @@ subroutine dsvdc(x,ldx,n,p,s,e,u,ldu,v,ldv,work,job,info) c = (sm*emm1)**2 shift = 0.0d0 if (b .eq. 0.0d0 .and. c .eq. 0.0d0) go to 550 - shift = dsqrt(b**2+c) + shift = sqrt(b**2+c) if (b .lt. 0.0d0) shift = -shift shift = c/(b + shift) 550 continue diff --git a/src/appl/dtrco.f b/src/appl/dtrco.f index 48f9e786d3..198d34c5a1 100644 --- a/src/appl/dtrco.f +++ b/src/appl/dtrco.f @@ -50,7 +50,7 @@ subroutine dtrco(t,ldt,n,rcond,z,job) c subroutines and functions c c blas daxpy,dscal,dasum -c fortran dabs,dmax1,dsign +c fortran abs,max,sign c c internal variables c @@ -69,7 +69,7 @@ subroutine dtrco(t,ldt,n,rcond,z,job) if (lower) l = n + 1 - j i1 = 1 if (lower) i1 = j - tnorm = dmax1(tnorm,dasum(l,t(i1,j),1)) + tnorm = max(tnorm,dasum(l,t(i1,j),1)) 10 continue c c rcond = 1/(norm(t)*(estimate of norm(inverse(t)))) . @@ -88,16 +88,16 @@ subroutine dtrco(t,ldt,n,rcond,z,job) do 100 kk = 1, n k = kk if (lower) k = n + 1 - kk - if (z(k) .ne. 0.0d0) ek = dsign(ek,-z(k)) - if (dabs(ek-z(k)) .le. dabs(t(k,k))) go to 30 - s = dabs(t(k,k))/dabs(ek-z(k)) + if (z(k) .ne. 0.0d0) ek = sign(ek,-z(k)) + if (abs(ek-z(k)) .le. abs(t(k,k))) go to 30 + s = abs(t(k,k))/abs(ek-z(k)) call dscal(n,s,z,1) ek = s*ek 30 continue wk = ek - z(k) wkm = -ek - z(k) - s = dabs(wk) - sm = dabs(wkm) + s = abs(wk) + sm = abs(wkm) if (t(k,k) .eq. 0.0d0) go to 40 wk = wk/t(k,k) wkm = wkm/t(k,k) @@ -112,9 +112,9 @@ subroutine dtrco(t,ldt,n,rcond,z,job) j2 = n if (lower) j2 = k - 1 do 60 j = j1, j2 - sm = sm + dabs(z(j)+wkm*t(k,j)) + sm = sm + abs(z(j)+wkm*t(k,j)) z(j) = z(j) + wk*t(k,j) - s = s + dabs(z(j)) + s = s + abs(z(j)) 60 continue if (s .ge. sm) go to 80 w = wkm - wk @@ -136,8 +136,8 @@ subroutine dtrco(t,ldt,n,rcond,z,job) do 130 kk = 1, n k = n + 1 - kk if (lower) k = kk - if (dabs(z(k)) .le. dabs(t(k,k))) go to 110 - s = dabs(t(k,k))/dabs(z(k)) + if (abs(z(k)) .le. abs(t(k,k))) go to 110 + s = abs(t(k,k))/abs(z(k)) call dscal(n,s,z,1) ynorm = s*ynorm 110 continue