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

branches/petra/src/verttransform_nests.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   *
@@ -52 +52 @@
   ! add the variable cloud for use with scavenging - descr. in com_mod
   !*****************************************************************************
+  ! Petra Seibert, Feb 2015: Add quick fix from 2013 
+  !*****************************************************************************
   !                                                                            *
   ! Variables:                                                                 *
@@ -69 +71 @@
   implicit none
 
-  integer :: ix,jy,kz,iz,n,l,kmin,kl,klp,ix1,jy1,ixp,jyp
-  integer :: rain_cloud_above,kz_inv
-  real :: f_qvsat,pressure,rh,lsp,convp
-  real :: wzlev(nwzmax),rhoh(nuvzmax),pinmconv(nzmax)
-  real :: uvwzlev(0:nxmaxn-1,0:nymaxn-1,nzmax)
-  real :: ew,pint,tv,tvold,pold,dz1,dz2,dz,ui,vi,cosf
+  integer :: ix,jy,kz,iz,n,l,kmin,kl,klp,ix1,jy1,ixp,jyp,kz_inv
+  integer :: icloudtop
+  real :: f_qvsat,pressure
+  real :: rh,lsp,convp,prec,rhmin
+  real :: rhoh(nuvzmax),pinmconv(nzmax)
+  real :: wzlev(nwzmax),uvwzlev(0:nxmaxn-1,0:nymaxn-1,nzmax)
+  real :: ew,pint,tv,tvold,pold,dz1,dz2,dz,ui,vi
   real :: dzdx,dzdy
-  real :: dzdx1,dzdx2,dzdy1,dzdy2
+  real :: dzdx1,dzdx2,dzdy1,dzdy2,cosf
   real :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
   real :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
@@ -83 +86 @@
   real,parameter :: const=r_air/ga
 
+  logical :: lconvectprec, lsearch
 
   ! Loop over all nests
   !********************
 
+  numbnest_loop: &
   do l=1,numbnests
 
@@ -143 +148 @@
 
 
-  ! Levels, where u,v,t and q are given
-  !************************************
+  ! Levels where u,v,t and q are given
+  !***********************************
 
       uun(ix,jy,1,n,l)=uuhn(ix,jy,1,l)
@@ -194 +199 @@
 
 
-  ! Levels, where w is given
-  !*************************
+  ! Levels where w is given
+  !************************
 
       wwn(ix,jy,1,n,l)=wwhn(ix,jy,1,l)*pinmconv(1)
@@ -275 +280 @@
 
       end do
-
     end do
   end do
 
-
-  !write (*,*) 'initializing nested cloudsn, n:',n
-  !   create a cloud and rainout/washout field, cloudsn occur where rh>80%
+  ! write (*,*) 'diagnosing nested clouds, n:',n
+  jy_loop: &
   do jy=0,nyn(l)-1
     do ix=0,nxn(l)-1
-      rain_cloud_above=0
+
       lsp=lsprecn(ix,jy,1,n,l)
       convp=convprecn(ix,jy,1,n,l)
-      cloudsnh(ix,jy,n,l)=0
-      do kz_inv=1,nz-1
-         kz=nz-kz_inv+1
-         pressure=rhon(ix,jy,kz,n,l)*r_air*ttn(ix,jy,kz,n,l)
-         rh=qvn(ix,jy,kz,n,l)/f_qvsat(pressure,ttn(ix,jy,kz,n,l))
-         cloudsn(ix,jy,kz,n,l)=0
-         if (rh.gt.0.8) then ! in cloud
-            if ((lsp.gt.0.01).or.(convp.gt.0.01)) then
-               rain_cloud_above=1
-               cloudsnh(ix,jy,n,l)=cloudsnh(ix,jy,n,l)+ &
-               height(kz)-height(kz-1)
-               if (lsp.ge.convp) then
-                  cloudsn(ix,jy,kz,n,l)=3 ! lsp dominated rainout
-               else
-                  cloudsn(ix,jy,kz,n,l)=2 ! convp dominated rainout
-               endif
-            else ! no precipitation
-                  cloudsn(ix,jy,kz,n,l)=1 ! cloud
+      prec=lsp+convp
+      if (lsp .gt. convp) then !  prectype='lsp'
+        lconvectprec = .false.
+      else ! prectype='cp '
+        lconvectprec = .true.
+      endif
+      icloudbotn(ix,jy,n,l)=icmv
+      icloudtop=icmv ! this is just a local variable
+      rhmin=rhmininit  
+      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=rhon(ix,jy,kz,n,l)*r_air*ttn(ix,jy,kz,n,l)
+           rh=qvn(ix,jy,kz,n,l)/f_qvsat(pressure,ttn(ix,jy,kz,n,l))
+           if (rh .gt. rhmin) then 
+            if (icloudbotn(ix,jy,n,l) .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
-                  cloudsn(ix,jy,kz,n,l)=5 ! lsp dominated washout
-               else
-                  cloudsn(ix,jy,kz,n,l)=4 ! convp dominated washout
-               endif
-            endif
-         endif
-      end do
-    end do
-  end do
-
-  end do
+            icloudbotn(ix,jy,n,l)=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. &
+          ( icloudbotn(ix,jy,n,l) .eq. icmv .or. &
+            icloudtop-icloudbotn(ix,jy,n,l) .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. &
+         icloudbotn(ix,jy,n,l) .lt. icloudtopmin .and. prec .gt. precmin) then
+        if (convp .lt. 0.1) then
+          icloudbotn(ix,jy,n,l) = icloudbot1
+          icloudtop =             icloudtop1
+        else
+          icloudbotn(ix,jy,n,l) = icloudbot2
+          icloudtop =             icloudtop2
+        endif
+      endif
+      if (icloudtop .ne. icmv) then
+        icloudthckn(ix,jy,n,l) = icloudtop-icloudbotn(ix,jy,n,l)
+      else
+        icloudthckn(ix,jy,n,l) = icmv
+      endif
+      ! PS get rid of too thin clouds      
+      if (icloudthck(ix,jy,n) .lt. 50) then
+        icloudbotn(ix,jy,n,l)=icmv
+        icloudthckn(ix,jy,n,l)=icmv
+      endif
+
+    enddo
+  enddo jy_loop
+ 
+  enddo numbnest_loop
 
 end subroutine verttransform_nests