Line data Source code
1 : module dme_adjust
2 :
3 : use ccpp_kinds, only: kind_phys
4 :
5 : implicit none
6 :
7 : contains
8 : !===============================================================================
9 : !> \section arg_table_dme_adjust_run Argument Table
10 : !! \htmlinclude dme_adjust_run.html
11 : !!
12 0 : subroutine dme_adjust_run(ncol, pver, pcnst, ps, pint, pdel, lnpint, rpdel, const_props, const_array, qini, liqini, iceini, &
13 0 : is_dycore_moist, errmsg, errflg)
14 : !-----------------------------------------------------------------------
15 : !
16 : ! Purpose: Adjust the dry mass in each layer back to the value of physics input state
17 : !
18 : ! Method: Conserve the integrated mass, momentum and total energy in each layer
19 : ! by scaling the specific mass of consituents, specific momentum (velocity)
20 : ! and specific total energy by the relative change in layer mass. Solve for
21 : ! the new temperature by subtracting the new kinetic energy from total energy
22 : ! and inverting the hydrostatic equation
23 : !
24 : ! The mass in each layer is modified, changing the relationship of the layer
25 : ! interfaces and midpoints to the surface pressure. The result is no longer in
26 : ! the original hybrid coordinate.
27 : !
28 : ! This procedure cannot be applied to the "eul" or "sld" dycores because they
29 : ! require the hybrid coordinate.
30 : !
31 : ! Author: Byron Boville
32 :
33 : ! !REVISION HISTORY:
34 : ! 03.03.28 Boville Created, partly from code by Lin in p_d_adjust
35 : !
36 : !-----------------------------------------------------------------------
37 :
38 : use ccpp_constituent_prop_mod, only: ccpp_constituent_prop_ptr_t
39 :
40 : implicit none
41 : !
42 : ! Arguments
43 : !
44 : integer, intent(in) :: ncol
45 : integer, intent(in) :: pver
46 : integer, intent(in) :: pcnst
47 : real(kind_phys), intent(inout) :: ps(:)
48 : real(kind_phys), intent(inout) :: pint(:,:)
49 : real(kind_phys), intent(inout) :: pdel(:,:)
50 : real(kind_phys), intent(inout) :: lnpint(:,:)
51 : real(kind_phys), intent(inout) :: rpdel(:,:)
52 : type(ccpp_constituent_prop_ptr_t), intent(in) :: const_props(:)
53 : real(kind_phys), intent(inout) :: const_array(:,:,:)
54 :
55 : real(kind_phys), intent(in) :: qini(:,:) ! initial specific humidity
56 : real(kind_phys), intent(in) :: liqini(:,:) ! initial total liquid
57 : real(kind_phys), intent(in) :: iceini(:,:) ! initial total ice
58 : logical, intent(in) :: is_dycore_moist
59 : character(len=512), intent(out) :: errmsg
60 : integer, intent(out) :: errflg
61 :
62 : !
63 : !---------------------------Local workspace-----------------------------
64 : !
65 : integer :: k,m ! Longitude, level indices
66 0 : real(kind_phys) :: fdq(ncol) ! mass adjustment factor
67 :
68 0 : real(kind_phys) :: tot_water (ncol,2) ! total water (initial, present)
69 : real(kind_phys) :: tot_water_chg(ncol) ! total water change
70 :
71 :
72 : integer :: m_cnst
73 : logical :: water_flag, active_flag
74 :
75 0 : errmsg = ' '
76 0 : errflg = 0
77 :
78 : !-----------------------------------------------------------------------
79 : ! if dycore is not moist, return as dme_adjust is only for moist mixing ratios
80 :
81 0 : if (.not. is_dycore_moist) return
82 :
83 : !
84 : !-----------------------------------------------------------------------
85 : ! adjust dry mass in each layer back to input value, while conserving
86 : ! constituents, momentum, and total energy
87 0 : ps(:) = pint(:,1)
88 :
89 0 : do k = 1, pver
90 0 : tot_water(:,1) = qini(:,k) +liqini(:,k)+iceini(:,k) !initial total H2O
91 0 : tot_water(:,2) = 0.0_kind_phys
92 0 : do m_cnst=1,pcnst
93 0 : call const_props(m_cnst)%is_water_species(water_flag)
94 0 : call const_props(m_cnst)%is_thermo_active(active_flag)
95 0 : if(water_flag .and. active_flag) then
96 0 : tot_water(:,2) = tot_water(:,2)+const_array(:,k,m_cnst)
97 : end if
98 : end do
99 0 : fdq(:) = 1._kind_phys + tot_water(:,2) - tot_water(:,1)
100 : ! adjust constituents to conserve mass in each layer
101 0 : do m = 1, pcnst
102 0 : const_array(:,k,m) = const_array(:,k,m) / fdq(:)
103 : end do
104 : ! compute new total pressure variables
105 0 : pdel (:,k ) = pdel(:,k ) * fdq(:)
106 0 : ps(:) = ps(:) + pdel(:,k)
107 0 : pint (:,k+1) = pint(:,k ) + pdel(:,k)
108 0 : lnpint(:,k+1) = log(pint(:,k+1))
109 0 : rpdel (:,k ) = 1._kind_phys/ pdel(:,k )
110 : !note that mid-level variables (e.g. pmid) are not recomputed
111 : end do
112 :
113 : end subroutine dme_adjust_run
114 :
115 : end module dme_adjust
|