Changeset 37 for branches/petra/src/wetdepokernel.f90

Timestamp:

Apr 22, 2015, 3:42:35 PM (9 years ago)

Author:

pesei

Message:

Wet dep quick fix and other small changes. Wet depo quick fix not final yet.

File:

• branches/petra/src/wetdepokernel.f90 (modified) (4 diffs)

branches/petra/src/wetdepokernel.f90

@@ -1 +1 @@
 !**********************************************************************
-! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
+! Copyright 1998-2015                                                 *
 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
@@ -20 +20 @@
 !**********************************************************************
 
-subroutine wetdepokernel(nunc,deposit,x,y,nage,kp)
-  !                          i      i    i i  i
+subroutine wetdepokernel(nunc,deposit,x,y,itage,nage,kp)
+  !                          i      i    i  i    i   i
   !*****************************************************************************
   !                                                                            *
   !     Attribution of the deposition from an individual particle to the       *
-  !     deposition fields using a uniform kernel with bandwidths dxout and dyout.*
+  !     deposition fields using a uniform kernel with bandwidths dxout         *
+  !     and dyout.                                                             *
   !                                                                            *
   !     Author: A. Stohl                                                       *
   !                                                                            *
   !     26 December 1996                                                       *
+  !
+  !  PS, 2/2015: do not use kernel for itage < 3 h
+  !   same as for concentration in conccalc.f90
   !                                                                            *
   !*****************************************************************************
@@ -48 +52 @@
 
   real :: x,y,deposit(maxspec),ddx,ddy,xl,yl,wx,wy,w
-  integer :: ix,jy,ixp,jyp,nunc,nage,ks,kp
+  integer :: ix,jy,ixp,jyp,nunc,nage,ks,kp,itage
 
   xl=(x*dx+xoutshift)/dxout
@@ -74 +78 @@
 
 
-  ! Determine mass fractions for four grid points
-  !**********************************************
+  if (itage .lt. itagekernmin) then 
+    ! no kernel, direct attribution to grid cell
+    
+    do ks=1,nspec
+      if (ix.ge.0 .and. jy.ge.0 .and. &
+          ix.le.numxgrid-1 .and. jy.le.numygrid-1) &
+        wetgridunc(ix,jy,ks,kp,nunc,nage)= &
+          wetgridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)
+    enddo
+        
+  else
+    ! Determine mass fractions for four grid points & distribute
 
-  do ks=1,nspec
+    do ks=1,nspec
 
-  if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
-       (jy.le.numygrid-1)) then
-    w=wx*wy
-      wetgridunc(ix,jy,ks,kp,nunc,nage)= &
-           wetgridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
+      if (ix.ge.0 .and. jy.ge.0 .and. &
+          ix.le.numxgrid-1 .and. jy.le.numygrid-1) then
+        w=wx*wy
+        wetgridunc(ix,jy,ks,kp,nunc,nage)= &
+          wetgridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
+      endif
+
+      if ((ixp.ge.0).and.(jyp.ge.0).and.&
+         (ixp.le.numxgrid-1).and. (jyp.le.numygrid-1)) then
+        w=(1.-wx)*(1.-wy)
+        wetgridunc(ixp,jyp,ks,kp,nunc,nage)= &
+          wetgridunc(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+      endif
+
+      if ((ixp.ge.0).and.(jy.ge.0).and. &
+          (ixp.le.numxgrid-1).and.(jy.le.numygrid-1)) then
+        w=(1.-wx)*wy
+        wetgridunc(ixp,jy,ks,kp,nunc,nage)= &
+           wetgridunc(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
+      endif
+
+      if ((ix.ge.0).and.(jyp.ge.0).and. &
+          (ix.le.numxgrid-1).and.(jyp.le.numygrid-1)) then
+        w=wx*(1.-wy)
+        wetgridunc(ix,jyp,ks,kp,nunc,nage)= &
+          wetgridunc(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+      endif
+
+    end do
+
   endif
 
-  if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgrid-1).and. &
-       (jyp.le.numygrid-1)) then
-    w=(1.-wx)*(1.-wy)
-      wetgridunc(ixp,jyp,ks,kp,nunc,nage)= &
-           wetgridunc(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
-  endif
-
-  if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgrid-1).and. &
-       (jy.le.numygrid-1)) then
-    w=(1.-wx)*wy
-      wetgridunc(ixp,jy,ks,kp,nunc,nage)= &
-           wetgridunc(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
-  endif
-
-  if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgrid-1).and. &
-       (jyp.le.numygrid-1)) then
-    w=wx*(1.-wy)
-      wetgridunc(ix,jyp,ks,kp,nunc,nage)= &
-           wetgridunc(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
-  endif
-  end do
-
 end subroutine wetdepokernel