#ifndef dfltpbd subroutine fltpbn #else subroutine fltpbn (pwk2) #endif c c======================================================================= c === c This routine filters the radiation-type estimate for the transport=== c streamfunction along the outer boundary. === c === c ------ === c Input: === c ------ === #ifdef dfltpbd c === c PWK2 Time change guess for transport. (real array) === #endif c === c Common Blocks: === c === #ifndef dfltpbd c /BNDATA/ === c === c PO transport boundary conditions at t=TTBDYO. (real array) === c === #endif c /FILTDAT/ === c === c NORDP transport: order of the Shapiro filter. (integer)=== c NORDV velocity: order of the Shapiro filter. (integer)=== c NTIMP transport: number of times to apply filter. (integer)=== c NTIMV velocity: number of times to apply filter. (integer)=== c === c /FULLWD/ === c === c IEXT Extraction I-coords, external bndy. (integer vector) === c JEXT Extraction J-coords, external bndy. (integer vector) === c NOEXT Length of external boundary. (integer) === c === c ------- === c Output: === c ------- === #ifdef dfltpbd c === c PWK2 Filtered time change guess for transport. (real array) === #else c === c Common Blocks: === c === c /BNDATA/ === c === c PO filtered transport boundary conditions. (real array) === c === #endif c ------ === c Calls: === c ------ === c === #ifdef coast c CNSTPBY, SHAP1DC === #else c SHAP1DC === #endif c === c======================================================================= c c----------------------------------------------------------------------- c Define global data. c----------------------------------------------------------------------- c #include #include #ifndef dfltpbd # include #endif #include #include c c----------------------------------------------------------------------- c Define local data. c----------------------------------------------------------------------- c integer n,pbord,pbtim #ifndef dfltpbd & ,i,j #endif logical first real pwk1(maxext),pwk2(imt,jmt) c save first,pbord,pbtim c data first/.true./ c c======================================================================= c Begin executable code. c======================================================================= c c----------------------------------------------------------------------- c Initialize filter parameters on first call. c----------------------------------------------------------------------- c if (first) then if (nordp.ne.0) then pbord = nordp else pbord = nordv endif if (ntimp.ne.0) then pbtim = ntimp else pbtim = ntimv endif first = .false. endif c c----------------------------------------------------------------------- c Place boundary data on 2D array for ease of extraction. c----------------------------------------------------------------------- c #ifndef dfltpbd do 10 i = 1, imt pwk2(i,1) = po(i,1,south) pwk2(i,jmt) = po(i,1,north) 10 continue c do 20 j = 2, jmtm1 pwk2(1,j) = po(i,1,west) pwk2(imt,j) = po(i,1,east) 20 continue c #endif #ifdef coast call cnstpby (pwk2) c #endif c----------------------------------------------------------------------- c Extract external boundary data into vector. c----------------------------------------------------------------------- c do 30 n = 1, noext pwk1(n) = pwk2(iext(n),jext(n)) 30 continue c c----------------------------------------------------------------------- c Filter boundary data. c----------------------------------------------------------------------- c do 40 n = 1, pbtim call shap1dc (pwk1,noext,pbord) 40 continue c c----------------------------------------------------------------------- c Place filtered external boundary data into array. c----------------------------------------------------------------------- c do 50 n = 1, noext pwk2(iext(n),jext(n)) = pwk1(n) 50 continue c #ifdef coast call cnstpby (pwk2) c #endif #ifndef dfltpbd c----------------------------------------------------------------------- c Replace filtered boundary data into working storage. c----------------------------------------------------------------------- c do 60 i = 1, imt po(i,1,south) = pwk2(i,1) po(i,1,north) = pwk2(i,jmt) 60 continue c do 70 j = 1, jmt po(i,1,west) = pwk2(1,j) po(i,1,east) = pwk2(imt,j) 70 continue c #endif return end