c c c ================================================================== subroutine rptt3(ixyz,icoor,maxm,meqn,mwaves,mbc,mx, & ql,qr,aux1,aux2,aux3,maux,imp,impt,bsasdq, & cmbsasdq,cpbsasdq) c ================================================================== c c # Double transverse Riemann solver for the acoustics equations c # with varying material properties. c # auxN(i,1,:) holds impedance Z c # auxN(i,2,:) holds sound speed c c # c # On input, c c # ql,qr is the data along some one-dimensional slice, as in rpn3 c # This slice is c # in the x-direction if ixyz=1, c # in the y-direction if ixyz=2, or c # in the z-direction if ixyz=3. c c # bsasdq is an array of flux differences that result from a c # transverse splitting (a previous call to rpt3). c # This stands for B^* A^* \Dq but could represent any of c # 6 possibilities, e.g. C^* B^* \Dq, as specified by ixyz c # and icoor (see below). c # Moreover, each * represents either + or -, as specified by c # imp and impt. c c # ixyz indicates the direction of the original Riemann solve, c # called the x-like direction in the table below: c c # x-like direction y-like direction z-like direction c # ixyz=1: x y z c # ixyz=2: y z x c # ixyz=3: z x y c c # icoor indicates direction in which the transverse solve should c # be performed. c # icoor=2: split in the y-like direction. c # icoor=3: split in the z-like direction. c c # For example, c # ixyz=1, icoor=3 means bsasdq=B^*A^*\Dq, and should be c # split in z into c # cmbsasdq = C^-B^*A^*\Dq, c # cpbsasdq = C^+B^*A^*\Dq. c # c # ixyz=2, icoor=3 means bsasdq=C^*B^*\Dq, and should be c # split in x into c # cmbsasdq = A^-C^*B^*\Dq, c # cpbsasdq = A^+C^*B^*\Dq. c c # The parameters imp and impt are generally needed only if aux c # arrays are being used, in order to access the appropriate c # variable coefficients: c # imp = 1 if bsasdq = B^*A^- \Dq, a left-going flux difference c # 2 if bsasdq = B^*A^+ \Dq, a right-going flux difference c # impt = 1 if bsasdq = B^-A^* \Dq, a down-going flux difference c # 2 if bsasdq = B^+A^* \Dq, an up-going flux difference c c # aux2(:,:,2) is a 1d slice of the aux array along the row c # where the data ql, qr lie. c # aux1(:,:,2) and aux3(:,:,2) are neighboring rows in the c # y-like direction c # aux2(:,:,1) and aux2(:,:,3) are neighboring rows in the c # z-like direction c c implicit real*8(a-h,o-z) dimension ql(1-mbc:maxm+mbc, meqn) dimension qr(1-mbc:maxm+mbc, meqn) dimension bsasdq(1-mbc:maxm+mbc, meqn) dimension cmbsasdq(1-mbc:maxm+mbc, meqn) dimension cpbsasdq(1-mbc:maxm+mbc, meqn) dimension aux1(1-mbc:maxm+mbc, maux, 3) dimension aux2(1-mbc:maxm+mbc, maux, 3) dimension aux3(1-mbc:maxm+mbc, maux, 3) c c c # set iuvw = 2,3,4, depending on which component of q represents c # velocity in the transverse direction in which splitting is to c # be performed: iuvw = ixyz + icoor if (iuvw.gt.4) iuvw = iuvw-3 c do 10 i=2-mbc,mx+mbc c # The flux difference bsasdq is split into downward moving part c # traveling at speed -c relative to the medium below and c # an upward moving part traveling at speed +c relative to c # the medium above, in the double-transverse direction specified c # by icoor. c c # Note that the sum of these parts does not give all of bsasdq c # since there is also reflection at the interfaces which decreases c # the flux. c c c # set impendance and sound speed in each row of cells, c # by selecting appropriate values from aux arrays depending on c # values of icoor, imp, impt: c i1 = i-2+imp !# = i-1 for amdq, i for apdq c if (impt .eq. 1) then c # bsasdq propagates to "left" in transverse direction used in rpt3 c # so we either use auxN(:,:,1) or aux1(:,:,N) for N=1,2,3 c # depending on icoor: if (icoor .eq. 2) then c # new double-transverse direction is y-like direction zm = aux1(i1,1,1) zz = aux2(i1,1,1) zp = aux3(i1,1,1) cm = aux1(i1,2,1) c = aux2(i1,2,1) cp = aux3(i1,2,1) else !! (icoor .eq. 3) c # new double-transverse direction is z-like direction zm = aux1(i1,1,1) zz = aux1(i1,1,2) zp = aux1(i1,1,3) cm = aux1(i1,2,1) c = aux1(i1,2,2) cp = aux1(i1,2,3) endif else c # bsasdq propagates to "right" in transverse direction used in rpt3 c # so we either use auxN(:,:,3) or aux3(:,:,N) for N=1,2,3 c # depending on icoor: if (icoor .eq. 2) then c # new double-transverse direction is y-like direction zm = aux1(i1,1,3) zz = aux2(i1,1,3) zp = aux3(i1,1,3) cm = aux1(i1,2,3) c = aux2(i1,2,3) cp = aux3(i1,2,3) else !! (icoor .eq. 3) c # new double-transverse direction is z-like direction zm = aux3(i1,1,1) zz = aux3(i1,1,2) zp = aux3(i1,1,3) cm = aux3(i1,2,1) c = aux3(i1,2,2) cp = aux3(i1,2,3) endif endif c c # transmitted part of down-going wave: a1 = (-bsasdq(i,1) + bsasdq(i,iuvw)*zz) / & (zm + zz) c # transmitted part of up-going wave: a2 = (bsasdq(i,1) + bsasdq(i,iuvw)*zz) / & (zz + zp) c c # The down-going flux difference cmbsasdq is the product -c * wave c cmbsasdq(i,1) = cm * a1*zm cmbsasdq(i,2) = 0.d0 cmbsasdq(i,3) = 0.d0 cmbsasdq(i,4) = 0.d0 cmbsasdq(i,iuvw) = -cm * a1 c c # The up-going flux difference cpbsasdq is the product c * wave c cpbsasdq(i,1) = cp * a2*zp cpbsasdq(i,2) = 0.d0 cpbsasdq(i,3) = 0.d0 cpbsasdq(i,4) = 0.d0 cpbsasdq(i,iuvw) = cp * a2 c 10 continue c return end c