module m_ECOSM_micomsink contains !----------------------------------------------------- ! subroutine that, if given vertical distribution of: ! -variable ! -vertical velocity ! -thickness of layer ! calculates the sinking ! from Karen A. 26.05.06 !----------------------------------------------------- subroutine ECOSM_micomsink(n,timestep) use mod_xc use mod_necessary_ecovars implicit none include 'common_blocks.h' c include 'sedcom.h' include 'biovar.h' integer,intent(in) :: n real,intent(in) :: timestep real :: layer_thickn, layer_donor real :: srdia,srdet,srbg,sropa real,dimension (1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) & :: totaldia,totaldet,totalbg,totalopa #if defined (ECOCCO) real :: srcocc, srcaco3 real,dimension (1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) & :: totalcaco3,totalcocc #endif integer :: kdonor !KAL - Should use existing margin, points up to ii+margin should !KAL - still be valid at this point !margin=0 srdia=BioC(45) srdet=BioC(23) srbg=BioC(44) sropa=BioC(43) #if defined (ECOCCO) srcocc=BioC(52) srcaco3=BioC(52) #endif !--- CH: sinking velocities !--- surface layer k=1 do i=1-margin,ii+margin do j=1-margin,jj+margin layer_thickn=dp(i,j,k,n)/onem totaldia(i,j)=dot_product(bio(i,j,:,n,idia),dp(i,j,:,n)/onem) totaldet(i,j)=dot_product(bio(i,j,:,n,idet),dp(i,j,:,n)/onem) totalopa(i,j)=dot_product(bio(i,j,:,n,iopa),dp(i,j,:,n)/onem) if(depths(i,j).gt.0. .and. layer_thickn .gt.0.) then bio(i,j,k,n,idet)=(bio(i,j,k,n,idet)*layer_thickn)/ & (layer_thickn+srdet*timestep) bio(i,j,k,n,iopa)=(bio(i,j,k,n,iopa)*layer_thickn)/ & (layer_thickn+sropa*timestep) if(bio(i,j,k,n,idia).gt.0.1)then bio(i,j,k,n,idia)=(bio(i,j,k,n,idia)*layer_thickn)/ & (layer_thickn+srdia*timestep) endif #if defined (ECOCCO) if(bio(i,j,k,n,icocc).gt.0.1)then bio(i,j,k,n,icocc)=(bio(i,j,k,n,icocc)*layer_thickn)/ & (layer_thickn+srcocc*timestep) end if if(bio(i,j,k,n,icaco3).gt.0.1)then bio(i,j,k,n,icaco3)=(bio(i,j,k,n,icaco3)*layer_thickn)/ & (layer_thickn+srcaco3*timestep) end if #endif endif enddo enddo c !--- layer k=2..kdm c do j=1-margin,jj+margin do i=1-margin,ii+margin kdonor=1 do k=2,kdm layer_donor=dp(i,j,k-1,n)/onem layer_thickn=dp(i,j,k,n)/onem if(depths(i,j).gt.1.) then !AS fixing detritud 'falling through' the bottom) !AS if(layer_thickn .gt.0.) then if(k .lt.klist(i,j).and.layer_thickn .gt.0.) then bio(i,j,k,n,idet)=(bio(i,j,k,n,idet)*layer_thickn & +bio(i,j,kdonor,n,idet) & *min(layer_donor,srdet*timestep)) & /(layer_thickn+srdet*timestep) bio(i,j,k,n,iopa)=(bio(i,j,k,n,iopa)*layer_thickn & +bio(i,j,kdonor,n,iopa)* & *min(layer_donor,sropa*timestep)) & /(layer_thickn+sropa*timestep) if(bio(i,j,kdonor,n,idia).gt.0.1)then bio(i,j,k,n,idia)=(bio(i,j,k,n,idia)*layer_thickn & +bio(i,j,kdonor,n,idia) & *min(layer_donor,srdia*timestep)) & /(layer_thickn+srdia*timestep) endif #if defined (ECOCCO) if(bio(i,j,kdonor,n,icocc).gt.0.1)then bio(i,j,k,n,icocc)=(bio(i,j,k,n,icocc)*layer_thickn & +bio(i,j,kdonor,n,icocc) & *min(layer_donor,srcocc*timestep)) & /(layer_thickn+srcocc*timestep) endif if(bio(i,j,kdonor,n,icaco3).gt.0.1)then bio(i,j,k,n,icaco3)=(bio(i,j,k,n,icaco3)*layer_thickn & +bio(i,j,kdonor,n,icaco3) & *min(layer_donor,srcaco3*timestep)) & /(layer_thickn+srcaco3*timestep) endif #endif kdonor=k elseif (k==klist(i,j).and.layer_thickn .gt.0.) then bio(i,j,k,n,idet)=(totaldet(i,j)- & dot_product(bio(i,j,1:klist(i,j)-1,n,idet), & dp(i,j,1:klist(i,j)-1,n)/onem)) & /(layer_thickn+sum(dp(i,j,k+1:kdm,n)/onem)) c bio(i,j,k,n,iopa)=(totalopa(i,j)- & dot_product(bio(i,j,1:klist(i,j)-1,n,iopa), & dp(i,j,1:klist(i,j)-1,n)/onem)) & /(layer_thickn+sum(dp(i,j,k+1:kdm,n)/onem)) c if(bio(i,j,kdonor,n,idia).gt.0.1)then bio(i,j,k,n,idia)=(totaldia(i,j)- & dot_product(bio(i,j,1:klist(i,j)-1,n,idia), & dp(i,j,1:klist(i,j)-1,n)/onem)) & /(layer_thickn+sum(dp(i,j,k+1:kdm,n)/onem)) endif #if defined (ECOCCO) if(bio(i,j,kdonor,n,icocc).gt.0.1)then bio(i,j,k,n,icocc)=(totalcocc(i,j)- & dot_product(bio(i,j,1:klist(i,j)-1,n,icocc), & dp(i,j,1:klist(i,j)-1,n)/onem)) & /(layer_thickn+sum(dp(i,j,k+1:kdm,n)/onem)) endif if(bio(i,j,kdonor,n,icaco3).gt.0.1)then bio(i,j,k,n,icaco3)=(totalcaco3(i,j)- & dot_product(bio(i,j,1:klist(i,j)-1,n,icaco3), & dp(i,j,1:klist(i,j)-1,n)/onem)) & /(layer_thickn+sum(dp(i,j,k+1:kdm,n)/onem)) endif #endif kdonor=k layer_donor=layer_thickn else bio(i,j,k,n,idet)=bio(i,j,kdonor,n,idet) bio(i,j,k,n,iopa)=bio(i,j,kdonor,n,iopa) bio(i,j,k,n,idia)=bio(i,j,kdonor,n,idia) #if defined (ECOCCO) bio(i,j,k,n,icocc)=bio(i,j,kdonor,n,icocc) bio(i,j,k,n,icaco3)=bio(i,j,kdonor,n,icaco3) #endif endif endif enddo enddo enddo c CAGLAR c ---- this part is here just because cyanobacteria (bg) c are allowed to float. Use this only if srbg is lt 0.0 c Else, comment out the bg lines above and comment these k=kdm do i=1-margin,ii+margin do j=1-margin,jj+margin layer_thickn=dp(i,j,k,n)/onem if(depths(i,j).gt.0. .and. layer_thickn .gt.0.) then if(bio(i,j,k,n,ibg).gt.0.1)then bio(i,j,k,n,ibg)=(bio(i,j,k,n,ibg)*layer_thickn)/ & (layer_thickn+srbg*timestep) endif endif enddo enddo do j=1-margin,jj+margin do i=1-margin,ii+margin kdonor=kdm do k=kdm-1,1,-1 layer_thickn=dp(i,j,k,n)/onem if(depths(i,j).gt.1.) then if(layer_thickn .gt.0.) then if(bio(i,j,kdonor,n,ibg).gt.0.1)then bio(i,j,k,n,ibg)=(bio(i,j,k,n,ibg)*layer_thickn & +bio(i,j,kdonor,n,ibg)*srbg & *timestep) & /(layer_thickn+srbg*timestep) endif kdonor=k else bio(i,j,k,n,ibg)=bio(i,j,kdonor,n,ibg) endif endif enddo enddo enddo c ---- CAGLAR -------------------------------------------------- c --- in case of small concentrations, no sinking of diatoms and c --- flagellates c end subroutine ECOSM_micomsink end module m_ECOSM_micomsink