Line data    Source code

       1             : module ML_fixer_check
       2             : 
       3             : 
       4             : contains
       5           0 : subroutine ML_fixer_calc(mgncol,dt,qc,nc,qr,nr,qctend,nctend,qrtend,nrtend,fixer,qc_fixer, nc_fixer, qr_fixer, nr_fixer)
       6             : 
       7             : use shr_kind_mod,   only: r8=>shr_kind_r8
       8             : use micro_pumas_utils, only: pi, rhow
       9             : 
      10             : integer, intent(in) :: mgncol
      11             : real(r8), intent(in) :: dt
      12             : real(r8), intent(in) :: qc(mgncol)
      13             : real(r8), intent(in) :: nc(mgncol)
      14             : real(r8), intent(in) :: qr(mgncol)
      15             : real(r8), intent(in) :: nr(mgncol)
      16             : real(r8), intent(inout) :: qctend(mgncol)
      17             : real(r8), intent(inout) :: nctend(mgncol)
      18             : real(r8), intent(inout) :: qrtend(mgncol)
      19             : real(r8), intent(inout) :: nrtend(mgncol)
      20             : 
      21             : real(r8), intent(out) :: qc_fixer(mgncol)
      22             : real(r8), intent(out) :: nc_fixer(mgncol)
      23             : real(r8), intent(out) :: qr_fixer(mgncol)
      24             : real(r8), intent(out) :: nr_fixer(mgncol)
      25             : 
      26             : real(r8), intent(out) :: fixer(mgncol)
      27             : 
      28             : real(r8) :: qc_tmp, nc_tmp, qr_tmp, nr_tmp
      29             : integer :: i
      30             : 
      31           0 : fixer = 0._r8
      32             : 
      33           0 : qc_fixer = 0._r8
      34           0 : qr_fixer = 0._r8
      35           0 : nc_fixer = 0._r8
      36           0 : nr_fixer = 0._r8
      37             : 
      38           0 : do i = 1,mgncol
      39           0 :    qc_tmp = qc(i)+qctend(i)*dt
      40           0 :    nc_tmp = nc(i)+nctend(i)*dt
      41           0 :    qr_tmp = qr(i)+qrtend(i)*dt
      42           0 :    nr_tmp = nr(i)+nrtend(i)*dt
      43             : 
      44           0 :    if( qc_tmp.lt.0._r8 ) then
      45           0 :       fixer(i) = 1._r8
      46           0 :       qctend(i) = -qc(i)/dt
      47           0 :       qrtend(i) = qc(i)/dt
      48           0 :       nctend(i) = -nc(i)/dt   
      49             :    end if
      50           0 :    if( qr_tmp.lt.0._r8 ) then
      51           0 :       fixer(i) = 1._r8
      52           0 :       qrtend(i) = -qr(i)/dt
      53           0 :       qctend(i) = qr(i)/dt
      54           0 :       nrtend(i) = -nr(i)/dt   
      55             :    end if
      56           0 :    if( nc_tmp.lt.0._r8 ) then
      57           0 :       fixer(i) = 1._r8
      58           0 :       if( qc_tmp.gt.0._r8 ) then
      59           0 :          nc_tmp = qc_tmp/(4._r8/3._r8*pi*(5.e-5_r8)**3._r8*rhow)
      60           0 :          nctend(i) = (nc_tmp-nc(i))/dt
      61             :       else
      62           0 :          nctend(i) = -nc(i)/dt
      63             :       end if
      64             :    end if
      65           0 :    if( nr_tmp.lt.0._r8 ) then
      66           0 :       fixer(i) = 1._r8
      67           0 :       if(qr_tmp.gt.0._r8) then
      68           0 :          nr_tmp = qr_tmp/(4._r8/3._r8*pi*(5.e-5_r8)**3._r8*rhow)
      69           0 :          nrtend(i) = (nr_tmp-nr(i))/dt
      70             :       else
      71           0 :          nrtend(i) = -nr(i)/dt
      72             :       end if
      73             :    end if
      74             : 
      75           0 :    qc_fixer(i) = qc(i)+qctend(i)*dt-qc_tmp
      76           0 :    qr_fixer(i) = qr(i)+qrtend(i)*dt-qr_tmp
      77           0 :    nc_fixer(i) = nc(i)+nctend(i)*dt-nc_tmp
      78           0 :    nr_fixer(i) = nr(i)+nrtend(i)*dt-nr_tmp
      79             : end do
      80             : 
      81           0 : end subroutine ML_fixer_calc
      82             : 
      83             : end module ML_fixer_check