#if !defined usrdiagnostic | !defined nesttime subroutine nest_rec_bc (itt) #else subroutine nest_rec_bc (itt,tsn1,tsn2) #endif c c======================================================================= c === c This routine receives the boundary conditions from a larger domain.=== c === c ------ === c Input: === c ------ === c === c ITT Current time step. (integer) === c === c Common Blocks: === c === c /IOUNITS/ === c === c STDOUT Unit number for standard output. (integer) === c === c /NEST/ === c === c LRGTID PVM task identifier for larger grid. (integer) === c SPVL Flag value from larger grid. (real) === c === c /OPTIONS/ === c === c IOPT various switches from standard input: (integer vector) === c IOPT(5) "diagnostic" printing control: === c [0] Terse output. === c [1] Verbose output. === c IOPT(8) Number of tracers exchanged with larger domain. === c === c /RHOMEAN/ === c === c SMEAN Mean salinity subtracted during === c computations. (real) === c === #ifdef gridold c /VERTSLABS/ === c === c DZVQZ Vertical box thickness. (real array) === #else c /VERTICAL/ === c === c DZV Thicknesses of UV vertical boxes. (real array; cm) === #endif c === c ------- === c Output: === c ------- === #if defined usrdiagnostic & defined nesttime c === c TSN1 Time spent in communications. (real vector) === c TSN2 Time spent in auxillary calculations. (real vector) === #endif c === c Common Blocks: === c === c /BNDATA/ === c === c PO Transport and time rate change of === c vorticity boundary conditions (real array)=== c === c /FIELDS/ === c === c ZTD Time change of vorticity with BCs. (real array) === c === c /VOLDAT/ === c === c XT Tracer fields. (real array)=== c XU Zonal internal mode velocity. (real array)=== c XV Meridional internal mode velocity. (real array)=== c === c Calls: HOPSRECV, NEST_ERRCHK === c PVM Calls: PVMFUNPACK === c === c======================================================================= c c----------------------------------------------------------------------- c Define global data c----------------------------------------------------------------------- c #include #include #include #include #include #include #include #include #include #include #include #ifdef gridold # include #else # include #endif c c----------------------------------------------------------------------- c Define local and equivalence data. c----------------------------------------------------------------------- c integer bufid,i,ip,itt,j,k,n,status,toff,xip logical first FLOAT * trc_shft #if defined usrdiagnostic & defined nesttime FLOAT & tsn1(2),tsn2(2),twk(2) #endif c save first,toff c data first /.true./ c c======================================================================= c Begin executable code. c======================================================================= c c----------------------------------------------------------------------- c Set tracer code offset. c----------------------------------------------------------------------- c if (first) then toff = trofst + iopt(8) + 1 first = .false. end if c c----------------------------------------------------------------------- c Receive boundary conditions for transport streamfunction. c----------------------------------------------------------------------- c if (itt.gt.nest_start) then if (mod(itt,itt_fac).eq.0) then #ifndef nest_ext2lrgr c if (iopt(5).eq.1) write (stdout,900) c c Western boundary. c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,psibdw,bufid) call pvmfunpack (nstflt,xvol,jmt,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c i=1 do 10 j = 1, jmt if (xvol(j).ne.spvl) po(j,1,west) = xvol(j) 10 continue c c Eastern boundary. c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,psibde,bufid) call pvmfunpack (nstflt,xvol,jmt,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c i=imt do 20 j = 1, jmt if (xvol(j).ne.spvl) po(j,1,east) = xvol(j) 20 continue c c Southern boundary. c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,psibds,bufid) call pvmfunpack (nstflt,xvol,imt,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c j=1 do 30 i = 1, imt if (xvol(i).ne.spvl) po(i,1,south) = xvol(i) 30 continue c c Northern boundary. c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,psibdn,bufid) call pvmfunpack (nstflt,xvol,imt,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c j=jmt do 40 i = 1, imt if (xvol(i).ne.spvl) po(i,1,north) = xvol(i) 40 continue c #else c write (stdout,900) c c Full field. c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,psibdw,bufid) call pvmfunpack (nstflt,xpal,imt*jmt,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c do 10 j = 1, jmt do 10 i = 1, imt ip=i+(j-1)*imt pb(i,j)=p(i,j) if (xvol(ip).ne.spvl) p(i,j) = xpal(ip) 10 continue #endif endif endif c c----------------------------------------------------------------------- c Receive boundary conditions for 3D fields. c----------------------------------------------------------------------- c if (itt.gt.nest_start) then if (mod(itt,itt_fac).eq.0) then c if (iopt(5).eq.1) write (stdout,910) c c -- Internal mode zonal velocity. c c Western boundary c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,ucbdyw,bufid) call pvmfunpack (nstflt,xvol,jmt*km,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c i = 1 do 50 k = 1, km do 50 j = 1, jmt ip = i + (j-1)*imt xip = j + (k-1)*jmt # ifdef gridold call setvert (j) if (xvol(xip).ne.spvl) xu(ip,k) = xvol(xip)/dzvqz(i,k,0) # else if (xvol(xip).ne.spvl) xu(ip,k) = xvol(xip)/dzv(i,j,k) # endif 50 continue c c Eastern boundary c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,ucbdye,bufid) call pvmfunpack (nstflt,xvol,jmt*km,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c i = imtm1 do 60 k = 1, km do 60 j = 1, jmt ip = i + (j-1)*imt xip = j + (k-1)*jmt # ifdef gridold call setvert (j) if (xvol(xip).ne.spvl) xu(ip,k) = xvol(xip)/dzvqz(i,k,0) # else if (xvol(xip).ne.spvl) xu(ip,k) = xvol(xip)/dzv(i,j,k) # endif 60 continue c c Southern boundary c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,ucbdys,bufid) call pvmfunpack (nstflt,xvol,imt*km,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c j = 1 # ifdef gridold call setvert (j) # endif do 70 k = 1, km do 70 i = 1, imt ip = i + (j-1)*imt xip = i + (k-1)*imt # ifdef gridold if (xvol(xip).ne.spvl) xu(ip,k) = xvol(xip)/dzvqz(i,k,0) # else if (xvol(xip).ne.spvl) xu(ip,k) = xvol(xip)/dzv(i,j,k) # endif 70 continue c c Northern boundary c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,ucbdyn,bufid) call pvmfunpack (nstflt,xvol,imt*km,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c j = jmtm1 # ifdef gridold call setvert (j) # endif do 80 k = 1, km do 80 i = 1, imt ip = i + (j-1)*imt xip = i + (k-1)*imt # ifdef gridold if (xvol(xip).ne.spvl) xu(ip,k) = xvol(xip)/dzvqz(i,k,0) # else if (xvol(xip).ne.spvl) xu(ip,k) = xvol(xip)/dzv(i,j,k) # endif 80 continue c c -- Internal mode meridional velocity. c c Western boundary c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,vcbdyw,bufid) call pvmfunpack (nstflt,xvol,jmt*km,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c i = 1 do 90 k = 1, km do 90 j = 1, jmt ip = i + (j-1)*imt xip = j + (k-1)*jmt # ifdef gridold call setvert (j) if (xvol(xip).ne.spvl) xv(ip,k) = xvol(xip)/dzvqz(i,k,0) # else if (xvol(xip).ne.spvl) xv(ip,k) = xvol(xip)/dzv(i,j,k) # endif 90 continue c c Eastern boundary c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,vcbdye,bufid) call pvmfunpack (nstflt,xvol,jmt*km,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c i = imtm1 do 100 k = 1, km do 100 j = 1, jmt ip = i + (j-1)*imt xip = j + (k-1)*jmt # ifdef gridold call setvert (j) if (xvol(xip).ne.spvl) xv(ip,k) = xvol(xip)/dzvqz(i,k,0) # else if (xvol(xip).ne.spvl) xv(ip,k) = xvol(xip)/dzv(i,j,k) # endif 100 continue c c Southern boundary c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,vcbdys,bufid) call pvmfunpack (nstflt,xvol,imt*km,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c j = 1 # ifdef gridold call setvert (j) # endif do 110 k = 1, km do 110 i = 1, imt ip = i + (j-1)*imt xip = i + (k-1)*imt # ifdef gridold if (xvol(xip).ne.spvl) xv(ip,k) = xvol(xip)/dzvqz(i,k,0) # else if (xvol(xip).ne.spvl) xv(ip,k) = xvol(xip)/dzv(i,j,k) # endif 110 continue c c Northern boundary c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,vcbdyn,bufid) call pvmfunpack (nstflt,xvol,imt*km,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c j = jmtm1 # ifdef gridold call setvert (j) # endif do 120 k = 1, km do 120 i = 1, imt ip = i + (j-1)*imt xip = i + (k-1)*imt # ifdef gridold if (xvol(xip).ne.spvl) xv(ip,k) = xvol(xip)/dzvqz(i,k,0) # else if (xvol(xip).ne.spvl) xv(ip,k) = xvol(xip)/dzv(i,j,k) # endif 120 continue c c -- Tracers. c do 170 n = 1,iopt(8) c if (n.ne.2) then trc_shft = c0 else trc_shft = smean end if c c Western boundary c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,toff+(n-1)*4,bufid) call pvmfunpack (nstflt,xvol,jmt*km,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c i = 1 do 130 k = 1, km do 130 j = 1, jmt ip = i + (j-1)*imt xip = j + (k-1)*jmt if (xvol(xip).ne.spvl) xt(ip,k,n) = xvol(xip)-trc_shft 130 continue c c Eastern boundary c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,toff+1+(n-1)*4,bufid) call pvmfunpack (nstflt,xvol,jmt*km,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c i = imt do 140 k = 1, km do 140 j = 1, jmt ip = i + (j-1)*imt xip = j + (k-1)*jmt if (xvol(xip).ne.spvl) xt(ip,k,n) = xvol(xip)-trc_shft 140 continue c c Southern boundary c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,toff+2+(n-1)*4,bufid) call pvmfunpack (nstflt,xvol,imt*km,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c j = 1 do 150 k = 1, km do 150 i = 1, imt ip = i + (j-1)*imt xip = i + (k-1)*imt if (xvol(xip).ne.spvl) xt(ip,k,n) = xvol(xip)-trc_shft 150 continue c c Northern boundary c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,toff+3+(n-1)*4,bufid) call pvmfunpack (nstflt,xvol,imt*km,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c j = jmtm1 do 160 k = 1, km do 160 i = 1, imt ip = i + (j-1)*imt xip = i + (k-1)*imt if (xvol(xip).ne.spvl) xt(ip,k,n) = xvol(xip)-trc_shft 160 continue c 170 continue c end if end if c c----------------------------------------------------------------------- c Receive ZTD boundary conditions from larger domain c----------------------------------------------------------------------- c if(itt.gt.nest_start)then if(mod(itt,itt_fac).eq.0)then #ifndef nestnultest c if (iopt(5).eq.1) write (stdout,920) c c Western boundary. c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,vrtbdw,bufid) call pvmfunpack (nstflt,xvol,jmt,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c do 180 j = 1, jmt if (xvol(j).ne.spvl) ztd(2,j) = xvol(j) 180 continue c c Eastern boundary. c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,vrtbde,bufid) call pvmfunpack (nstflt,xvol,jmt,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c do 190 j = 1, jmt if (xvol(j).ne.spvl) ztd(imtm1,j) = xvol(j) 190 continue c c Southern boundary. c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,vrtbds,bufid) call pvmfunpack (nstflt,xvol,imt,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c do 200 i = 1, imt if (xvol(i).ne.spvl) ztd(i,2) = xvol(i) 200 continue c c Northern boundary. c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call hopsrecv ('NEST_REC_BC',lrgtid,vrtbdn,bufid) call pvmfunpack (nstflt,xvol,imt,1,status) call nest_errchk ('NEST_REC_BC','UnPack',status,1,1,1) # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn1(1) = tsn1(1) + twk(1) tsn1(2) = tsn1(2) + twk(2) # endif c do 210 i = 1, imt if (xvol(i).ne.spvl) ztd(i,jmtm1) = xvol(i) 210 continue c #endif endif endif # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif #ifdef sunflush c c Flush output buffers. c call flush(stdout) #endif c return c 900 format ('NEST_REC_BC: receiving boundary transport') 910 format ('NEST_REC_BC: receiving bc for 3D fields') 920 format ('NEST_REC_BC: receiving bc for rate of change of ', & 'barotropic vorticity') c end