var/da/da_physics/da_condens_adj.inc

   1 subroutine da_condens_adj(DT,SCR31,SCR42,SCR71,DUM31,PRD,  &
   2                    QVT,QCT,QRT,TTT,P_B,T_B,QV_B,QCW_B,QRN_B,  &
   3                    SCR319,SCR429,SCR719,DUM319,PRD9,  &
   4                    QVT9,QCT9,QRT9,TTT9,P_A,T_A,QV_A,QCW_A,QRN_A,kts,kte)
   5
   6    !-----------------------------------------------------------------------
   7    ! Purpose: Condensation
   8    !-----------------------------------------------------------------------
   9
  10    implicit none
  11
  12    integer, intent(in)                     :: kts, kte
  13    real, dimension(kts:kte), intent(in)    :: DT,SCR31,SCR42,SCR71,PRD,DUM31
  14    real, dimension(kts:kte), intent(in)    :: P_B,T_B,QV_B,QCW_B,QRN_B
  15    real, dimension(kts:kte), intent(inout) :: SCR319,SCR429,SCR719,PRD9
  16    real, dimension(kts:kte), intent(inout) :: P_A,T_A,QV_A,QCW_A,QRN_A,DUM319
  17
  18    real, dimension(kts:kte), intent(in)    :: QVT,QCT,QRT,TTT
  19    real, dimension(kts:kte), intent(inout) :: QRT9,QCT9,QVT9,TTT9
  20
  21
  22    real, dimension(kts:kte)  :: DUM2139
  23    real, dimension(kts:kte)  :: TMP,DUM114,DUM2129,SCR89,DUM212,DUM115
  24    real, dimension(kts:kte)  :: PRC5,PRC59,DUM1149,SCR61,SCR8,DUM213
  25    real, dimension(kts:kte)  :: SCR619
  26    integer                   :: k
  27
  28    !  initilization
  29
  30    do K=kts,kte
  31       DUM2129(K) = 0.0
  32       SCR89 (K) = 0.0
  33       PRC59 (K) = 0.0
  34    end do
  35
  36    do K=kts, kte
  37
  38    if (DT(k) <= 0.0) cycle
  39
  40       DUM114(K)=1.0e3*SVP1*EXP(SVP2*(SCR71(K)-SVPT0)/(SCR71(K)-SVP3))
  41
  42       if(SCR71(K) > TO) then
  43          DUM212(K)=DUM31(K)*DUM31(K)/(gas_constant_v*PRD(K))
  44       else
  45          DUM212(K)=XLS*DUM31(K)/(gas_constant_v*PRD(K))
  46       end if
  47       PRC5(K)=.622*DUM114(K)/(P_B(K)-DUM114(K))
  48
  49       if(SCR42(K) < PRC5(K) .AND. SCR71(K) < TO) then
  50          SCR61(K)=0.0
  51       else
  52          SCR8(K)=(SCR42(K)-PRC5(K))/(1.0+DUM212(K)*PRC5(K)/  &
  53                  (SCR71(K)*SCR71(K)))
  54
  55          DUM115(K)=SCR31(K)+SCR8(K)
  56          if (DUM115(K) >= 0.0)then
  57             SCR61(K)=SCR8(K)/DT(k)
  58          else
  59             SCR61(K)=-SCR31(K)/DT(k)
  60          end if
  61       end if
  62       if(SCR71(K) > TO)then
  63          DUM213(K)=DUM31(K)/PRD(K)
  64       else
  65          DUM213(K)=XLS/PRD(K)
  66       end if
  67
  68       TTT9(K)=DT(K)*T_A(K)
  69       SCR619(K)=DT(K)*DUM213(K)*T_A(K)
  70       DUM2139(K)=DT(K)*SCR61(K)*T_A(K)
  71       if(QRN_B(K) < 1.0e-25) QRN_A(K)=0.0
  72       QRT9(K)=DT(K)*QRN_A(K)
  73
  74       DUM319(K)=0.0
  75       if(SCR71(K) > TO)then
  76          DUM319(K)=DUM2139(K)/PRD(K)
  77          PRD9(K)=-DUM31(K)/(PRD(K)*PRD(K))*DUM2139(K)
  78       else
  79          PRD9(K)=-XLS/(PRD(K)*PRD(K))*DUM2139(K)
  80       end if
  81       if(QCW_B(K) < 1.0e-25) QCW_A(K)=0.0
  82       QCT9(K)=DT(K)*QCW_A(K)
  83       SCR619(K)=SCR619(K)+DT(K)*QCW_A(K)
  84       if(QV_B(K) < 1.0e-25) QV_A(K)=0.0
  85       QVT9(K)=DT(K)*QV_A(K)
  86       SCR619(K)=SCR619(K)-DT(K)*QV_A(K)
  87
  88       SCR319(K)=0.0
  89       SCR429(K)=0.0
  90       SCR719(K)=0.0
  91       if(SCR42(K) >= PRC5(K) .OR. SCR71(K) >= TO) then
  92          if(DUM115(K) >= 0.0)then
  93             SCR89(K)=SCR89(K)+SCR619(K)/DT(k)
  94          else
  95             SCR319(K)=-SCR619(K)/DT(k)
  96          end if
  97
  98          TMP(K)=1.0/(1.0+DUM212(K)*PRC5(K)/(SCR71(K)*SCR71(K)))
  99          SCR719(K)=TMP(K)*TMP(K)*2.0*DUM212(K)*PRC5(K)  &
 100                    *(SCR42(K)-PRC5(K))/(SCR71(K)*SCR71(K)*SCR71(K))*SCR89(K)
 101          DUM2129(K)=DUM2129(K)-TMP(K)*TMP(K)*(SCR42(K)-PRC5(K))*PRC5(K)/  &
 102                      (SCR71(K)*SCR71(K))*SCR89(K)
 103          PRC59(K)=PRC59(K)-TMP(K)*(1.0+(SCR42(K)-PRC5(K))*DUM212(K)/  &
 104                      (SCR71(K)*SCR71(K))*TMP(K))*SCR89(K)
 105          SCR429(K)=TMP(K)*SCR89(K)
 106       end if
 107
 108       TMP(K)=.622/(P_B(K)-DUM114(K))**2
 109       DUM1149(K)=TMP(K)*P_B(K)*PRC59(K)
 110       P_A(K)=P_A(K)-TMP(K)*DUM114(K)*PRC59(K)
 111       if(SCR71(K) > TO) then
 112          PRD9(K)=PRD9(K)-DUM31(K)*DUM31(K)/   &
 113                  (gas_constant_v*PRD(K)*PRD(K))*DUM2129(K)
 114          DUM319(K)=DUM319(K)+2.0*DUM31(K)/(gas_constant_v*PRD(K))*DUM2129(K)
 115       else
 116          PRD9(K)=PRD9(K)-XLS*DUM31(K)/(gas_constant_v*PRD(K)*PRD(K))*DUM2129(K)
 117          DUM319(K)=DUM319(K)+XLS/(gas_constant_v*PRD(K))*DUM2129(K)
 118       end if
 119       DUM114(K)=1.0e3*SVP1*EXP(SVP2*(SCR71(K)-SVPT0)/(SCR71(K)-SVP3))
 120       SCR719(K)=SCR719(K)+DUM114(K)*SVP2*(SVPT0-SVP3)/  &
 121                 (SCR71(K)-SVP3)**2*DUM1149(K)
 122
 123    end do
 124
 125 end subroutine da_condens_adj