! source file: /Users/jfidler/work/UVic_ESCM/2.9/source/mom/convect.F subroutine convct (ts, ncon, joff, js, je, istrt, iend, kmt) implicit none integer is, ie, nn, ncon, ks, js, je, j, jrow, joff, i, k, n integer iend, istrt real dense include "size.h" include "param.h" include "pconst.h" include "stdunits.h" include "accel.h" integer kmt(imt,jmt) parameter (is=2, ie=imt-1) real ts(imt,km,1:jmw,nt), temp(imt,km,jsmw:jmw) !----------------------------------------------------------------------- ! standard explicit convection scheme ! convectively adjust water column if gravitationally unstable ! inputs: ! ncon = number of passes through convection routine ! joff = offset between "j" in MW and "jrow" latitude on disk ! js = starting row in MW ! je = ending row in MW ! is = starting longitude index ! ie = ending longitude index ! Note: istrt,iend are currently bypassed. instead, is and ie are ! set as parameters to optimize performance ! kmt = number of ocean "t" boxes in the vertical ! ts = temperature and salinity before convection ! outputs: ! ts = tracers after convection !----------------------------------------------------------------------- ! ks=1: compare lev. 1 to 2; 3 to 4; etc. ! ks=2: compare lev. 2 to 3; 4 to 5; etc. do nn=1,ncon do ks=1,2 ! find density for rows call statec (ts(1,1,1,1), ts(1,1,1,2), temp(1,1,jsmw) &, max(js,jsmw), je, is, ie, ks) ! set "heavy water" in land to stop convection dense = 1.e15 do j=js,je jrow = j + joff do i=is,ie k = kmt(i,jrow) + 1 if (k .le. km) then temp(i,k,j) = dense endif enddo enddo ! if unstable, mix tracers on adjoining levels do n=1,nt do j=js,je do k=ks,kmm1,2 do i=is,ie if (temp(i,k,j) .gt. temp(i,k+1,j)) then ts(i,k,j,n) = (dztxcl(k)*ts(i,k,j,n) + & dztxcl(k+1)*ts(i,k+1,j,n))*dzwxcl(k) ts(i,k+1,j,n) = ts(i,k,j,n) endif enddo enddo enddo enddo enddo enddo do n=1,nt do j=js,je call setbcx (ts(1,1,j,n), imt, km) enddo enddo return end subroutine convct2 (ts, joff, js, je, is, ie, kmt) !======================================================================= ! The following convection scheme is an alternative to the standard ! scheme. In contrast to the standard scheme, it totally removes ! all gravitational instability in the water column. It does that ! in one pass, so the parameter ncon becomes irrelevant if this ! option is selected. Since most convection propagates downward the ! scheme looks downward first and follows any instability (upward or ! downward) before checking the other direction. The routine mixes ! passive tracers only after the entire instability is found. The ! scheme is similar to that used by Rahmstorf (jgr 96,6951-6963) and ! by Marotzke (jpo 21,903-907). It is discussed in a note to Ocean ! Modelling (101). It uses as much cpu time as 1-3 passes of the ! standard scheme, depending on the amount of static instability ! found in the model, and is much faster than using "implicitvmix". ! inputs: ! joff = offset between "j" in MW and "jrow" latitude on disk ! js = starting row in MW ! je = ending row in MW ! is = starting longitude index ! ie = ending longitude index ! kmt = number of ocean "t" boxes in the vertical ! ts = tracers before convection ! outputs: ! ts = tracers after convection ! other previously undefined variables: ! chk_la = logical flag to check level above kt ! chk_lb = logical flag to check level below kb ! kb = bottom level of (potential) instability ! kbo = bottom level of ocean ! kt = top level of (potential) instability ! ktot = total number of levels convecting in the column ! kven = number of levels that ventilated in the column ! la = test level above kt ! lb = test level below kb ! rl = lower level density referenced to lower level ! ru = upper level density referenced to lower level ! tmx = mixed tracer (1=temp, 2=salt, 3=other) ! tsm = sum of tracers (weighted by thickness) in the instability ! zsm = total thickness of the instability !======================================================================= implicit none integer i, ie, is, j, je, joff, jrow, js, k, kb, kbo integer kt, ktot, kven, la, lb, n logical chk_la, chk_lb real rl, ru, tmx(3), tsm(3), zsm, dens, tq, sq, drodt, drods real drhodt, drhods, ddensdtdt, ddensdtds, ddensdsds include "size.h" include "param.h" include "pconst.h" include "stdunits.h" include "accel.h" include "coord.h" include "scalar.h" include "switch.h" include "diaga.h" include "state.h" include "dens.h" integer kmt(imt,jmt) real ts(imt,km,1:jmw,nt) do j=js,je jrow = j + joff do i=is,ie ! ktot = 0 kbo = kmt(i,jrow) if (timavgperts) then totalk(i,j) = 0.0 vdepth(i,j) = 0.0 pe(i,j) = 0.0 do k=1,km ru = dens (ts(i,k,j,1)-to(k), ts(i,k,j,2)-so(k), k) pe(i,j) = pe(i,j) + grav*zt(k)*ru*dztxcl(k) enddo endif ! search for unstable regions starting from the top kt = 1 kb = 2 do while (kt .lt. kbo) ru = dens (ts(i,kt,j,1)-to(kb), ts(i,kt,j,2)-so(kb), kb) rl = dens (ts(i,kb,j,1)-to(kb), ts(i,kb,j,2)-so(kb), kb) ! sum the first pair found in an unstable region if (ru .gt. rl) then chk_la = .true. chk_lb = .true. zsm = dztxcl(kt) + dztxcl(kb) tsm(1) = ts(i,kt,j,1)*dztxcl(kt) + ts(i,kb,j,1)*dztxcl(kb) tmx(1) = tsm(1)/zsm tsm(2) = ts(i,kt,j,2)*dztxcl(kt) + ts(i,kb,j,2)*dztxcl(kb) tmx(2) = tsm(2)/zsm do while (chk_lb .or. chk_la) ! check for an unstable level (lb) below kb if (kb .ge. kbo) chk_lb = .false. do while (chk_lb) chk_lb = .false. lb = kb + 1 ru = dens (tmx(1)-to(lb), tmx(2)-so(lb), lb) rl = dens (ts(i,lb,j,1)-to(lb),ts(i,lb,j,2)-so(lb),lb) if (ru .gt. rl) then ! add new level to sums kb = lb zsm = zsm + dztxcl(kb) tsm(1) = tsm(1) + ts(i,kb,j,1)*dztxcl(kb) tmx(1) = tsm(1)/zsm tsm(2) = tsm(2) + ts(i,kb,j,2)*dztxcl(kb) tmx(2) = tsm(2)/zsm chk_la = .true. if (kb .lt. kbo) chk_lb = .true. endif enddo ! check for an unstable level (la) above kt ! to get the equivalent of Rahmstorf's scheme uncomment the next line chk_la = .true. if (kt .le. 1) chk_la = .false. do while (chk_la) chk_la = .false. la = kt - 1 ru = dens (ts(i,la,j,1)-to(kt),ts(i,la,j,2)-so(kt),kt) rl = dens (tmx(1)-to(kt), tmx(2)-so(kt), kt) if (ru .gt. rl) then ! add new level to sums kt = la zsm = zsm + dztxcl(kt) tsm(1) = tsm(1) + ts(i,kt,j,1)*dztxcl(kt) tmx(1) = tsm(1)/zsm tsm(2) = tsm(2) + ts(i,kt,j,2)*dztxcl(kt) tmx(2) = tsm(2)/zsm chk_lb = .true. ! to get the equivalent of Rahmstorf's scheme comment out the next line ! if (kt .gt. 1) chk_la = .true. endif enddo enddo ! mix all tracers from kt to kb do k=kt,kb ts(i,k,j,1) = tmx(1) ts(i,k,j,2) = tmx(2) enddo do n=3,nt tsm(3) = c0 do k=kt,kb tsm(3) = tsm(3) + ts(i,k,j,n)*dztxcl(k) enddo tmx(3) = tsm(3)/zsm do k=kt,kb ts(i,k,j,n) = tmx(3) enddo enddo ! some possible diagnostics ! ktot = ktot + kb - kt + 1 ! if (kt .eq. 1) kven = kb ! finished this region, save convection diagnostics if (timavgperts) then totalk(i,j) = totalk(i,j) + float(kb - kt + 1) if (kt .eq. 1) vdepth(i,j) = zw(kb) endif kt = kb + 1 else kt = kb endif ! continue the search for other unstable regions kb = kt + 1 enddo if (timavgperts) then do k=1,km ru = dens (ts(i,k,j,1)-to(k), ts(i,k,j,2)-so(k), k) pe(i,j) = pe(i,j) - grav*zt(k)*ru*dztxcl(k) enddo pe(i,j) = pe(i,j)/c2dtts endif enddo enddo return end