Merge remote-tracking branch 'origin/release-v4.5.2'
[WRF.git] / var / da / da_radar / da_radzicevar_cal_tl_fw4wetice.inc
blob8bcc8b841d249451c0076678ae6ed381a89b5a30
1   subroutine da_radzicevar_cal_tl_fw4wetice(species_flg,qx,pxabk_all,para_alpha_rxa,para_alpha_rxb,  &
2                                    pxkh,pxkv,ice_abc,ice_bac,fw,pxkh_tlr,    &
3                                    pxkv_tlr,pxkh_tlx,pxkv_tlx,qra,tlopt,     &
4                                    npara_alpharxa) 
6    !---------------------------------------------------------------------------------------------
7    ! purpose: calculate the sum of fw term and its tl linear for the contribution from wet ice
8    !--------------------------------------------------------------------------------------------
9     implicit none
10     integer :: species_flg    ! 1 for snow 2 for graupel
11     integer :: tlopt
12     integer :: npara_alpharxa
13     real    :: qx             ! mixing ratio for ice
14     real    :: pxabk          ! a function: calculate PxA, PxB, PxC for Pxk
15     real    :: pkx            ! a function: calculate PxK
16     real    :: pxabk_all(3)
17     real    :: para_alpha_rxa(npara_alpharxa,2)
18     real    :: para_alpha_rxb(npara_alpharxa,2)
19     real    :: pxkh,pxkv
20     integer :: kk
21     real    :: ice_abc(3),ice_bac(3)
22     real    :: fw,pxkh_tlr,pxkv_tlr,pxkh_tlx,pxkv_tlx
23     real    :: qra            ! mixing ratio for rainwater
24     real    :: temr01,temr02
26     do kk=0,2*npara_alpharxa-1
27        call da_radzicevar_pxabk(para_alpha_rxa(:,species_flg),para_alpha_rxa(:,species_flg), &
28                       kk,npara_alpharxa,pxabk_all(1))
29        call da_radzicevar_pxabk(para_alpha_rxb(:,species_flg),para_alpha_rxb(:,species_flg), &
30                       kk,npara_alpharxa,pxabk_all(2))
31        call da_radzicevar_pxabk(para_alpha_rxa(:,species_flg),para_alpha_rxb(:,species_flg), &
32                       kk,npara_alpharxa,pxabk_all(3))
33        call da_radzicevar_pkx(ice_abc,pxabk_all,temr01) 
34        pxkh=pxkh+temr01*fw**kk
35        call da_radzicevar_pkx(ice_bac,pxabk_all,temr02)
36        pxkv=pxkv+temr02*fw**kk
37        if(tlopt==2.and.kk>=1) then
38           call da_radzicevar_pkx(ice_abc,pxabk_all,temr01)
39           call da_radzicevar_pkx(ice_bac,pxabk_all,temr02)
40           pxkh_tlr=pxkh_tlr+temr01*kk*fw**kk*(1./qra-1./(qra+qx))
41           pxkv_tlr=pxkv_tlr+temr02*kk*fw**kk*(1./qra-1./(qra+qx))
42           pxkh_tlx=pxkh_tlx+temr01*kk*fw**kk*(-1./(qra+qx))
43           pxkv_tlx=pxkv_tlx+temr02*kk*fw**kk*(-1./(qra+qx))
44        endif
45     enddo
47   end subroutine da_radzicevar_cal_tl_fw4wetice