From f7172fa81daaa4324d9b200710b3f2e4ca7d455a Mon Sep 17 00:00:00 2001 From: Andreas Holm <60451789+holm10@users.noreply.github.com> Date: Tue, 14 Jan 2025 15:08:48 -0800 Subject: [PATCH 1/3] Implements fixes to OMP Pandf1 evaluation --- com/com.v | 4 +++ ppp/omp_parallel.F90 | 69 ++++++++++++++++++++++---------------------- ppp/parallel.F90 | 21 ++++++++------ ppp/ppp.v | 4 +-- svr/nksol.m | 19 ++++++++++++ 5 files changed, 71 insertions(+), 46 deletions(-) diff --git a/com/com.v b/com/com.v index a4221299..96b4f391 100755 --- a/com/com.v +++ b/com/com.v @@ -705,3 +705,7 @@ tanh_multi(i:integer,a:real,j:integer,b:real,fname:string,d:real) subroutine ***** Flags: # Common flags used by UEDGE iprint integer /1/ # Flag controlling whether to be verbose or not + +***** Svrstatus: +# Parameters indicating the solver status +comnfe integer /0/ # Number of NK iterations for time-step diff --git a/ppp/omp_parallel.F90 b/ppp/omp_parallel.F90 index fd6965a5..db5b597c 100644 --- a/ppp/omp_parallel.F90 +++ b/ppp/omp_parallel.F90 @@ -604,6 +604,7 @@ subroutine OMPPandf1Rhs(neq,time,yl,yldot) use Dim,only:ny use Selec, only:yinc,xrinc,xlinc Use Grid,only:ijactot + Use Svrstatus, only: comnfe integer yinc_bkp,xrinc_bkp,xlinc_bkp,iv,tid integer,intent(in)::neq @@ -674,30 +675,28 @@ subroutine OMPPandf1Rhs(neq,time,yl,yldot) if (CheckPandf1.gt.0) then - Time2=omp_get_wtime() - call pandf1 (-1, -1, 0.0, neq, time, ylcopy, yldotsave) - Time2=omp_get_wtime()-Time2 - OMPTimeSerialPandf1=Time2+OMPTimeSerialPandf1 + Time2=omp_get_wtime() + call pandf1 (-1, -1, 0.0, neq, time, ylcopy, yldotsave) + Time2=omp_get_wtime()-Time2 + OMPTimeSerialPandf1=Time2+OMPTimeSerialPandf1 + if (OMPPandf1Verbose.gt.0) then write(*,*) "Timing Pandf1 serial:",OMPTimeSerialPandf1,"(",Time2,")/parallel:",OMPTimeParallelPandf1,'(',Time1,')' - write(*,*) 'ijactot ',ijactot - call Compare(yldot,yldotsave,neq) - write(*,*) "serial and parallel pandf are identical" endif + call Compare(yldot,yldotsave,neq) + write(*,'(a,i4)') " Serial and parallel pandf are identical for nfe = ", comnfe + endif else call pandf1 (-1,-1, 0.0, neq, time, yl, yldot) endif end subroutine OMPPandf1Rhs -module Bins -contains -subroutine CreateBin(ieqmin,ieqmax,ichunkmin,ichunkmax,Padding,iCenterBin,iLeftBin,iRightBin,inc) - integer,intent(in):: ieqmin, ieqmax,Padding,ichunkmin,ichunkmax - integer ::N,SizeBin,i,Nchunk - integer,intent(out),allocatable:: iCenterbin(:),inc(:),iLeftBin(:),iRightBin(:) -! integer,intent(out):: iCenterbin(Nchunk),inc(Nchunk),iLeftBin(Nchunk),iRightBin(Nchunk) +subroutine CreateBin(ieqmin,ieqmax,ichunkmin,ichunkmax,ichunktot,Padding,iCenterBin,iLeftBin,iRightBin,inc) + implicit none + integer,intent(in):: ieqmin, ieqmax,Padding,ichunkmin,ichunkmax, ichunktot + integer,intent(out):: iCenterbin(ichunktot),inc(ichunktot),iLeftBin(ichunktot),iRightBin(ichunktot) + integer ::N,SizeBin,Nchunk, i N=ieqmax-ieqmin+1 Nchunk=ichunkmax-ichunkmin+1 - allocate (iCenterbin(Nchunk),inc(Nchunk),iLeftBin(Nchunk),iRightBin(Nchunk)) if (N>Nchunk) then SizeBin=int((N/Nchunk)) @@ -724,7 +723,6 @@ subroutine CreateBin(ieqmin,ieqmax,ichunkmin,ichunkmax,Padding,iCenterBin,iLeftB return end subroutine CreateBin -end module Bins subroutine MakeChunksPandf1() Use Indexes,only: igyl @@ -733,41 +731,43 @@ subroutine MakeChunksPandf1() Nivchunk,Nxchunks,Nychunks,iymaxchunk,ixmaxchunk,iyminchunk,ixminchunk use Lsode, only: neq use Dim, only:nx,ny - use Bins implicit none integer:: remakechunk,i,ii,ichunk,iv,ix,iy - integer,allocatable:: iyCenterBin(:),iyRightBin(:),iyLeftBin(:),incy(:) - integer,allocatable:: ixCenterBin(:),ixRightBin(:),ixLeftBin(:),incx(:) - - allocate (iyCenterBin(Nychunks),iyRightBin(Nychunks),iyLeftBin(Nychunks),incy(Nychunks)) - allocate (ixCenterBin(Nxchunks),ixRightBin(Nxchunks),ixLeftBin(Nxchunks),incx(Nxchunks)) + integer:: iyCenterBin(Nychunks),iyRightBin(Nychunks),iyLeftBin(Nychunks),incy(Nychunks) + integer::ixCenterBin(Nxchunks),ixRightBin(Nxchunks),ixLeftBin(Nxchunks),incx(Nxchunks) remakechunk=0 if ((Nxchunks.ne.Nxchunks_old).or.(Nychunks.ne.Nychunks_old)) then - if (Nychunks.gt.1) then if (Nychunks.eq.ny) then iyLeftBin(1)=0 iyRightBin(1)=1 iyCenterBin(1)=1 incy(1)=ypadding - call CreateBin(2,ny-1,2,Nychunks-1,ypadding,iyCenterBin,iyLeftBin,iyRightBin,incy) + call CreateBin( 2,ny-1,2,Nychunks-1, Nychunks, ypadding, & + iyCenterBin, iyLeftBin, iyRightBin,& + incy & + ) iyLeftBin(Nychunks)=ny iyRightBin(Nychunks)=ny+1 iyCenterBin(Nychunks)=ny incy(Nychunks)=ypadding - write(*,*) '----- Bins in y direction: ', Nychunks, ny+2 - do iy=1,Nychunks - write(*,*) iyCenterBin(iy),iyLeftBin(iy),iyRightBin(iy),incy(iy) - enddo + if (OMPPandf1Verbose.gt.1) then + write(*,*) '----- Bins in y direction: ', Nychunks, ny+2 + do iy=1,Nychunks + write(*,*) iyCenterBin(iy),iyLeftBin(iy),iyRightBin(iy),incy(iy) + enddo + endif else - call CreateBin(0,ny+1,1,Nychunks,ypadding,iyCenterBin,iyLeftBin,iyRightBin,incy) + call CreateBin(0,ny+1,1,Nychunks,Nychunks,ypadding,iyCenterBin,iyLeftBin,iyRightBin,incy) - write(*,*) '----- Bins in y direction: ', Nychunks, ny+2 - do iy=1,Nychunks + if (OMPPandf1Verbose.gt.1) then + write(*,*) '----- Bins in y direction: ', Nychunks, ny+2 + do iy=1,Nychunks write(*,*) iyCenterBin(iy),iyLeftBin(iy),iyRightBin(iy),incy(iy) - enddo + enddo + endif ! now we check the first and last bins to check that ypadding is 3 if iyCenterBin=2 if (iyCenterBin(1)==0) then @@ -787,7 +787,7 @@ subroutine MakeChunksPandf1() if (Nxchunks.gt.1) then - call CreateBin(0,nx+1,1,Nxchunks,xpadding,ixCenterBin,ixLeftBin,ixRightBin,incx) + call CreateBin(0,nx+1,1,Nxchunks,Nxchunks,xpadding,ixCenterBin,ixLeftBin,ixRightBin,incx) else ixCenterBin(1)=-1 ixLeftBin(1)=0 @@ -865,8 +865,7 @@ subroutine MakeChunksPandf1() enddo endif endif - - + return end subroutine MakeChunksPandf1 !subroutine PrintChunks diff --git a/ppp/parallel.F90 b/ppp/parallel.F90 index cb314859..92116810 100644 --- a/ppp/parallel.F90 +++ b/ppp/parallel.F90 @@ -32,15 +32,18 @@ subroutine InitParallel endif -! if (OMPParallelPandf1.gt.0) then -! if (OMPParallelJac==0) then -! call xerrab('Cannot run omp parallel evaluation of pandf1 without running jacobian omp evaluation.') -! endif -! call InitOMPPandf1() -! ParallelPandf1=1 -! else -! ParallelPandf1=0 -! endif + if (OMPParallelPandf1.gt.0) then + if (OMPParallelJac==0) then + write(*,*) "Parallel Pandf1 requires Parallel Jac: activating..." + OMPParallelJac=1 + call InitOMPJac + ParallelJac=1 + endif + call InitOMPPandf1() + ParallelPandf1=1 + else + ParallelPandf1=0 + endif end subroutine InitParallel diff --git a/ppp/ppp.v b/ppp/ppp.v index e1f175a6..c599b7f2 100644 --- a/ppp/ppp.v +++ b/ppp/ppp.v @@ -5,11 +5,11 @@ ppp ***** ParallelSettings: OMPParallelPandf1 integer /0/ # [0]: serial pandf1 rhs calc [1] omp parallel pandf1 rhs calc OMPParallelJac integer /0/ # [0]: serial jacobian calc [1] omp parallel jacobian calc -ParallelWarning integer /1/ # Warning for users who wish to use it +ParallelWarning integer /0/ # Warning for users who wish to use it CheckJac integer /0/ # [0/1]: Turn on on-the-fly comparison of parallel vs serial evaluation of Jacobian. # If differences between para and serial Jacobians, dump both Jacs in serialjac.dat and paralleljac.dat with routine jac_write in current working folder. See UEDGEToolBox docs for analysis tools. Nthreads integer /64/ # Number of threads to be used to calculate the Jacobian -CheckPandf1 integer /1/ # [0/1]: Turn on on-the-fly comparison of parallel vs serial evaluation of pandf1. +CheckPandf1 integer /0/ # [0/1]: Turn on on-the-fly comparison of parallel vs serial evaluation of pandf1. ***** ParallelDebug: OMPJacDebug integer /0/ #Print debug info for omp constructs diff --git a/svr/nksol.m b/svr/nksol.m index 7f3b3bdb..f59af4d0 100755 --- a/svr/nksol.m +++ b/svr/nksol.m @@ -737,6 +737,7 @@ dimension icnstr(n) real zero,one,two,three logical mxtkn Use(Cdv) + Use(Svrstatus) # comnfe cpetsc external gettime cpetsc real gettime,sec4 c+pnb @@ -1006,6 +1007,7 @@ call errgen(ierr,zero,zero,iret,ivar) c----------------------------------------------------------------------- call f(n, u, savf) nfe = nfe + 1 + comnfe = comnfe + 1 fnrm = vnormnk(n,savf,sf) f1nrm = fnrm*fnrm/two if (iprint .ge. 1) write(iunit,400) iter,fnrm,nfe @@ -1215,6 +1217,7 @@ dimension u(*),unew(n),savf(n),su(n),sf(n),wk(n) c nks001 common block. c----------------------------------------------------------------------- real eps, sqteta, rhom + Use(Svrstatus) # comnfe common /nks001/ eps, rhom, sqteta, locwmp, locimp, iersl, kmp, * mmax, methn, methk, ipflg, mfdif, nfe, nje, nni, * nli, npe, nps, ncfl, nbcf @@ -1478,6 +1481,7 @@ dimension u(*), savf(n), su(n), sf(n) c nks001 common block. c----------------------------------------------------------------------- real eps, sqteta, rhom + Use(Svrstatus) # comnfe common /nks001/ eps, rhom, sqteta, locwmp, locimp, iersl, kmp, * mmax, methn, methk, ipflg, mfdif, nfe, nje, nni, * nli, npe, nps, ncfl, nbcf @@ -1601,6 +1605,7 @@ dimension u(*), savf(n), su(n), sf(n), wm(lenwm), iwm(leniwm), c nks001 common block. c----------------------------------------------------------------------- real eps, sqteta, rhom + Use(Svrstatus) # comnfe common /nks001/ eps, rhom, sqteta, locwmp, locimp, iersl, kmp, * mmax, methn, methk, ipflg, mfdif, nfe, nje, nni, * nli, npe, nps, ncfl, nbcf @@ -1966,6 +1971,7 @@ c f(u) = 0. c nks001 common block. c----------------------------------------------------------------------- real delt, sqteta, rhom + Use(Svrstatus) # comnfe common /nks001/ delt, rhom, sqteta, locwmp, locimp, iersl, kmp, * mmax, methn, methk, ipflg, mfdif, nfe, nje, nni, * nli, npe, nps, ncfl, nbcf @@ -2043,6 +2049,7 @@ call psol (n, u, savf, su, sf, f, jac, ftem, wmp, iwmp, endif call f(n, u, ftem) nfe = nfe + 1 + comnfe = comnfe + 1 ccc do 281 i = 1, n # Begin 2nd order Jac ccc u(i) = z(i) - sigma*vtem(i) # change sign of perturbation ccc 281 continue @@ -2640,6 +2647,7 @@ dimension u(*), uprev(n), unew(n), savf(n), fprev(n), su(n), sf(n) integer icflag, icnstr, ivio, ivar dimension icnstr(n) logical mxtkn, dog1, nwttkn + Use(Svrstatus) # comnfe c----------------------------------------------------------------------- c nks001 common block. c----------------------------------------------------------------------- @@ -2733,6 +2741,7 @@ dimension ygm(m), ycp(m), hes(mmaxp1,m), ynew(mp1), xnew(n), * v(n,m), wk(n), wmp(*), iwmp(*), u(*), su(n), sf(n), * savf(n) logical dog1, nwttkn + Use(Svrstatus) # comnfe c----------------------------------------------------------------------- c this is subroutine dogstp, which computes the dogleg step for a c given trust region size tau. @@ -2914,6 +2923,7 @@ subroutine trgupd (m, mp1, mmaxp1, n, np1, u, savf, f1nrm, x, xl, * wk, savf dimension u(*), x(n), ynew(m), savf(n), su(n), sf(n), * hes(mmaxp1,m), uprev(n), fprev(n), upls(n), wk(np1) + Use(Svrstatus) # comnfe c----------------------------------------------------------------------- c this is the real version of subroutine trgupd, which determines c if the x(tau) returned by dogstp satisfies @@ -3053,6 +3063,7 @@ call scopy (n, u, 1, upls, 1) 20 continue call f (n, u, savf) nfe = nfe + 1 + comnfe = comnfe + 1 call sswap(n, u, 1, upls, 1) fnrmp = vnormnk(n, savf, sf) f1pls = pt5*fnrmp*fnrmp @@ -3214,6 +3225,7 @@ c norm() denotes the euclidean norm. dimension savf(n),u(*),unew(n),p(n),su(n),sf(n),icnstr(n) real pt1,pt1trl,pt99,one,two,alpha,acond,mcond,bcond logical mxtkn + Use(Svrstatus) # comnfe c----------------------------------------------------------------------- c nks001 common block. c----------------------------------------------------------------------- @@ -3284,6 +3296,7 @@ call scopy(n, u, 1, unew, 1) 120 continue call f(n, u, savf) nfe = nfe + 1 + comnfe = comnfe + 1 call sswap(n, u, 1, unew, 1) fnrmp = vnormnk(n,savf,sf) f1nrmp = fnrmp*fnrmp/two @@ -3310,6 +3323,7 @@ call scopy(n, u, 1, unew, 1) 140 u(i) = unew(i) + rl*p(i) call f(n, u, savf) nfe = nfe + 1 + comnfe = comnfe + 1 call sswap(n, u, 1, unew, 1) fnrmp = vnormnk(n,savf,sf) f1nrmp = fnrmp*fnrmp/two @@ -3339,6 +3353,7 @@ call scopy(n, u, 1, unew, 1) 160 u(i) = unew(i) + rl*p(i) call f(n, u, savf) nfe = nfe + 1 + comnfe = comnfe + 1 call sswap(n, u, 1, unew, 1) fnrmp = vnormnk(n,savf,sf) f1nrmp = fnrmp*fnrmp/two @@ -3369,6 +3384,7 @@ call scopy(n, u, 1, unew, 1) 170 u(i) = unew(i) + rllo*p(i) call f(n, u, savf) nfe = nfe + 1 + comnfe = comnfe + 1 call sswap(n, u, 1, unew, 1) fnrmp = vnormnk(n,savf,sf) f1nrmp = fnrmp*fnrmp/two @@ -3392,6 +3408,7 @@ call scopy(n, u, 1, unew, 1) c load savf and f1nrmp with current values. call f(n, u, savf) nfe = nfe + 1 + comnfe = comnfe + 1 fnrmp = vnormnk(n,savf,sf) f1nrmp = fnrmp*fnrmp/two return @@ -3860,6 +3877,7 @@ c norm() denotes the euclidean norm. dimension savf(n),u(*),unew(n),p(n),su(n),sf(n),icnstr(n) real pt99,one,two logical mxtkn + Use(Svrstatus) # comnfe c----------------------------------------------------------------------- c nks001 common block. c----------------------------------------------------------------------- @@ -3919,6 +3937,7 @@ call scopy(n, u, 1, unew, 1) 20 continue call f(n, u, savf) nfe = nfe + 1 + comnfe = comnfe + 1 call sswap(n, u, 1, unew, 1) fnrmp = vnormnk(n,savf,sf) f1nrmp = fnrmp*fnrmp/two From 90ce6b1abdb55b1aa3dc719669481e95a3272b91 Mon Sep 17 00:00:00 2001 From: Andreas Holm <60451789+holm10@users.noreply.github.com> Date: Tue, 14 Jan 2025 15:26:56 -0800 Subject: [PATCH 2/3] Moves comnfe to Cvd pkg Nksol did not recognize Com packages in Basis build #@notests @nowheel --- bbb/bbb.v | 1 + com/com.v | 3 --- ppp/omp_parallel.F90 | 4 ++-- svr/nksol.m | 19 +++++++++---------- 4 files changed, 12 insertions(+), 15 deletions(-) diff --git a/bbb/bbb.v b/bbb/bbb.v index 843c96bd..9542e53d 100644 --- a/bbb/bbb.v +++ b/bbb/bbb.v @@ -3237,6 +3237,7 @@ ifexmain integer /0/ #scalar to indicate if subroutine allocate #=0 means it is not. exmain_aborted logical /.false./ # Set to .true. in Python version on control-C abort iallcall integer /0/ #flag to signal first call to allocate +comnfe integer /0/ # Number of NK iterations for time-step ***** RZ_cell_info: # RZ grid-cell center and face locations diff --git a/com/com.v b/com/com.v index 96b4f391..13bf3388 100755 --- a/com/com.v +++ b/com/com.v @@ -706,6 +706,3 @@ tanh_multi(i:integer,a:real,j:integer,b:real,fname:string,d:real) subroutine # Common flags used by UEDGE iprint integer /1/ # Flag controlling whether to be verbose or not -***** Svrstatus: -# Parameters indicating the solver status -comnfe integer /0/ # Number of NK iterations for time-step diff --git a/ppp/omp_parallel.F90 b/ppp/omp_parallel.F90 index db5b597c..64e33fb4 100644 --- a/ppp/omp_parallel.F90 +++ b/ppp/omp_parallel.F90 @@ -604,8 +604,8 @@ subroutine OMPPandf1Rhs(neq,time,yl,yldot) use Dim,only:ny use Selec, only:yinc,xrinc,xlinc Use Grid,only:ijactot - Use Svrstatus, only: comnfe - + Use Cdv, only: comnfe + integer yinc_bkp,xrinc_bkp,xlinc_bkp,iv,tid integer,intent(in)::neq real,intent(in)::yl(*) diff --git a/svr/nksol.m b/svr/nksol.m index f59af4d0..fc5de1b9 100755 --- a/svr/nksol.m +++ b/svr/nksol.m @@ -737,7 +737,6 @@ dimension icnstr(n) real zero,one,two,three logical mxtkn Use(Cdv) - Use(Svrstatus) # comnfe cpetsc external gettime cpetsc real gettime,sec4 c+pnb @@ -1204,6 +1203,7 @@ c norm(f) asymptotes from above to a finite value c in some direction, or stepmx is too small. c c----------------------------------------------------------------------- + Use(Cdv) implicit none integer n, iret, iter, itermx, ncscmx, iterm, locwmp, locimp integer iersl, kmp, mmax, methn, methk, ipflg, mfdif, nfe, nje @@ -1217,7 +1217,6 @@ dimension u(*),unew(n),savf(n),su(n),sf(n),wk(n) c nks001 common block. c----------------------------------------------------------------------- real eps, sqteta, rhom - Use(Svrstatus) # comnfe common /nks001/ eps, rhom, sqteta, locwmp, locimp, iersl, kmp, * mmax, methn, methk, ipflg, mfdif, nfe, nje, nni, * nli, npe, nps, ncfl, nbcf @@ -1467,6 +1466,7 @@ subroutine model(n, wm, lenwm, iwm, leniwm, u, savf, x, f, jac, c and the nonlinear iteration is halted. c c----------------------------------------------------------------------- + Use(Cdv) implicit none integer n, lenwm, leniwm, locwmp, locimp, iersl, kmp, mmax integer methn, methk, ipflg, mfdif, nfe, nje, nni, nli, npe @@ -1481,7 +1481,6 @@ dimension u(*), savf(n), su(n), sf(n) c nks001 common block. c----------------------------------------------------------------------- real eps, sqteta, rhom - Use(Svrstatus) # comnfe common /nks001/ eps, rhom, sqteta, locwmp, locimp, iersl, kmp, * mmax, methn, methk, ipflg, mfdif, nfe, nje, nni, * nli, npe, nps, ncfl, nbcf @@ -1538,6 +1537,7 @@ call solpk (n,wm,lenwm,iwm,leniwm,u,savf,x,su,sf,f,jac,psol) end subroutine solpk (n, wm, lenwm, iwm, leniwm, u, savf, x, su, sf, * f, jac, psol) + Use(Cdv) implicit none integer lenwm, leniwm, locwmp, locimp, iersl, kmp, mmax integer methn, methk, ipflg, mfdif, nfe, nje, nni, nli, npe @@ -1605,7 +1605,6 @@ dimension u(*), savf(n), su(n), sf(n), wm(lenwm), iwm(leniwm), c nks001 common block. c----------------------------------------------------------------------- real eps, sqteta, rhom - Use(Svrstatus) # comnfe common /nks001/ eps, rhom, sqteta, locwmp, locimp, iersl, kmp, * mmax, methn, methk, ipflg, mfdif, nfe, nje, nni, * nli, npe, nps, ncfl, nbcf @@ -1914,6 +1913,7 @@ call psol (n, u, savf, su, sf, f, jac, wk, wmp, iwmp, x, ier) end subroutine atv (n, u, savf, v, su, sf, ftem, f, jac, psol, z, * vtem, wmp, iwmp, ier, npsl) + Use(Cdv) implicit none integer iwmp, ier, npsl, locwmp, locimp, iersl, kmp, mmax integer methn, methk, ipflg, mfdif, nfe, nje, nni, nli, npe @@ -1971,7 +1971,6 @@ c f(u) = 0. c nks001 common block. c----------------------------------------------------------------------- real delt, sqteta, rhom - Use(Svrstatus) # comnfe common /nks001/ delt, rhom, sqteta, locwmp, locimp, iersl, kmp, * mmax, methn, methk, ipflg, mfdif, nfe, nje, nni, * nli, npe, nps, ncfl, nbcf @@ -2632,6 +2631,7 @@ c norm() denotes the euclidean norm. c failure causes the nonlinear iteration to halt. c c----------------------------------------------------------------------- + Use(Cdv) implicit none integer n, lenwm, iwm, leniwm, iret, locwmp, locimp, iersl integer kmp, mmax, methn, methk, ipflg, mfdif, nfe, nje, nni @@ -2647,7 +2647,6 @@ dimension u(*), uprev(n), unew(n), savf(n), fprev(n), su(n), sf(n) integer icflag, icnstr, ivio, ivar dimension icnstr(n) logical mxtkn, dog1, nwttkn - Use(Svrstatus) # comnfe c----------------------------------------------------------------------- c nks001 common block. c----------------------------------------------------------------------- @@ -2730,6 +2729,7 @@ subroutine dogstp (m, mp1, mmaxp1, ygm, ycp, beta, hes, tau, ynew, * stepmx, dog1, nwttkn, cpl, gml, n, v, xnew, * xnewl, wk, wmp, iwmp, u, su, sf, savf, f, jac, * psol) + Use(Cdv) implicit none integer m, mp1, mmaxp1, n, iwmp, locwmp, locimp, iersl, kmp integer mmax, methn, methk, ipflg, mfdif, nfe, nje, nni, nli @@ -2741,7 +2741,6 @@ dimension ygm(m), ycp(m), hes(mmaxp1,m), ynew(mp1), xnew(n), * v(n,m), wk(n), wmp(*), iwmp(*), u(*), su(n), sf(n), * savf(n) logical dog1, nwttkn - Use(Svrstatus) # comnfe c----------------------------------------------------------------------- c this is subroutine dogstp, which computes the dogleg step for a c given trust region size tau. @@ -2913,6 +2912,7 @@ subroutine trgupd (m, mp1, mmaxp1, n, np1, u, savf, f1nrm, x, xl, * ynew, su, sf, nwttkn, stepmx, beta, hes, * stptol, mxtkn, tau, uprev, fprev, f1prv, upls, * f1pls, wk, ivio, iret, f) + Use(Cdv) implicit none integer m, mp1, mmaxp1, n, np1, ivio, iret, locwmp, locimp integer iersl, kmp, mmax, methn, methk, ipflg, mfdif, nfe, nje @@ -2923,7 +2923,6 @@ subroutine trgupd (m, mp1, mmaxp1, n, np1, u, savf, f1nrm, x, xl, * wk, savf dimension u(*), x(n), ynew(m), savf(n), su(n), sf(n), * hes(mmaxp1,m), uprev(n), fprev(n), upls(n), wk(np1) - Use(Svrstatus) # comnfe c----------------------------------------------------------------------- c this is the real version of subroutine trgupd, which determines c if the x(tau) returned by dogstp satisfies @@ -3210,6 +3209,7 @@ c norm() denotes the euclidean norm. c the beta-condition could not be met on this call. c c----------------------------------------------------------------------- + Use(Cdv) implicit none integer n, iret, icflag, icnstr, locwmp, locimp, iersl, kmp integer mmax, methn, methk, ipflg, mfdif, nfe, nje, nni, nli @@ -3225,7 +3225,6 @@ c norm() denotes the euclidean norm. dimension savf(n),u(*),unew(n),p(n),su(n),sf(n),icnstr(n) real pt1,pt1trl,pt99,one,two,alpha,acond,mcond,bcond logical mxtkn - Use(Svrstatus) # comnfe c----------------------------------------------------------------------- c nks001 common block. c----------------------------------------------------------------------- @@ -3864,6 +3863,7 @@ c norm() denotes the euclidean norm. c maximum length stepmx. c c----------------------------------------------------------------------- + Use(Cdv) implicit none integer n, iret, icflag, icnstr, locwmp, locimp, iersl, kmp integer mmax, methn, methk, ipflg, mfdif, nfe, nje, nni, nli @@ -3877,7 +3877,6 @@ c norm() denotes the euclidean norm. dimension savf(n),u(*),unew(n),p(n),su(n),sf(n),icnstr(n) real pt99,one,two logical mxtkn - Use(Svrstatus) # comnfe c----------------------------------------------------------------------- c nks001 common block. c----------------------------------------------------------------------- From 77f587fffcb22e6a570483648daca587482b4b73 Mon Sep 17 00:00:00 2001 From: Andreas Holm <60451789+holm10@users.noreply.github.com> Date: Tue, 14 Jan 2025 15:31:18 -0800 Subject: [PATCH 3/3] Reorders Use to comply w/ BASIS build #@notests @nowheel --- svr/nksol.m | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/svr/nksol.m b/svr/nksol.m index fc5de1b9..ddc1895d 100755 --- a/svr/nksol.m +++ b/svr/nksol.m @@ -1203,8 +1203,8 @@ c norm(f) asymptotes from above to a finite value c in some direction, or stepmx is too small. c c----------------------------------------------------------------------- - Use(Cdv) implicit none + Use(Cdv) integer n, iret, iter, itermx, ncscmx, iterm, locwmp, locimp integer iersl, kmp, mmax, methn, methk, ipflg, mfdif, nfe, nje integer nni, nli, npe, nps, ncfl, nbcf, ipcur, nnipset @@ -1466,8 +1466,8 @@ subroutine model(n, wm, lenwm, iwm, leniwm, u, savf, x, f, jac, c and the nonlinear iteration is halted. c c----------------------------------------------------------------------- - Use(Cdv) implicit none + Use(Cdv) integer n, lenwm, leniwm, locwmp, locimp, iersl, kmp, mmax integer methn, methk, ipflg, mfdif, nfe, nje, nni, nli, npe integer nps, ncfl, nbcf, ipcur, nnipset, incpset, ier @@ -1537,8 +1537,8 @@ call solpk (n,wm,lenwm,iwm,leniwm,u,savf,x,su,sf,f,jac,psol) end subroutine solpk (n, wm, lenwm, iwm, leniwm, u, savf, x, su, sf, * f, jac, psol) - Use(Cdv) implicit none + Use(Cdv) integer lenwm, leniwm, locwmp, locimp, iersl, kmp, mmax integer methn, methk, ipflg, mfdif, nfe, nje, nni, nli, npe integer nps, ncfl, nbcf, iwk, npsl, mmaxp1, ihsv, iq, mgmr @@ -1913,8 +1913,8 @@ call psol (n, u, savf, su, sf, f, jac, wk, wmp, iwmp, x, ier) end subroutine atv (n, u, savf, v, su, sf, ftem, f, jac, psol, z, * vtem, wmp, iwmp, ier, npsl) - Use(Cdv) implicit none + Use(Cdv) integer iwmp, ier, npsl, locwmp, locimp, iersl, kmp, mmax integer methn, methk, ipflg, mfdif, nfe, nje, nni, nli, npe integer nps, ncfl, nbcf, i @@ -2631,8 +2631,8 @@ c norm() denotes the euclidean norm. c failure causes the nonlinear iteration to halt. c c----------------------------------------------------------------------- - Use(Cdv) implicit none + Use(Cdv) integer n, lenwm, iwm, leniwm, iret, locwmp, locimp, iersl integer kmp, mmax, methn, methk, ipflg, mfdif, nfe, nje, nni integer nli, npe, nps, ncfl, nbcf, iprint, iunit, iermsg, np1 @@ -2729,8 +2729,8 @@ subroutine dogstp (m, mp1, mmaxp1, ygm, ycp, beta, hes, tau, ynew, * stepmx, dog1, nwttkn, cpl, gml, n, v, xnew, * xnewl, wk, wmp, iwmp, u, su, sf, savf, f, jac, * psol) - Use(Cdv) implicit none + Use(Cdv) integer m, mp1, mmaxp1, n, iwmp, locwmp, locimp, iersl, kmp integer mmax, methn, methk, ipflg, mfdif, nfe, nje, nni, nli integer npe, nps, ncfl, nbcf, i, ier @@ -2912,8 +2912,8 @@ subroutine trgupd (m, mp1, mmaxp1, n, np1, u, savf, f1nrm, x, xl, * ynew, su, sf, nwttkn, stepmx, beta, hes, * stptol, mxtkn, tau, uprev, fprev, f1prv, upls, * f1pls, wk, ivio, iret, f) - Use(Cdv) implicit none + Use(Cdv) integer m, mp1, mmaxp1, n, np1, ivio, iret, locwmp, locimp integer iersl, kmp, mmax, methn, methk, ipflg, mfdif, nfe, nje integer nni, nli, npe, nps, ncfl, nbcf, i @@ -3209,8 +3209,8 @@ c norm() denotes the euclidean norm. c the beta-condition could not be met on this call. c c----------------------------------------------------------------------- - Use(Cdv) implicit none + Use(Cdv) integer n, iret, icflag, icnstr, locwmp, locimp, iersl, kmp integer mmax, methn, methk, ipflg, mfdif, nfe, nje, nni, nli integer npe, nps, ncfl, nbcf, iprint, iunit, iermsg, i, ivio @@ -3863,8 +3863,8 @@ c norm() denotes the euclidean norm. c maximum length stepmx. c c----------------------------------------------------------------------- - Use(Cdv) implicit none + Use(Cdv) integer n, iret, icflag, icnstr, locwmp, locimp, iersl, kmp integer mmax, methn, methk, ipflg, mfdif, nfe, nje, nni, nli integer npe, nps, ncfl, nbcf, iprint, iunit, iermsg, i, ivio, ivar