! Library:phys $Id: hlqcampli.F90 5126 2007-05-11 16:21:54Z towil $

!options xopt(noeval)
 subroutine hlqcampli(                                 &
! scalars and logicals 
 &                     khor,      klev,     kstart,    &
 &                     kstop,     kcall,    pdtime,    &
 &                     pdtheta,                        &
! prognostic variables  
 &                     pq,        pcw,      pcice,     & 
 &                     pqampli,                        &
! diagnostic fields 
 &                     pps,       ppf,                 &
! work arrays 
 &                     pzqp,      pzcwp,    pzcicep,   &
 &                     pzrhuc                          )
!     ---------------------------------------------------------
!     PURPOSE
!     --------
! (*) Compute amplitude 'pqampli' of relative variation of total 
!     specific humidity in the absence of moist convection 
!     penetrating the grid cell.
!     ----------
!     INTERFACE:
!     -----------
!     subroutine 'hlqcampli' is called from subroutine 'hlconds'.
!     It is called twice. The parameter 'kcall' being either 
!     1 or 2 decides the actual operations to be made. If 
!     'kcall=1' the routine only performs a security kind of 
!     computation. If 'kcall=2' the real time dependency of 
!     'pqampli' is computed. To describe this time variation 
!     involves assumptions which are rather speculative.  
!     The second call to the present routine (`kcall=2') should
!     be done after the tendency of cloud water due to precipitation 
!     release effects is known.
!     -----------
!     INPUT     :
!     -----------
!     (from argument list or modules)
!       khor         number of horizontal grid points 
!       klev         number of vertical levels 
!       kstart       start point of horizontal loop
!       kstop        end point of horizontal loop
!       kcall        call number identifier for this routine 
!       pdtime       time step for condensation processes. 
!       pdtheta      model resolution (deg.) 
!       pps          surface pressure (Pa.)
!       pt           temperature at old time step 
!                    (currently not used)
!       pq           specific humidity at old time step           
!       pcw          cloud water content at old time step.
!       ppf          pressure at 'full' levels
!       pzqp         provisional value of specific humidity
!       pzcwp        provisional value of specific cloud water
!       pzcicep      provisional value of specific ice 
!     ------------
!     OUTPUT     :  
!     ------------
!     'pqampli'      aplitude of fractional total specific humidity 
!                    variation (3D-time dependent field)
!     --------------------
!     EXTERNAL SUBROUTINES:  none

!     LITTERATURE:
!     ------------
!     DMI Tech. Rep. 02-10.

!     AUTHOR:
!     -------
!     Bent H. Sass,(DMI)
!     based on the research during the HIRLAM I-IV projects.
!     --------------
!     MODIFICATIONS:
!     --------------
!     Original version for ALADIN/ARPEGE: 2005-12-27

!     ===============================================================
!     1. Declarations. 
!     ===============================================================

!     1.1 MODULES USED:

use parkind1  ,only : jpim,    jprb
use yomhook   ,only : lhook,   dr_hook
use yhlconst  ,only : pi,  rearth

!     1.2 OTHER DECLARATIONS.
     
implicit none

integer(kind=jpim),intent(in)     ::  khor
integer(kind=jpim),intent(in)     ::  klev  
integer(kind=jpim),intent(in)     ::  kstart
integer(kind=jpim),intent(in)     ::  kstop
integer(kind=jpim),intent(in)     ::  kcall 
real(kind=jprb)   ,intent(in)     ::  pdtime
real(kind=jprb)   ,intent(in)     ::  pdtheta 
real(kind=jprb)   ,intent(in)     ::  pps(khor) 
real(kind=jprb)   ,intent(in)     ::  pq(khor,klev) 
real(kind=jprb)   ,intent(in)     ::  pcw(khor,klev)
real(kind=jprb)   ,intent(in)     ::  pcice(khor,klev)
real(kind=jprb)   ,intent(inout)  ::  pqampli(khor,klev) 
real(kind=jprb)   ,intent(in)     ::  ppf(khor,klev) 
real(kind=jprb)   ,intent(in)     ::  pzqp(khor,klev) 
real(kind=jprb)   ,intent(in)     ::  pzcwp(khor,klev)
real(kind=jprb)   ,intent(in)     ::  pzcicep(khor,klev)
real(kind=jprb)   ,intent(inout)  ::  pzrhuc(khor,klev)

real(kind=jprb)   ::  ztenw,  zcofqt,  zcofcw,  ztoten1,  ztoten2, &
 &                    ztenq,  zcoflim, zwrhf,   zqctot,   zqmina
real(kind=jprb)   ::  zcwlim,   zpdps,    zrelf0, & 
 &                    zrelf1,  zrelf2, zdrelf,  zrelfh,   zdist,   &
 &                    zqwi

integer(kind=jpim)    ::  jl,  jk 
real(kind=jprb)       ::  zhook_handle 

#include "hlesat.h"

!     ==============================================================
!     2. Initialize various constants and arrays including labels
!     ==============================================================

!     2.1 local constants   
!     -------------------

!     'zrelf0,zrelf1,zrelf2,zrelfr,zdrelf':
!      coefficients involved in describing the relative variation 
!      of the total specific humidity.

!     'zcwlim'  minimum 'cutoff' cloud condensate for clouds 
!               to exist. 
!     'zqmina'  minimum humidity fraction amlitude used for 
!               variation of cloud condensate in clouds.
!     'zcofqt'  coefficient used to describe the time evolution 
!               of the humidity fraction amplitude.  
!     'zcofcw'  coefficient used to describe the time evolution 
!               of the humidity fraction amplitude.

      if (lhook) call dr_hook('hlqcampli',0,zhook_handle)

      zcwlim=1.E-7_jprb
      zqmina=0.005_jprb
      zdist=rearth*pi*pdtheta/180._jprb
      zrelf0=2.0_jprb
      zrelf1=1.0_jprb
      zrelf2=600._jprb
      zdrelf=9.0_jprb
      zrelfh=zrelf1/( 1._jprb + zrelf2/sqrt( zdist ) )
      zcofqt=3.0_jprb
      zcofcw=9.0_jprb

!     '1/zcoflim' corresponds to 6 hours 

      zcoflim=4.63E-5_jprb

!     The "zwrhf"-factor is used to describe 'local climatological
!     fluctuation'. 

      zwrhf=0.75_jprb

!     ==============================================================
!     3.   Compute amplitude 'qampli' as a security computation 
!     ==============================================================

      if( kcall == 1 ) then 
         do jk=1,klev
            do jl=kstart,kstop

!             Maximum amplitude 'wrhuc' during disturbed conditions 

               zpdps=ppf(jl,jk)/pps(jl) 
               pzrhuc(jl,jk)=  &
     &         zrelfh*(zrelf0 +zdrelf*(1._jprb -zpdps*zpdps*zpdps))/ &
     &                (zrelf0 +zdrelf)
         
!              Modify 'pqampli' only when it has not been initialized.

               if( pqampli(jl,jk) <= zqmina ) then
                  pqampli(jl,jk)=zwrhf*pzrhuc(jl,jk) 
               endif
            enddo
         enddo

      endif

!     ============================================================
!     4.   Compute time dependent amplitude 'qampli(jl,jk)' 
!          of relative total specific humidity fluctuations. 
!     ============================================================

      if( kcall == 2 ) then  
         do jk=1,klev
            do jl=kstart,kstop

!              4.1) Establish tendencies of humidity and cloud condensate
!              from input values.  
    
               ztenq = (pzqp(jl,jk) -pq(jl,jk))/pdtime
               ztenw = (pzcwp(jl,jk) +pzcicep(jl,jk) -  &
     &                 pcw(jl,jk) -pcice(jl,jk) )/pdtime

!              4.2) Provide limits for moisture fluctuation amplitude.  
!              This may be needed the first time step if the global
!              field 'pqampli' has not been taken over from previous 
!              forecast 'first guess' value. The limits are 
!              'zqamin' (constant) and 'pzrhuc(jl,jk)'. The latter is
!              dependent on resolution and on the vertical distance 
!              from the ground. It could be made dependent 
!              on local 'climatological' forcing in a more refined 
!              formulation.

               zpdps=ppf(jl,jk)/pps(jl) 
               pzrhuc(jl,jk) =  &
     &           zrelfh*(zrelf0 +zdrelf*(1._jprb -zpdps*zpdps*zpdps))/ &
     &           (zrelf0 +zdrelf)

               pqampli(jl,jk)=min( max( pqampli(jl,jk), zqmina),  &  
     &                             pzrhuc(jl,jk) ) 

!              4.3) Determine the time development of 'pqampli'.                      
!              The formulation expresses a sum of several processes,
!              that is, 

!              a) forcing towards the maximum amplitude 'pzrhuc'. It is 
!              assumed that the forcing coefficient depends on the 
!              absolute magnitude of the local relative tendency
!              of total specific humidity (precipitation release not 
!              considered). 

!              b) forcing towards a minimum amplitude 'zqmina' as a 
!              result of precipitation release. The forcing coefficient 
!              again depends on the tendency or cloud condensate relative 
!              to total specific humidity, as a result of precipitation 
!              release. 

!              c) decay towards a local amplitude 'zwrhf*pzrhuc'. 
!              It is noted that 'zwrhf' < 1 and 
!              'zqmina' < zwrhf*wrhuc < 'wrhuc'.

               zqwi=pzqp(jl,jk) +pzcwp(jl,jk) +pzcicep(jl,jk)
               zqctot=max( zqwi , zcwlim )
               ztoten1=zcofqt*abs( ztenq + ztenw )
               ztoten2=zcofcw*min( ztenw, 0._jprb ) 

               pqampli(jl,jk)=pqampli(jl,jk) +pdtime*  &
     &            ( ztoten1*(pzrhuc(jl,jk) -pqampli(jl,jk)) -  &
     &              ztoten2*(zqmina -pqampli(jl,jk)) )/zqctot +pdtime* &
     &              zcoflim*( zwrhf*pzrhuc(jl,jk) -pqampli(jl,jk) )

!              4.4) Impose again the minimum and the maximum limits 
!              for the possible value 'pqampli'. This is necessary because
!              of the potential risk that the tendencies in combination
!              with time step makes too large change of 'qampli'.

               pqampli(jl,jk)=min( max( pqampli(jl,jk), zqmina),   &
     &                              pzrhuc(jl,jk) )
            enddo
         enddo
      endif
!     ==============================================================
      if (lhook) call dr_hook('hlqcampli',1,zhook_handle)
end subroutine hlqcampli
