Changeset 37 for branches/petra/src/verttransform.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/verttransform.f90 (modified) (5 diffs)

branches/petra/src/verttransform.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   *
@@ -50 +50 @@
   ! added the variable cloud for use with scavenging - descr. in com_mod
   !*****************************************************************************
+  ! Petra Seibert, Feb 2015: Add quick fix from 2013 
+  !*****************************************************************************
   !                                                                            *
   ! Variables:                                                                 *
   ! nx,ny,nz                        field dimensions in x,y and z direction    *
-  ! clouds(0:nxmax,0:nymax,0:nzmax,2) cloud field for wet deposition           *
   ! uu(0:nxmax,0:nymax,nzmax,2)     wind components in x-direction [m/s]       *
   ! vv(0:nxmax,0:nymax,nzmax,2)     wind components in y-direction [m/s]       *
@@ -69 +70 @@
   implicit none
 
-  integer :: ix,jy,kz,iz,n,kmin,kl,klp,ix1,jy1,ixp,jyp,ixm,jym
-  integer :: rain_cloud_above,kz_inv
+  integer :: ix,jy,kz,iz,n,kmin,kl,klp,ix1,jy1,ixp,jyp,ixm,jym,kz_inv
+  integer :: icloudtop
   real :: f_qvsat,pressure
-  real :: rh,lsp,convp
+  real :: rh,lsp,convp,prec,rhmin
   real :: rhoh(nuvzmax),pinmconv(nzmax)
   real :: ew,pint,tv,tvold,pold,dz1,dz2,dz,ui,vi
@@ -85 +86 @@
   real,parameter :: const=r_air/ga
 
-  logical :: init = .true.
+  logical :: init = .true., lconvectprec, lsearch
 
 
@@ -477 +478 @@
 
 
-  !write (*,*) 'initializing clouds, n:',n,nymin1,nxmin1,nz
-  !   create a cloud and rainout/washout field, clouds occur where rh>80%
-  !   total cloudheight is stored at level 0
+  ! write (*,*) 'diagnosing clouds, n:',n,nymin1,nxmin1,nz
+  jy_loop: &
   do jy=0,nymin1
     do ix=0,nxmin1
-      rain_cloud_above=0
+    
       lsp=lsprec(ix,jy,1,n)
       convp=convprec(ix,jy,1,n)
-      cloudsh(ix,jy,n)=0
-      do kz_inv=1,nz-1
-         kz=nz-kz_inv+1
-         pressure=rho(ix,jy,kz,n)*r_air*tt(ix,jy,kz,n)
-         rh=qv(ix,jy,kz,n)/f_qvsat(pressure,tt(ix,jy,kz,n))
-         clouds(ix,jy,kz,n)=0
-         if (rh.gt.0.8) then ! in cloud
-            if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation
-               rain_cloud_above=1
-               cloudsh(ix,jy,n)=cloudsh(ix,jy,n)+ &
-               height(kz)-height(kz-1)
-               if (lsp.ge.convp) then
-                  clouds(ix,jy,kz,n)=3 ! lsp dominated rainout
-               else
-                  clouds(ix,jy,kz,n)=2 ! convp dominated rainout
-               endif
-            else ! no precipitation
-                  clouds(ix,jy,kz,n)=1 ! cloud
+      prec=lsp+convp
+      if (lsp .gt. convp) then !  prectype='lsp'
+        lconvectprec = .false.
+      else ! prectype='cp '
+        lconvectprec = .true.
+      endif
+      icloudbot(ix,jy,n)=icmv
+      icloudtop=icmv ! this is just a local variable
+      rhmin=rhmininit ! just initialise in a way that cond is true
+      lsearch=.true.
+
+      cloudsearch_loop: &
+      do while (rhmin .ge. rhminx .and. lsearch)
+        ! give up for < rhminx
+
+        kz_loop: &
+        do kz_inv=1,nz-1
+          kz=nz-kz_inv+1
+          pressure=rho(ix,jy,kz,n)*r_air*tt(ix,jy,kz,n)
+          rh=qv(ix,jy,kz,n)/f_qvsat(pressure,tt(ix,jy,kz,n))
+          if (rh .gt. rhmin) then 
+            if (icloudbot(ix,jy,n) .eq. icmv) then
+              icloudtop=nint(height(kz)) ! use int to save memory
             endif
-         else ! no cloud
-            if (rain_cloud_above.eq.1) then ! scavenging
-               if (lsp.ge.convp) then
-                  clouds(ix,jy,kz,n)=5 ! lsp dominated washout
-               else
-                  clouds(ix,jy,kz,n)=4 ! convp dominated washout
-               endif
-            endif
-         endif
-      end do
-    end do
-  end do
+            icloudbot(ix,jy,n)=nint(height(kz))
+          endif
+        end do kz_loop
+
+        ! PS try to get a cloud thicker than 50 m 
+        ! PS if there is at least precmin mm/h
+        if (prec .gt. precmin .and. &
+          ( icloudbot(ix,jy,n) .eq. icmv .or. &
+            icloudtop-icloudbot(ix,jy,n) .lt. 50)) then
+          rhmin = rhmin - 0.05
+        else
+          lsearch = .false.
+        endif
+        
+      enddo cloudsearch_loop
+
+      ! PS implement a rough fix for badly represented convection
+      ! PS is based on looking at a limited set of comparison data
+      if (lconvectprec .and. icloudtop .lt. icloudtopconvmin .or. &
+         icloudbot(ix,jy,n) .lt. icloudtopmin .and. prec .gt. precmin) then
+        if (convp .lt. 0.1) then
+          icloudbot(ix,jy,n) = icloudbot1
+          icloudtop =          icloudtop1
+        else
+          icloudbot(ix,jy,n) = icloudbot2
+          icloudtop =          icloudtop2
+        endif
+      endif
+
+      if (icloudtop .ne. icmv) then
+        icloudthck(ix,jy,n) = icloudtop-icloudbot(ix,jy,n)
+      else
+        icloudthck(ix,jy,n) = icmv ! no cloud found whatsoever
+      endif
+
+      ! PS get rid of too thin clouds      
+      if (icloudthck(ix,jy,n) .lt. 50) then
+        icloudbot(ix,jy,n)=icmv
+        icloudthck(ix,jy,n)=icmv
+      endif
+
+    enddo
+  enddo jy_loop
 
 end subroutine verttransform