step2.f.html | clawcode2html |
Source file: step2.f | |
Directory: /home/rjl/www/pubs/cise08/cise08levequeV2/lib | |
Converted: Wed Jul 2 2008 at 13:39:56 | |
This documentation file will not reflect any later changes in the source file. |
c c c c c ========================================================== subroutine step2(maxm,maxmx,maxmy,meqn,mwaves,mbc,mx,my, & qold,qnew,aux,dx,dy,dt,method,mthlim,cfl, & qadd,fadd,gadd,q1d,dtdx1d,dtdy1d, & aux1,aux2,aux3,work,mwork,rpn2,rpt2) c ========================================================== c c # Take one time step, updating q. c # On entry, qold and qnew should be identical and give the c # initial data for this step c # On exit, qnew returns values at the end of the time step. c # qold is unchanged. c c # qadd is used to return increments to q from flux2 c # fadd and gadd are used to return flux increments from flux2. c # See the flux2 documentation for more information. c c implicit double precision (a-h,o-z) external rpn2,rpt2 dimension qold(1-mbc:maxmx+mbc, 1-mbc:maxmy+mbc, meqn) dimension qnew(1-mbc:maxmx+mbc, 1-mbc:maxmy+mbc, meqn) dimension q1d(1-mbc:maxm+mbc, meqn) dimension qadd(1-mbc:maxm+mbc, meqn) dimension fadd(1-mbc:maxm+mbc, meqn) dimension gadd(1-mbc:maxm+mbc, meqn, 2) dimension aux(1-mbc:maxmx+mbc, 1-mbc:maxmy+mbc, *) dimension aux1(1-mbc:maxm+mbc, *) dimension aux2(1-mbc:maxm+mbc, *) dimension aux3(1-mbc:maxm+mbc, *) dimension dtdx1d(1-mbc:maxm+mbc) dimension dtdy1d(1-mbc:maxm+mbc) dimension method(7),mthlim(mwaves) dimension work(mwork) common /comxyt/ dtcom,dxcom,dycom,tcom,icom,jcom c c c c # partition work array into pieces needed for local storage in c # flux2 routine. Find starting index of each piece: c i0wave = 1 i0s = i0wave + (maxm+2*mbc)*meqn*mwaves i0amdq = i0s + (maxm+2*mbc)*mwaves i0apdq = i0amdq + (maxm+2*mbc)*meqn i0cqxx = i0apdq + (maxm+2*mbc)*meqn i0bmadq = i0cqxx + (maxm+2*mbc)*meqn i0bpadq = i0bmadq + (maxm+2*mbc)*meqn iused = i0bpadq + (maxm+2*mbc)*meqn - 1 c if (iused.gt.mwork) then c # This shouldn't happen due to checks in claw2 write(6,*) '*** not enough work space in step2' write(6,*) '*** iused = ', iused, ' mwork =',mwork stop endif c c mcapa = method(6) maux = method(7) cfl = 0.d0 dtdx = dt/dx dtdy = dt/dy c if (mcapa.eq.0) then c # no capa array: do 5 i=1-mbc,maxm+mbc dtdx1d(i) = dtdx dtdy1d(i) = dtdy 5 continue endif c c c # perform x-sweeps c ================== c do 50 j = 0,my+1 c c # copy data along a slice into 1d arrays: do 21 m=1,meqn do 20 i = 1-mbc, mx+mbc q1d(i,m) = qold(i,j,m) 20 continue 21 continue c if (mcapa.gt.0) then do 22 i = 1-mbc, mx+mbc dtdx1d(i) = dtdx / aux(i,j,mcapa) 22 continue endif c if (maux .gt. 0) then do 25 ma=1,maux do 24 i = 1-mbc, mx+mbc aux1(i,ma) = aux(i,j-1,ma) aux2(i,ma) = aux(i,j ,ma) aux3(i,ma) = aux(i,j+1,ma) 24 continue 25 continue endif c c # Store the value of j along this slice in the common block c # comxyt in case it is needed in the Riemann solver (for c # variable coefficient problems) jcom = j c c # compute modifications fadd and gadd to fluxes along this slice: call flux2(1,maxm,meqn,mwaves,mbc,mx, & q1d,dtdx1d,aux1,aux2,aux3,method,mthlim, & qadd,fadd,gadd,cfl1d, & work(i0wave),work(i0s),work(i0amdq),work(i0apdq), & work(i0cqxx),work(i0bmadq),work(i0bpadq),rpn2,rpt2) cfl = dmax1(cfl,cfl1d) c c # update qnew by flux differencing. c # (rather than maintaining arrays f and g for the total fluxes, c # the modifications are used immediately to update qnew c # in order to save storage.) c if (mcapa.eq.0) then c c # no capa array. Standard flux differencing: do 31 m=1,meqn do 30 i=1,mx qnew(i,j,m) = qnew(i,j,m) + qadd(i,m) & - dtdx * (fadd(i+1,m) - fadd(i,m)) & - dtdy * (gadd(i,m,2) - gadd(i,m,1)) qnew(i,j-1,m) = qnew(i,j-1,m) - dtdy * gadd(i,m,1) qnew(i,j+1,m) = qnew(i,j+1,m) + dtdy * gadd(i,m,2) 30 continue 31 continue c else c c # with capa array. do 41 m=1,meqn do 40 i=1,mx qnew(i,j,m) = qnew(i,j,m) + qadd(i,m) & - (dtdx * (fadd(i+1,m) - fadd(i,m)) & + dtdy * (gadd(i,m,2) - gadd(i,m,1))) & / aux(i,j,mcapa) qnew(i,j-1,m) = qnew(i,j-1,m) - dtdy * gadd(i,m,1) & / aux(i,j-1,mcapa) qnew(i,j+1,m) = qnew(i,j+1,m) + dtdy * gadd(i,m,2) & / aux(i,j+1,mcapa) 40 continue 41 continue endif 50 continue c c c c # perform y sweeps c ================== c c do 100 i = 0, mx+1 c c # copy data along a slice into 1d arrays: do 71 m=1,meqn do 70 j = 1-mbc, my+mbc q1d(j,m) = qold(i,j,m) 70 continue 71 continue c if (mcapa.gt.0) then do 72 j = 1-mbc, my+mbc dtdy1d(j) = dtdy / aux(i,j,mcapa) 72 continue endif c if (maux .gt. 0) then do 75 ma=1,maux do 74 j = 1-mbc, my+mbc aux1(j,ma) = aux(i-1,j,ma) aux2(j,ma) = aux(i, j,ma) aux3(j,ma) = aux(i+1,j,ma) 74 continue 75 continue endif c c c # Store the value of i along this slice in the common block c # comxyt in case it is needed in the Riemann solver (for c # variable coefficient problems) icom = i c c # compute modifications fadd and gadd to fluxes along this slice: call flux2(2,maxm,meqn,mwaves,mbc,my, & q1d,dtdy1d,aux1,aux2,aux3,method,mthlim, & qadd,fadd,gadd,cfl1d, & work(i0wave),work(i0s),work(i0amdq),work(i0apdq), & work(i0cqxx),work(i0bmadq),work(i0bpadq),rpn2,rpt2) c cfl = dmax1(cfl,cfl1d) c c # update qnew by flux differencing. c # Note that the roles of fadd and gadd are reversed for c # the y-sweeps -- fadd is the modification to g-fluxes and c # gadd is the modification to f-fluxes to the left and right. c if (mcapa.eq.0) then c c # no capa array. Standard flux differencing: do 81 m=1,meqn do 80 j=1,my qnew(i,j,m) = qnew(i,j,m) + (qadd(j,m) & - dtdy * (fadd(j+1,m) - fadd(j,m)) & - dtdx * (gadd(j,m,2) - gadd(j,m,1))) qnew(i-1,j,m) = qnew(i-1,j,m) - dtdx * gadd(j,m,1) qnew(i+1,j,m) = qnew(i+1,j,m) + dtdx * gadd(j,m,2) 80 continue 81 continue c else c c # with capa array. do 91 m=1,meqn do 90 j=1,my qnew(i,j,m) = qnew(i,j,m) + qadd(j,m) & - (dtdy * (fadd(j+1,m) - fadd(j,m)) & + dtdx * (gadd(j,m,2) - gadd(j,m,1))) & / aux(i,j,mcapa) qnew(i-1,j,m) = qnew(i-1,j,m) - dtdx * gadd(j,m,1) & / aux(i-1,j,mcapa) qnew(i+1,j,m) = qnew(i+1,j,m) + dtdx * gadd(j,m,2) & / aux(i+1,j,mcapa) 90 continue 91 continue endif 100 continue c return end