diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_microphysics.F b/src/core_atmosphere/physics/mpas_atmphys_driver_microphysics.F index 9281bed257..d6802415cb 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_microphysics.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_microphysics.F @@ -19,8 +19,7 @@ module mpas_atmphys_driver_microphysics !wrf physics: use module_mp_kessler use module_mp_thompson -!mchen use module_mp_wsm6 - use mp_wsm6 + use module_mp_wsm6 implicit none private diff --git a/src/core_atmosphere/physics/physics_sima/mp_wsm6.F b/src/core_atmosphere/physics/physics_sima/mp_wsm6.F index 347b567558..61a5f007e9 100644 --- a/src/core_atmosphere/physics/physics_sima/mp_wsm6.F +++ b/src/core_atmosphere/physics/physics_sima/mp_wsm6.F @@ -67,7 +67,6 @@ SUBROUTINE wsm62D(t, th, pii, q & ,ep1, ep2, qmin & ,XLS, XLV0, XLF0, den0, denr & ,cliq,cice,psat & -!mc ,lat & ,rain,rainncv & ,sr & ,its,ite, kts,kte & @@ -2396,7 +2395,7 @@ end subroutine refl10cm_wsm6 !----------------------------------------------------------------------- subroutine effectRad_wsm6 (t, pii, th, qc, qi, qs, rho, qmin, t0c, & - re_qc, re_qi, re_qs, kts, kte, ii, jj) + re_qc, re_qi, re_qs, kts, kte) !----------------------------------------------------------------------- ! Compute radiation effective radii of cloud water, ice, and snow for @@ -2410,7 +2409,7 @@ subroutine effectRad_wsm6 (t, pii, th, qc, qi, qs, rho, qmin, t0c, & implicit none !..Sub arguments - integer, intent(in) :: kts, kte, ii, jj + integer, intent(in) :: kts, kte real, intent(in) :: qmin real, intent(in) :: t0c real, dimension( kts:kte ), intent(out):: t diff --git a/src/core_atmosphere/physics/physics_wrf/module_mp_wsm6.F b/src/core_atmosphere/physics/physics_wrf/module_mp_wsm6.F index 57db98fc74..7a088cb687 100644 --- a/src/core_atmosphere/physics/physics_wrf/module_mp_wsm6.F +++ b/src/core_atmosphere/physics/physics_wrf/module_mp_wsm6.F @@ -126,34 +126,41 @@ SUBROUTINE wsm6(th, q, qc, qr, qi, qs, qg & DO j=jts,jte DO k=kts,kte DO i=its,ite - den_hv(i,k) = den(i,k,j) + den_hv(i,k) = den(i,k,j) delz_hv(i,k) = delz(i,k,j) - p_hv(i,k) = p(i,k,j) - q_hv(i,k)=q(i,k,j) - pii_hv(i,k)=pii(i,k,j) - th_hv(i,k)=th(i,k,j) - qc_hv(i,k) = qc(i,k,j) - qi_hv(i,k) = qi(i,k,j) - qr_hv(i,k) = qr(i,k,j) - qs_hv(i,k) = qs(i,k,j) - qg_hv(i,k) = qg(i,k,j) + p_hv(i,k) = p(i,k,j) + q_hv(i,k) = q(i,k,j) + pii_hv(i,k) = pii(i,k,j) + th_hv(i,k) = th(i,k,j) + qc_hv(i,k) = qc(i,k,j) + qi_hv(i,k) = qi(i,k,j) + qr_hv(i,k) = qr(i,k,j) + qs_hv(i,k) = qs(i,k,j) + qg_hv(i,k) = qg(i,k,j) ENDDO ENDDO DO i=its,ite - rain_hv(i) = rain(i,j) - if(PRESENT (snowncv) .AND. PRESENT (snow)) snow_hv(i) = snow(i,j) - if(PRESENT (graupelncv) .AND. PRESENT (graupel)) graupel_hv(i) = graupel(i,j) + rain_hv(i) = rain(i,j) ENDDO - ! Sending array starting locations of optional variables may cause - ! troubles, so we explicitly change the call. - CALL wsm62D(t_hv,th_hv,pii_hv,q_hv, qc_hv,qi_hv, qr_hv, qs_hv, qg_hv & + IF(PRESENT (snowncv) .AND. PRESENT (snow)) THEN + DO i=its,ite + snow_hv(i) = snow(i,j) + ENDDO + ENDIF + IF(PRESENT (graupelncv) .AND. PRESENT (graupel)) THEN + DO i=its,ite + graupel_hv(i) = graupel(i,j) + ENDDO + ENDIF + ! + CALL wsm62D(t_hv,th_hv,pii_hv & + ,q_hv,qc_hv,qi_hv,qr_hv,qs_hv,qg_hv & ,den_hv & ,p_hv, delz_hv & ,delt,g, cpd, cpv, rd, rv, t0c & ,ep1, ep2, qmin & ,XLS, XLV0, XLF0, den0, denr & ,cliq,cice,psat & -!mc ,j & ,rain_hv,rainncv_hv & ,sr_hv & ,its,ite, kts,kte & @@ -164,47 +171,51 @@ SUBROUTINE wsm6(th, q, qc, qr, qi, qs, qg & #endif ,errmsg, errflg & ) - DO K=kts,kte - DO I=its,ite + DO k=kts,kte + DO i=its,ite th(i,k,j) = t_hv(i,k) qc(i,k,j) = qc_hv(i,k) qi(i,k,j) = qi_hv(i,k) qr(i,k,j) = qr_hv(i,k) qs(i,k,j) = qs_hv(i,k) qg(i,k,j) = qg_hv(i,k) - q(i,k,j) = q_hv(i,k) + q(i,k,j) = q_hv(i,k) ENDDO ENDDO DO i=its,ite - rain(i,j) = rain_hv(i) - rainncv(i,j) = rainncv_hv(i) - sr(i,j) = sr_hv(i) - if(PRESENT (snowncv) .AND. PRESENT (snow)) then - snow(i,j) = snow_hv(i) - snowncv(i,j) = snowncv_hv(i) - endif - if(PRESENT (graupelncv) .AND. PRESENT (graupel)) then - graupel(i,j) = graupel_hv(i) - graupelncv(i,j) = graupelncv_hv(i) - endif + rain(i,j) = rain_hv(i) + rainncv(i,j) = rainncv_hv(i) + sr(i,j) = sr_hv(i) ENDDO + IF(PRESENT (snowncv) .AND. PRESENT (snow)) THEN + DO i=its,ite + snow(i,j) = snow_hv(i) + snowncv(i,j) = snowncv_hv(i) + ENDDO + ENDIF + IF(PRESENT (graupelncv) .AND. PRESENT (graupel)) THEN + DO i=its,ite + graupel(i,j) = graupel_hv(i) + graupelncv(i,j) = graupelncv_hv(i) + ENDDO + ENDIF - if (has_reqc.ne.0 .and. has_reqi.ne.0 .and. has_reqs.ne.0) then - do i=its,ite - do k=kts,kte - re_qc(k) = 2.51E-6 - re_qi(k) = 10.01E-6 - re_qs(k) = 25.E-6 - th_hv2(k)=th(i,k,j) - pii_hv2(k)=pii(i,k,j) - den1d(k)= den(i,k,j) - qc1d(k) = qc(i,k,j) - qi1d(k) = qi(i,k,j) - qs1d(k) = qs(i,k,j) - enddo - call effectRad_wsm6(t1d, pii_hv2,th_hv2,qc1d, qi1d, qs1d, den1d, & - qmin, t0c, re_qc, re_qi, re_qs, & - kts, kte, i, j) + IF (has_reqc.ne.0 .and. has_reqi.ne.0 .and. has_reqs.ne.0) THEN + do i=its,ite + do k=kts,kte + re_qc(k) = 2.51E-6 + re_qi(k) = 10.01E-6 + re_qs(k) = 25.E-6 + th_hv2(k) = th(i,k,j) + pii_hv2(k) = pii(i,k,j) + den1d(k) = den(i,k,j) + qc1d(k) = qc(i,k,j) + qi1d(k) = qi(i,k,j) + qs1d(k) = qs(i,k,j) + enddo + CALL effectRad_wsm6(t1d, pii_hv2,th_hv2,qc1d, qi1d, qs1d, den1d, & + qmin, t0c, re_qc, re_qi, re_qs, & + kts, kte) do k=kts,kte re_cloud(i,k,j) = MAX(2.51E-6, MIN(re_qc(k), 50.E-6)) re_ice(i,k,j) = MAX(10.01E-6, MIN(re_qi(k), 125.E-6)) @@ -223,4 +234,4 @@ SUBROUTINE wsm6(th, q, qc, qr, qi, qs, qg & #endif ENDDO END SUBROUTINE wsm6 -END MODULE mp_wsm6 +END MODULE module_mp_wsm6