#if !defined usrdiagnostic | !defined nesttime subroutine nest_snd_bc (n_tim) #else subroutine nest_snd_bc (n_tim,tsn1,tsn2) #endif c c======================================================================= c === c This routine sends the boundary conditions to a smaller domain. === c === c ------ === c Input: === c ------ === c === c N_TIM Current time step. (integer) === c === c Common Blocks: === c === c /FIELDS/ === c === c P Transport stream function. (real array) === c ZTDB Preserved time change of vorticity. (real array) === #ifdef coast c /FULLWD/ === c === c LANDT Land/sea mask at tracer points. (integer array) === c LANDV Land/sea mask at velocity points. (integer array) === c === #endif c === c /IOUNITS/ === c === c STDOUT Unit number for standard output. (integer) === c === c /NEST/ === c === c I_LL_S Lower left corner of smaller grid in === c current grid. (integer) === c J_LL_S Lower left corner of current grid in === c larger grid. (integer) === c NXS Number of x-grid points in smaller grid. (integer) === c NYS Number of y-grid points in smaller grid. (integer) === c SMLTID PVM task identifier for smaller grid. (integer) === c === c /OPTIONS/ === c === c IOPT various switches from standard input: === c IOPT(5) "diagnostic" printing control: === c [0] Terse output. === c [1] Verbose output. === c IOPT(9) Number of tracers exchanged with smaller domain. === c === c /RHOMEAN/ === c === c SMEAN Mean salinity subtracted during === c computations. (real) === 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 === #if defined usrdiagnostic & defined nesttime c ------- === c Output: === c ------- === c === c TSN1 Time spent in communications. (real vector) === c TSN2 Time spent in auxillary calculations. (real vector) === c === #endif #ifndef coast c Calls: BESS2D, NEST_ERRCHK === #else c Calls: BESS2D_PMSK, NEST_ERRCHK === #endif c PVM Calls: PVMFINITSEND, PVMFPACK, PVMFSEND === c === c======================================================================= c c----------------------------------------------------------------------- c Define global data c----------------------------------------------------------------------- c #include #include #include #include #include #include #include #include #include #include #ifdef coast # include #endif c c----------------------------------------------------------------------- c Define local and equivalence data. c----------------------------------------------------------------------- c integer n_tim,toff #ifndef nestnultest * ,bufid,i_p,i_s,ip,j_s,j_p,k,n,status FLOAT * trc_shft,x,y # ifndef coast * ,bess2d # else * ,bess2d_msk,bess2d_pmsk # endif FLOAT * ,wk(nwds,km) #endif #if defined usrdiagnostic & defined nesttime FLOAT & tsn1(2),tsn2(2),twk(2) #endif logical first 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(9) + 1 first = .false. end if c c----------------------------------------------------------------------- #ifndef nest_ext2smlr c Send boundary conditions for transport streamfunction. #else c Send transport streamfunction (full field). #endif c----------------------------------------------------------------------- c if(n_tim.gt.nest_start)then #ifndef nestnultest # ifndef nest_ext2smlr c if (iopt(5).eq.1) write (stdout,900) c c Western boundary. c i_s=1 i_p = i_ll_s-1+i_s/3 x = FLoaT( mod(i_s,3) )*r3 do 10 j_s = 1, nys j_p = j_ll_s-1+j_s/3 y = FLoaT( mod(j_s,3) )*r3 #ifndef coast xvol(j_s) = bess2d (i_p,j_p,x,y,p,imt,jmt) #else xvol(j_s) = bess2d_pmsk (i_p,j_p,x,y,p,landp,imt,jmt,0, & ncseg,mclen,icoast,jcoast,spv) #endif 10 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nys,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,psibdw,status) call nest_errchk ('NEST_SND_BC','Send',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 c Eastern boundary. c i_s=nxs i_p = i_ll_s-1+i_s/3 x = FLoaT( mod(i_s,3) )*r3 do 20 j_s = 1, nys j_p = j_ll_s-1+j_s/3 y = FLoaT( mod(j_s,3) )*r3 #ifndef coast xvol(j_s) = bess2d (i_p,j_p,x,y,p,imt,jmt) #else xvol(j_s) = bess2d_pmsk (i_p,j_p,x,y,p,landp,imt,jmt,0, & ncseg,mclen,icoast,jcoast,spv) #endif 20 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nys,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,psibde,status) call nest_errchk ('NEST_SND_BC','Send',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 c Southern boundary. c j_s=1 j_p = j_ll_s-1+j_s/3 y = FLoaT( mod(j_s,3) )*r3 do 30 i_s = 1, nxs i_p = i_ll_s-1+i_s/3 x = FLoaT( mod(i_s,3) )*r3 #ifndef coast xvol(i_s) = bess2d (i_p,j_p,x,y,p,imt,jmt) #else xvol(i_s) = bess2d_pmsk (i_p,j_p,x,y,p,landp,imt,jmt,0, & ncseg,mclen,icoast,jcoast,spv) #endif 30 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nxs,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,psibds,status) call nest_errchk ('NEST_SND_BC','Send',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 c Northern boundary. c j_s=nys j_p = j_ll_s-1+j_s/3 y = FLoaT( mod(j_s,3) )*r3 do 40 i_s = 1, nxs i_p = i_ll_s-1+i_s/3 x = FLoaT( mod(i_s,3) )*r3 #ifndef coast xvol(i_s) = bess2d (i_p,j_p,x,y,p,imt,jmt) #else xvol(i_s) = bess2d_pmsk (i_p,j_p,x,y,p,landp,imt,jmt,0, & ncseg,mclen,icoast,jcoast,spv) #endif 40 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nxs,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,psibdn,status) call nest_errchk ('NEST_SND_BC','Send',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 # else c if (iopt(5).eq.1) write (stdout,900) c c Full field c do 10 j_s = 1, nys j_p = j_ll_s-1+j_s/3 y = FLoaT( mod(j_s,3) )*r3 do 10 i_s = 1, nxs ip = i_s+(j_s-1)*nxs i_p = i_ll_s-1+i_s/3 x = FLoaT( mod(i_s,3) )*r3 #ifndef coast xpal(ip) = bess2d (i_p,j_p,x,y,p,imt,jmt) #else xpal(ip) = bess2d_pmsk (i_p,j_p,x,y,p,landp,imt,jmt,0, & ncseg,mclen,icoast,jcoast,spv) #endif 10 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xpal,nxs*nys,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,psibdw,status) call nest_errchk ('NEST_SND_BC','Send',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 # endif #endif endif c c----------------------------------------------------------------------- c Send boundary conditions for 3D fields. c----------------------------------------------------------------------- c if (n_tim.gt.nest_start) then #ifndef nestnultest c if (iopt(5).eq.1) write (stdout,910) c c -- Internal mode zonal velocity. c c Scale by box thickness to ensure baroclinicity. c call scalvcln (xu,wk) c c Western boundary c i_s = 1 i_p = i_ll_s-2+(i_s+2)/3 x = FLoaT( mod(i_s+2,3) )*r3 do 50 k = 1, km do 50 j_s = 1, nys ip = j_s + (k-1)*nys j_p = j_ll_s-2+(j_s+2)/3 y = FLoaT( mod(j_s+2,3) )*r3 # ifndef coast xvol(ip) = bess2d (i_p,j_p,x,y,wk(1,k),imt,jmt) # else xvol(ip)= bess2d_msk (i_p,j_p,x,y,wk(1,k),landv,imt, * jmt,v_act,spv) # endif 50 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nys*km,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,ucbdyw,status) call nest_errchk ('NEST_SND_BC','Send',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 c Eastern boundary c i_s = nxs-1 i_p = i_ll_s-2+(i_s+2)/3 x = FLoaT( mod(i_s+2,3) )*r3 do 60 k = 1, km do 60 j_s = 1, nys ip = j_s + (k-1)*nys j_p = j_ll_s-2+(j_s+2)/3 y = FLoaT( mod(j_s+2,3) )*r3 # ifndef coast xvol(ip) = bess2d (i_p,j_p,x,y,wk(1,k),imt,jmt) # else xvol(ip)= bess2d_msk (i_p,j_p,x,y,wk(1,k),landv,imt, * jmt,v_act,spv) # endif 60 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nys*km,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,ucbdye,status) call nest_errchk ('NEST_SND_BC','Send',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 c Southern boundary c j_s = 1 j_p = j_ll_s-2+(j_s+2)/3 y = FLoaT( mod(j_s+2,3) )*r3 do 70 k = 1, km do 70 i_s = 1, nxs ip = i_s + (k-1)*nxs i_p = i_ll_s-2+(i_s+2)/3 x = FLoaT( mod(i_s+2,3) )*r3 # ifndef coast xvol(ip) = bess2d (i_p,j_p,x,y,wk(1,k),imt,jmt) # else xvol(ip)= bess2d_msk (i_p,j_p,x,y,wk(1,k),landv,imt, * jmt,v_act,spv) # endif 70 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nxs*km,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,ucbdys,status) call nest_errchk ('NEST_SND_BC','Send',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 c Northern boundary c j_s = nys-1 j_p = j_ll_s-2+(j_s+2)/3 y = FLoaT( mod(j_s+2,3) )*r3 do 80 k = 1, km do 80 i_s = 1, nxs ip = i_s + (k-1)*nxs i_p = i_ll_s-2+(i_s+2)/3 x = FLoaT( mod(i_s+2,3) )*r3 # ifndef coast xvol(ip) = bess2d (i_p,j_p,x,y,wk(1,k),imt,jmt) # else xvol(ip)= bess2d_msk (i_p,j_p,x,y,wk(1,k),landv,imt, * jmt,v_act,spv) # endif 80 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nxs*km,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,ucbdyn,status) call nest_errchk ('NEST_SND_BC','Send',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 c -- Internal mode meridional velocity. c c Scale by box thickness to ensure baroclinicity. c call scalvcln (xv,wk) c c Western boundary c i_s = 1 i_p = i_ll_s-2+(i_s+2)/3 x = FLoaT( mod(i_s+2,3) )*r3 do 90 k = 1, km do 90 j_s = 1, nys ip = j_s + (k-1)*nys j_p = j_ll_s-2+(j_s+2)/3 y = FLoaT( mod(j_s+2,3) )*r3 # ifndef coast xvol(ip) = bess2d (i_p,j_p,x,y,wk(1,k),imt,jmt) # else xvol(ip)= bess2d_msk (i_p,j_p,x,y,wk(1,k),landv,imt, * jmt,v_act,spv) # endif 90 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nys*km,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,vcbdyw,status) call nest_errchk ('NEST_SND_BC','Send',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 c Eastern boundary c i_s = nxs-1 i_p = i_ll_s-2+(i_s+2)/3 x = FLoaT( mod(i_s+2,3) )*r3 do 100 k = 1, km do 100 j_s = 1, nys ip = j_s + (k-1)*nys j_p = j_ll_s-2+(j_s+2)/3 y = FLoaT( mod(j_s+2,3) )*r3 # ifndef coast xvol(ip) = bess2d (i_p,j_p,x,y,wk(1,k),imt,jmt) # else xvol(ip)= bess2d_msk (i_p,j_p,x,y,wk(1,k),landv,imt, * jmt,v_act,spv) # endif 100 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nys*km,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,vcbdye,status) call nest_errchk ('NEST_SND_BC','Send',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 c Southern boundary c j_s = 1 j_p = j_ll_s-2+(j_s+2)/3 y = FLoaT( mod(j_s+2,3) )*r3 do 110 k = 1, km do 110 i_s = 1, nxs ip = i_s + (k-1)*nxs i_p = i_ll_s-2+(i_s+2)/3 x = FLoaT( mod(i_s+2,3) )*r3 # ifndef coast xvol(ip) = bess2d (i_p,j_p,x,y,wk(1,k),imt,jmt) # else xvol(ip)= bess2d_msk (i_p,j_p,x,y,wk(1,k),landv,imt, * jmt,v_act,spv) # endif 110 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nxs*km,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,vcbdys,status) call nest_errchk ('NEST_SND_BC','Send',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 c Northern boundary c j_s = nys-1 j_p = j_ll_s-2+(j_s+2)/3 y = FLoaT( mod(j_s+2,3) )*r3 do 120 k = 1, km do 120 i_s = 1, nxs ip = i_s + (k-1)*nxs i_p = i_ll_s-2+(i_s+2)/3 x = FLoaT( mod(i_s+2,3) )*r3 # ifndef coast xvol(ip) = bess2d (i_p,j_p,x,y,wk(1,k),imt,jmt) # else xvol(ip)= bess2d_msk (i_p,j_p,x,y,wk(1,k),landv,imt, * jmt,v_act,spv) # endif 120 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nxs*km,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,vcbdyn,status) call nest_errchk ('NEST_SND_BC','Send',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 c -- Tracers. c do 170 n = 1,iopt(9) c if (n.ne.2) then trc_shft = c0 else trc_shft = smean end if c c Western boundary c i_s = 1 i_p = i_ll_s-1+i_s/3 x = FLoaT( mod(i_s,3) )*r3 do 130 k = 1, km do 130 j_s = 1, nys ip = j_s + (k-1)*nys j_p = j_ll_s-1+j_s/3 y = FLoaT( mod(j_s,3) )*r3 # ifndef coast xvol(ip) =bess2d (i_p,j_p,x,y,xt(1,k,n),imt,jmt) * +trc_shft # else xvol(ip) =bess2d_msk (i_p,j_p,x,y,xt(1,k,n),landt,imt, * jmt,t_act,spv) if (xvol(ip).ne.spv) xvol(ip) = xvol(ip) + trc_shft # endif 130 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nys*km,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,toff+(n-1)*4,status) call nest_errchk ('NEST_SND_BC','Send',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 c Eastern boundary c i_s = nxs i_p = i_ll_s-1+i_s/3 x = FLoaT( mod(i_s,3) )*r3 do 140 k = 1, km do 140 j_s = 1, nys ip = j_s + (k-1)*nys j_p = j_ll_s-1+j_s/3 y = FLoaT( mod(j_s,3) )*r3 # ifndef coast xvol(ip) =bess2d (i_p,j_p,x,y,xt(1,k,n),imt,jmt) * +trc_shft # else xvol(ip) = bess2d_msk (i_p,j_p,x,y,xt(1,k,n),landt,imt, * jmt,t_act,spv) if (xvol(ip).ne.spv) xvol(ip) = xvol(ip) + trc_shft # endif 140 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nys*km,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,toff+1+(n-1)*4,status) call nest_errchk ('NEST_SND_BC','Send',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 c Southern boundary c j_s = 1 j_p = j_ll_s-1+j_s/3 y = FLoaT( mod(j_s,3) )*r3 do 150 k = 1, km do 150 i_s = 1, nxs ip = i_s + (k-1)*nxs i_p = i_ll_s-1+i_s/3 x = FLoaT( mod(i_s,3) )*r3 # ifndef coast xvol(ip) = bess2d (i_p,j_p,x,y,xt(1,k,n),imt,jmt) * +trc_shft # else xvol(ip) = bess2d_msk (i_p,j_p,x,y,xt(1,k,n),landt,imt, * jmt,t_act,spv) if (xvol(ip).ne.spv) xvol(ip) = xvol(ip) + trc_shft # endif 150 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nxs*km,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,toff+2+(n-1)*4,status) call nest_errchk ('NEST_SND_BC','Send',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 c Northern boundary c j_s = nys-1 j_p = j_ll_s-1+j_s/3 y = FLoaT( mod(j_s,3) )*r3 do 160 k = 1, km do 160 i_s = 1, nxs ip = i_s + (k-1)*nxs i_p = i_ll_s-1+i_s/3 x = FLoaT( mod(i_s,3) )*r3 # ifndef coast xvol(ip)=bess2d(i_p,j_p,x,y,xt(1,k,n),imt,jmt) * +trc_shft # else xvol(ip) = bess2d_msk (i_p,j_p,x,y,xt(1,k,n),landt,imt, * jmt,t_act,spv) if (xvol(ip).ne.spv) xvol(ip) = xvol(ip) + trc_shft # endif 160 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nxs*km,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,toff+3+(n-1)*4,status) call nest_errchk ('NEST_SND_BC','Send',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 170 continue c #endif end if c c----------------------------------------------------------------------- c Send ZTD boundary conditions to smaller domain. Looking in variable c ZTDB since relax modified ZTD but saved a copy in ZTDB. c----------------------------------------------------------------------- c if (n_tim.gt.nest_start) then if(mod(n_tim,itt_fac).eq.0)then #ifndef nestnultest c if (iopt(5).eq.1) write (stdout,920) c c Western boundary of smaller domain. c i_s = 2 i_p = i_ll_s-1+i_s/3 x = FLoaT( mod(i_s,3) )*r3 do 180 j_s = 1, nys j_p = j_ll_s-1+j_s/3 y = FLoaT( mod(j_s,3) )*r3 # ifndef coast xvol(j_s) = bess2d (i_p,j_p,x,y,ztdb,imt,jmt) # else xvol(j_s) = bess2d_msk (i_p,j_p,x,y,ztdb,landt,imt,jmt, & t_act,spv) # endif 180 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nys,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,vrtbdw,status) call nest_errchk ('NEST_SND_BC','Send',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 c Eastern boundary of smaller domain. c i_s = nxs-1 i_p = i_ll_s-1+i_s/3 x = FLoaT( mod(i_s,3) )*r3 do 190 j_s = 1, nys j_p = j_ll_s-1+j_s/3 y = FLoaT( mod(j_s,3) )*r3 # ifndef coast xvol(j_s) = bess2d (i_p,j_p,x,y,ztdb,imt,jmt) # else xvol(j_s) = bess2d_msk (i_p,j_p,x,y,ztdb,landt,imt,jmt, & t_act,spv) # endif 190 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nys,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,vrtbde,status) call nest_errchk ('NEST_SND_BC','Send',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 c Southern boundary of smaller domain. c j_s = 2 j_p = j_ll_s-1+j_s/3 y = FLoaT( mod(j_s,3) )*r3 do 200 i_s = 1, nxs i_p = i_ll_s-1+i_s/3 x = FLoaT( mod(i_s,3) )*r3 # ifndef coast xvol(i_s) = bess2d (i_p,j_p,x,y,ztdb,imt,jmt) # else xvol(i_s) = bess2d_msk (i_p,j_p,x,y,ztdb,landt,imt,jmt, & t_act,spv) # endif 200 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nxs,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,vrtbds,status) call nest_errchk ('NEST_SND_BC','Send',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 c Northern boundary of smaller domain. c j_s = nys-1 j_p = j_ll_s-1+j_s/3 y = FLoaT( mod(j_s,3) )*r3 do 210 i_s = 1, nxs i_p = i_ll_s-1+i_s/3 x = FLoaT( mod(i_s,3) )*r3 # ifndef coast xvol(i_s) = bess2d (i_p,j_p,x,y,ztdb,imt,jmt) # else xvol(i_s) = bess2d_msk (i_p,j_p,x,y,ztdb,landt,imt,jmt, & t_act,spv) # endif 210 continue c # if defined usrdiagnostic & defined nesttime call dtime (twk) tsn2(1) = tsn2(1) + twk(1) tsn2(2) = tsn2(2) + twk(2) # endif call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_SND_BC','InitSend',bufid,1,1,1) call pvmfpack (nstflt,xvol,nxs,1,status) call nest_errchk ('NEST_SND_BC','Pack',status,1,1,1) call pvmfsend (smltid,vrtbdn,status) call nest_errchk ('NEST_SND_BC','Send',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 #endif endif endif #ifdef sunflush c c Flush output buffers. c call flush(stdout) #endif c return c #ifndef nest_ext2smlr 900 format ('NEST_SND_BC: sending boundary transport') #else 900 format ('NEST_SND_BC: sending transport') #endif 910 format ('NEST_SND_BC: sending bc for 3D fields') 920 format ('NEST_SND_BC: sending bc for rate of change of ', & 'barotropic vorticity') c end