--- MITgcm/pkg/ctrl/ctrl_getobcsw.F 2002/02/05 20:23:58 1.1.2.1 +++ MITgcm/pkg/ctrl/ctrl_getobcsw.F 2011/03/14 17:08:00 1.11 @@ -1,3 +1,5 @@ +C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/ctrl/ctrl_getobcsw.F,v 1.11 2011/03/14 17:08:00 mlosch Exp $ +C $Name: $ #include "CTRL_CPPOPTIONS.h" #ifdef ALLOW_OBCS @@ -15,11 +17,12 @@ c SUBROUTINE ctrl_getobcsw c ================================================================== c -c o Get norhtern obc of the control vector and add it +c o Get western obc of the control vector and add it c to dyn. fields c c started: heimbach@mit.edu, 29-Aug-2001 c +c modified: gebbie@mit.edu, 18-Mar-2003 c ================================================================== c SUBROUTINE ctrl_getobcsw c ================================================================== @@ -56,6 +59,7 @@ integer imin,imax integer ilobcsw integer iobcs + integer ip1 _RL dummy _RL obcswfac @@ -64,14 +68,18 @@ integer obcswcount0 integer obcswcount1 - _RL maskyz (1-oly:sny+oly,nr,nsx,nsy) +cgg _RL maskyz (1-oly:sny+oly,nr,nsx,nsy) + _RL tmpfldyz (1-oly:sny+oly,nr,nsx,nsy) logical doglobalread logical ladinit character*(80) fnameobcsw - +cgg( Variables for splitting barotropic/baroclinic vels. + _RL ubaro + _RL utop +cgg) c == external functions == @@ -89,100 +97,116 @@ jmax = sny+oly imin = 1-olx imax = snx+olx + ip1 = 1 + +cgg( Initialize variables for balancing volume flux. + ubaro = 0.d0 + utop = 0.d0 +cgg) c-- Now, read the control vector. doglobalread = .false. ladinit = .false. if (optimcycle .ge. 0) then - ilobcsw=ilnblnk( xx_obcsw_file ) - write(fnameobcsw(1:80),'(2a,i10.10)') - & xx_obcsw_file(1:ilobcsw), '.', optimcycle - else - print* - print*,' ctrl_getobcsw: optimcycle not set correctly.' - print*,' ... stopped in ctrl_getobcsw.' + ilobcsw=ilnblnk( xx_obcsw_file ) + write(fnameobcsw(1:80),'(2a,i10.10)') + & xx_obcsw_file(1:ilobcsw), '.', optimcycle endif c-- Get the counters, flags, and the interpolation factor. - call ctrl_GetRec( 'xx_obcsw', + call ctrl_get_gen_rec( + I xx_obcswstartdate, xx_obcswperiod, O obcswfac, obcswfirst, obcswchanged, O obcswcount0,obcswcount1, I mytime, myiter, mythid ) do iobcs = 1,nobcs - - call active_read_yz( 'maskobcsw', maskyz, - & iobcs, - & doglobalread, ladinit, 0, - & mythid, dummy ) - - call active_read_yz( fnameobcsw, tmpfldyz, + if ( obcswfirst ) then + call active_read_yz( fnameobcsw, tmpfldyz, & (obcswcount0-1)*nobcs+iobcs, & doglobalread, ladinit, optimcycle, & mythid, xx_obcsw_dummy ) do bj = jtlo,jthi - do bi = itlo,ithi - do k = 1,nr - do j = jmin,jmax - yz_obcs0(j,k,bi,bj) = tmpfldyz (j,k,bi,bj) - enddo - enddo + do bi = itlo,ithi + do k = 1,nr + do j = jmin,jmax + xx_obcsw1(j,k,bi,bj,iobcs) = tmpfldyz (j,k,bi,bj) +cgg & * maskyz (j,k,bi,bj) + enddo enddo + enddo enddo + endif - call active_read_yz( fnameobcsw, tmpfldyz, - & (obcswcount1-1)*nobcs+iobcs, - & doglobalread, ladinit, optimcycle, - & mythid, xx_obcsw_dummy ) + if ( (obcswfirst) .or. (obcswchanged)) then do bj = jtlo,jthi - do bi = itlo,ithi - do k = 1,nr - do j = jmin,jmax - yz_obcs1 (j,k,bi,bj) = tmpfldyz (j,k,bi,bj) - enddo - enddo + do bi = itlo,ithi + do k = 1,nr + do j = jmin,jmax + xx_obcsw0(j,k,bi,bj,iobcs) = xx_obcsw1(j,k,bi,bj,iobcs) + tmpfldyz (j,k,bi,bj) = 0. _d 0 + enddo enddo + enddo enddo -c-- Add control to model variable. + call active_read_yz( fnameobcsw, tmpfldyz, + & (obcswcount1-1)*nobcs+iobcs, + & doglobalread, ladinit, optimcycle, + & mythid, xx_obcsw_dummy ) + do bj = jtlo,jthi - do bi = itlo,ithi -c-- Calculate mask for tracer cells (0 => land, 1 => water). - do k = 1,nr - do j = 1,sny - if (iobcs .EQ. 1) then - OBWt(j,k,bi,bj) = OBWt (j,k,bi,bj) - & + obcswfac *yz_obcs0(j,k,bi,bj) - & + (1. _d 0 - obcswfac)*yz_obcs1(j,k,bi,bj) - OBWt(j,k,bi,bj) = OBWt(j,k,bi,bj) - & *maskyz(j,k,bi,bj) - else if (iobcs .EQ. 2) then - OBWs(j,k,bi,bj) = OBWs (j,k,bi,bj) - & + obcswfac *yz_obcs0(j,k,bi,bj) - & + (1. _d 0 - obcswfac)*yz_obcs1(j,k,bi,bj) - OBWs(j,k,bi,bj) = OBWs(j,k,bi,bj) - & *maskyz(j,k,bi,bj) - else if (iobcs .EQ. 3) then - OBWu(j,k,bi,bj) = OBWu (j,k,bi,bj) - & + obcswfac *yz_obcs0(j,k,bi,bj) - & + (1. _d 0 - obcswfac)*yz_obcs1(j,k,bi,bj) - OBWu(j,k,bi,bj) = OBWu(j,k,bi,bj) - & *maskyz(j,k,bi,bj) - else if (iobcs .EQ. 4) then - OBWv(j,k,bi,bj) = OBWv (j,k,bi,bj) - & + obcswfac *yz_obcs0(j,k,bi,bj) - & + (1. _d 0 - obcswfac)*yz_obcs1(j,k,bi,bj) - OBWv(j,k,bi,bj) = OBWv(j,k,bi,bj) - & *maskyz(j,k,bi,bj) - endif - enddo - enddo + do bi = itlo,ithi + do k = 1,nr + do j = jmin,jmax + xx_obcsw1 (j,k,bi,bj,iobcs) = tmpfldyz (j,k,bi,bj) +cgg & * maskyz (j,k,bi,bj) enddo + enddo + enddo enddo + endif +c-- Add control to model variable. + do bj = jtlo, jthi + do bi = itlo, ithi +c-- Calculate mask for tracer cells (0 => land, 1 => water). + do k = 1,nr + do j = 1,sny + i = OB_Iw(j,bi,bj) + if (iobcs .EQ. 1) then + OBWt(j,k,bi,bj) = OBWt (j,k,bi,bj) + & + obcswfac *xx_obcsw0(j,k,bi,bj,iobcs) + & + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs) + OBWt(j,k,bi,bj) = OBWt(j,k,bi,bj) + & *maskW(i+ip1,j,k,bi,bj) + else if (iobcs .EQ. 2) then + OBWs(j,k,bi,bj) = OBWs (j,k,bi,bj) + & + obcswfac *xx_obcsw0(j,k,bi,bj,iobcs) + & + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs) + OBWs(j,k,bi,bj) = OBWs(j,k,bi,bj) + & *maskW(i+ip1,j,k,bi,bj) + else if (iobcs .EQ. 3) then + OBWu(j,k,bi,bj) = OBWu (j,k,bi,bj) + & + obcswfac *xx_obcsw0(j,k,bi,bj,iobcs) + & + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs) + OBWu(j,k,bi,bj) = OBWu(j,k,bi,bj) + & *maskW(i+ip1,j,k,bi,bj) + else if (iobcs .EQ. 4) then + OBWv(j,k,bi,bj) = OBWv (j,k,bi,bj) + & + obcswfac *xx_obcsw0(j,k,bi,bj,iobcs) + & + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs) + OBWv(j,k,bi,bj) = OBWv(j,k,bi,bj) + & *maskS(i,j,k,bi,bj) + endif + enddo + enddo + enddo + enddo + C-- End over iobcs loop enddo