- Timestamp:
- Nov 5, 2018, 3:24:59 PM (6 years ago)
- Location:
- LMDZ6/branches/DYNAMICO-conv
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/pbl_surface_mod.F90 (modified) (31 diffs, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/DYNAMICO-conv
- Property svn:mergeinfo changed
/LMDZ6/trunk removed
- Property svn:mergeinfo changed
-
LMDZ6/branches/DYNAMICO-conv/libf/phylmd/pbl_surface_mod.F90
-
Property
svn:executable
set to
*
r3356 r3411 23 23 USE climb_wind_mod, ONLY : climb_wind_down, climb_wind_up 24 24 USE coef_diff_turb_mod, ONLY : coef_diff_turb 25 USE wx_pbl_mod, ONLY : wx_pbl_init, wx_pbl_final, & 26 !! wx_pbl_fuse_no_dts, wx_pbl_split_no_dts, & 27 !! wx_pbl_fuse, wx_pbl_split 28 wx_pbl0_fuse, wx_pbl0_split 25 29 26 30 27 IMPLICIT NONE … … 149 146 ! CALL getin_p('iflag_frein',iflag_frein) 150 147 ! 151 !jyg<152 !****************************************************************************************153 ! Allocate variables for pbl splitting154 !155 !****************************************************************************************156 157 CALL wx_pbl_init158 !>jyg159 160 148 END SUBROUTINE pbl_surface_init 161 149 ! … … 214 202 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 215 203 !! tke_x, tke_w & 216 wake_dltke ,&217 treedrg &204 wake_dltke & 205 , treedrg & 218 206 !FC 219 207 !!! … … 286 274 ! pblh-----output-R- HCL 287 275 ! pblT-----output-R- T au nveau HCL 288 ! treedrg--output-R- tree drag (m) 289 ! 290 USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send 276 ! 277 USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send 291 278 USE indice_sol_mod 292 279 USE time_phylmdz_mod, ONLY: day_ini,annee_ref,itau_phy 293 280 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dto2d_glo 294 USE print_control_mod, ONLY : prt_level,lunout 295 USE ioipsl_getin_p_mod, ONLY : getin_p 281 USE print_control_mod, ONLY: prt_level,lunout 296 282 297 283 IMPLICIT NONE … … 505 491 CHARACTER(len=8), DIMENSION(nbsrf), SAVE :: cl_surf 506 492 !$OMP THREADPRIVATE(cl_surf) 507 REAL, SAVE :: beta_land ! beta for wx_dts508 !$OMP THREADPRIVATE(beta_land)509 493 510 494 ! Other local variables … … 524 508 REAL, DIMENSION(klon) :: yalb,yalb_vis 525 509 !albedo SB <<< 526 REAL, DIMENSION(klon) :: y t1, yq1, yu1, yv1510 REAL, DIMENSION(klon) :: yu1, yv1 527 511 REAL, DIMENSION(klon) :: ysnow, yqsurf, yagesno, yqsol 528 512 REAL, DIMENSION(klon) :: yrain_f, ysnow_f … … 733 717 !!! jyg le 25/03/2013 734 718 !! Variables intermediaires pour le raccord des deux colonnes \`a la surface 735 !jyg< 736 !! REAL :: dd_Ch 737 !! REAL :: dd_Cm 738 !! REAL :: dd_Kh 739 !! REAL :: dd_Km 740 !! REAL :: dd_u 741 !! REAL :: dd_v 742 !! REAL :: dd_t 743 !! REAL :: dd_q 744 !! REAL :: dd_AH 745 !! REAL :: dd_AQ 746 !! REAL :: dd_AU 747 !! REAL :: dd_AV 748 !! REAL :: dd_BH 749 !! REAL :: dd_BQ 750 !! REAL :: dd_BU 751 !! REAL :: dd_BV 752 !! 753 !! REAL :: dd_KHp 754 !! REAL :: dd_KQp 755 !! REAL :: dd_KUp 756 !! REAL :: dd_KVp 757 !>jyg 719 REAL :: dd_Ch 720 REAL :: dd_Cm 721 REAL :: dd_Kh 722 REAL :: dd_Km 723 REAL :: dd_u 724 REAL :: dd_v 725 REAL :: dd_t 726 REAL :: dd_q 727 REAL :: dd_AH 728 REAL :: dd_AQ 729 REAL :: dd_AU 730 REAL :: dd_AV 731 REAL :: dd_BH 732 REAL :: dd_BQ 733 REAL :: dd_BU 734 REAL :: dd_BV 735 736 REAL :: dd_KHp 737 REAL :: dd_KQp 738 REAL :: dd_KUp 739 REAL :: dd_KVp 758 740 759 741 !!! … … 762 744 REAL, DIMENSION(klon) :: y_delta_tsurf,delta_coef,tau_eq 763 745 REAL, PARAMETER :: facteur=2./sqrt(3.14) 764 REAL, PARAMETER :: inertia=2000.746 REAL, PARAMETER :: effusivity=2000. 765 747 REAL, DIMENSION(klon) :: ytsurf_th_x,ytsurf_th_w,yqsatsurf_x,yqsatsurf_w 766 748 REAL, DIMENSION(klon) :: ydtsurf_th … … 774 756 REAL, DIMENSION(klon) :: Kech_m_x, Kech_m_w 775 757 REAL, DIMENSION(klon) :: yts_x,yts_w 776 !jyg< 777 !! REAL, DIMENSION(klon) :: Kech_Hp, Kech_H_xp, Kech_H_wp 778 !! REAL, DIMENSION(klon) :: Kech_Qp, Kech_Q_xp, Kech_Q_wp 779 !! REAL, DIMENSION(klon) :: Kech_Up, Kech_U_xp, Kech_U_wp 780 !! REAL, DIMENSION(klon) :: Kech_Vp, Kech_V_xp, Kech_V_wp 781 !>jyg 782 !jyg< 783 REAL, DIMENSION(klon) :: ah, bh ! coefficients of the delta_Tsurf equation 784 !>jyg 758 REAL, DIMENSION(klon) :: Kech_Hp, Kech_H_xp, Kech_H_wp 759 REAL, DIMENSION(klon) :: Kech_Qp, Kech_Q_xp, Kech_Q_wp 760 REAL, DIMENSION(klon) :: Kech_Up, Kech_U_xp, Kech_U_wp 761 REAL, DIMENSION(klon) :: Kech_Vp, Kech_V_xp, Kech_V_wp 785 762 786 763 REAL :: vent … … 848 825 ! Initialize ok_flux_surf (for 1D model) 849 826 if (klon_glo>1) ok_flux_surf=.FALSE. 850 851 ! intialize beta_land852 beta_land = 0.5853 call getin_p('beta_land', beta_land)854 827 855 828 ! Initilize debug IO … … 1295 1268 ENDDO 1296 1269 !!! jyg le 07/02/2012 et le 10/04/2013 1297 DO k = 1, klev +11270 DO k = 1, klev 1298 1271 DO j = 1, knon 1299 1272 i = ni(j) … … 1301 1274 !! ytke(j,k) = tke(i,k,nsrf) 1302 1275 ytke(j,k) = tke_x(i,k,nsrf) 1303 ENDDO1304 ENDDO1305 1276 !>jyg 1306 DO k = 1, klev1307 DO j = 1, knon1308 i = ni(j)1309 1277 !FC 1310 1278 y_treedrg(j,k) = treedrg(i,k,nsrf) … … 1335 1303 ENDDO 1336 1304 ENDDO 1337 IF (prt_level .ge. 10) THEN1338 print *,'pbl_surface, wake_s(1), wake_dlt(1,:) ', wake_s(1), wake_dlt(1,:)1339 print *,'pbl_surface, wake_s(1), wake_dlq(1,:) ', wake_s(1), wake_dlq(1,:)1340 ENDIF1341 1305 !!! nrlmd le 02/05/2011 1342 1306 DO k = 1, klev+1 … … 1472 1436 yts_w, yqsurf, yz0m, yz0h, & 1473 1437 ycdragm_w, ycdragh_w, zri1_w, pref_w ) 1474 !1475 zgeo1(:) = wake_s(:)*zgeo1_w(:) + (1.-wake_s(:))*zgeo1_x(:)1476 1438 1477 1439 ! --- special Dice. JYG+MPL 25112013 puis BOMEX … … 1515 1477 ycoefm, ycoefh, ytke, y_treedrg) 1516 1478 ! ycoefm, ycoefh, ytke) 1517 !FC y_treedrg ajout e1479 !FC y_treedrg ajouté 1518 1480 IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN 1519 1481 ! In this case, coef_diff_turb is called for the Cd only … … 1627 1589 !!! 1628 1590 AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x) 1629 !!!1630 IF (prt_level >=10) THEN1631 PRINT *,'pbl_surface (climb_hq_down.x->) AcoefH_x ',AcoefH_x1632 PRINT *,'pbl_surface (climb_hq_down.x->) AcoefQ_x ',AcoefQ_x1633 PRINT *,'pbl_surface (climb_hq_down.x->) BcoefH_x ',BcoefH_x1634 PRINT *,'pbl_surface (climb_hq_down.x->) BcoefQ_x ',BcoefQ_x1635 ENDIF1636 1591 ! 1637 1592 CALL climb_hq_down(knon, ycoefh_w, ypaprs, ypplay, & … … 1642 1597 !!! 1643 1598 AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w) 1644 !!!1645 IF (prt_level >=10) THEN1646 PRINT *,'pbl_surface (climb_hq_down.w->) AcoefH_w ',AcoefH_w1647 PRINT *,'pbl_surface (climb_hq_down.w->) AcoefQ_w ',AcoefQ_w1648 PRINT *,'pbl_surface (climb_hq_down.w->) BcoefH_w ',BcoefH_w1649 PRINT *,'pbl_surface (climb_hq_down.w->) BcoefQ_w ',BcoefQ_w1650 ENDIF1651 1599 !!! 1652 1600 ENDIF ! (iflag_split .eq.0) … … 1699 1647 END IF 1700 1648 1649 !!! nrlmd le 13/06/2011 1650 !----- On finit le calcul des coefficients d'\'echange:on multiplie le cdrag par le module du vent et la densit\'e dans la premi\`ere couche 1651 ! Kech_h_x(j) = ycdragh_x(j) * & 1652 ! (1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2)) * & 1653 ! ypplay(j,1)/(RD*yt_x(j,1)) 1654 ! Kech_h_w(j) = ycdragh_w(j) * & 1655 ! (1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2)) * & 1656 ! ypplay(j,1)/(RD*yt_w(j,1)) 1657 ! Kech_h(j) = (1.-ywake_s(j))*Kech_h_x(j)+ywake_s(j)*Kech_h_w(j) 1658 ! 1659 ! Kech_m_x(j) = ycdragm_x(j) * & 1660 ! (1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2)) * & 1661 ! ypplay(j,1)/(RD*yt_x(j,1)) 1662 ! Kech_m_w(j) = ycdragm_w(j) * & 1663 ! (1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2)) * & 1664 ! ypplay(j,1)/(RD*yt_w(j,1)) 1665 ! Kech_m(j) = (1.-ywake_s(j))*Kech_m_x(j)+ywake_s(j)*Kech_m_w(j) 1666 !!! 1701 1667 1702 1668 !!! nrlmd le 02/05/2011 -----------------------On raccorde les 2 colonnes dans la couche 1 1703 1669 !---------------------------------------------------------------------------------------- 1704 1670 !!! jyg le 07/02/2012 1705 !!! jyg le 01/02/2017 1706 IF (iflag_split .eq. 0) THEN 1707 yt1(:) = yt(:,1) 1708 yq1(:) = yq(:,1) 1709 !! ELSE IF (iflag_split .eq. 1) THEN 1710 !!! 1711 !jyg< 1712 !! CALL wx_pbl_fuse_no_dts(knon, dtime, ypplay, ywake_s, & 1713 !! yt_x, yt_w, yq_x, yq_w, & 1714 !! yu_x, yu_w, yv_x, yv_w, & 1715 !! ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, & 1716 !! AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, & 1717 !! AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, & 1718 !! BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, & 1719 !! BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, & 1720 !! AcoefH, AcoefQ, AcoefU, AcoefV, & 1721 !! BcoefH, BcoefQ, BcoefU, BcoefV, & 1722 !! ycdragh, ycdragm, & 1723 !! yt1, yq1, yu1, yv1 & 1724 !! ) 1725 ELSE IF (iflag_split .ge. 1) THEN 1726 CALL wx_pbl0_fuse(knon, dtime, ypplay, ywake_s, & 1727 yt_x, yt_w, yq_x, yq_w, & 1728 yu_x, yu_w, yv_x, yv_w, & 1729 ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, & 1730 AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, & 1731 AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, & 1732 BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, & 1733 BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, & 1734 AcoefH, AcoefQ, AcoefU, AcoefV, & 1735 BcoefH, BcoefQ, BcoefU, BcoefV, & 1736 ycdragh, ycdragm, & 1737 yt1, yq1, yu1, yv1 & 1738 ) 1739 !! ELSE IF (iflag_split .ge.2) THEN 1740 !!! Provisoire 1741 !! ah(:) = 0. 1742 !! bh(:) = 0. 1743 !! IF (nsrf == is_oce) THEN 1744 !! ybeta(:) = 1. 1745 !! ELSE 1746 !! ybeta(:) = beta_land 1747 !! ENDIF 1748 !! ycdragh(:) = ywake_s(:)*ycdragh_w(:) + (1.-ywake_s(:))*ycdragh_x(:) 1749 !! CALL wx_dts(knon, nsrf, ywake_cstar, ywake_s, ywake_dens, & 1750 !! yts, ypplay(:,1), ybeta, ycdragh , ypaprs(:,1), & 1751 !! yq(:,1), yt(:,1), yu(:,1), yv(:,1), ygustiness, & 1752 !! ah, bh & 1753 !! ) 1754 !!! 1755 !! CALL wx_pbl_fuse(knon, dtime, ypplay, ywake_s, & 1756 !! yt_x, yt_w, yq_x, yq_w, & 1757 !! yu_x, yu_w, yv_x, yv_w, & 1758 !! ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, & 1759 !! AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, & 1760 !! AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, & 1761 !! BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, & 1762 !! BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, & 1763 !! ah, bh, & 1764 !! AcoefH, AcoefQ, AcoefU, AcoefV, & 1765 !! BcoefH, BcoefQ, BcoefU, BcoefV, & 1766 !! ycdragh, ycdragm, & 1767 !! yt1, yq1, yu1, yv1 & 1768 !! ) 1769 !>jyg 1770 !!! 1771 ENDIF ! (iflag_split .eq.0) 1772 !!! 1671 IF (iflag_split .eq.1) THEN 1672 !!! 1673 !!! jyg le 09/04/2013 ; passage aux nouvelles expressions en differences 1674 1675 DO j=1,knon 1676 ! 1677 ! Calcul des coefficients d echange 1678 mod_wind_x = 1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2) 1679 mod_wind_w = 1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2) 1680 rho1 = ypplay(j,1)/(RD*yt(j,1)) 1681 Kech_h_x(j) = ycdragh_x(j) * mod_wind_x * rho1 1682 Kech_h_w(j) = ycdragh_w(j) * mod_wind_w * rho1 1683 Kech_m_x(j) = ycdragm_x(j) * mod_wind_x * rho1 1684 Kech_m_w(j) = ycdragm_w(j) * mod_wind_w * rho1 1685 ! 1686 dd_Kh = Kech_h_w(j) - Kech_h_x(j) 1687 dd_Km = Kech_m_w(j) - Kech_m_x(j) 1688 IF (prt_level >=10) THEN 1689 print *,' mod_wind_x, mod_wind_w ', mod_wind_x, mod_wind_w 1690 print *,' rho1 ',rho1 1691 print *,' ycdragh_x(j),ycdragm_x(j) ',ycdragh_x(j),ycdragm_x(j) 1692 print *,' ycdragh_w(j),ycdragm_w(j) ',ycdragh_w(j),ycdragm_w(j) 1693 print *,' dd_Kh: ',dd_KH 1694 ENDIF 1695 ! 1696 Kech_h(j) = Kech_h_x(j) + ywake_s(j)*dd_Kh 1697 Kech_m(j) = Kech_m_x(j) + ywake_s(j)*dd_Km 1698 ! 1699 ! Calcul des coefficients d echange corriges des retroactions 1700 Kech_H_xp(j) = Kech_h_x(j)/(1.-BcoefH_x(j)*Kech_h_x(j)*dtime) 1701 Kech_H_wp(j) = Kech_h_w(j)/(1.-BcoefH_w(j)*Kech_h_w(j)*dtime) 1702 Kech_Q_xp(j) = Kech_h_x(j)/(1.-BcoefQ_x(j)*Kech_h_x(j)*dtime) 1703 Kech_Q_wp(j) = Kech_h_w(j)/(1.-BcoefQ_w(j)*Kech_h_w(j)*dtime) 1704 Kech_U_xp(j) = Kech_m_x(j)/(1.-BcoefU_x(j)*Kech_m_x(j)*dtime) 1705 Kech_U_wp(j) = Kech_m_w(j)/(1.-BcoefU_w(j)*Kech_m_w(j)*dtime) 1706 Kech_V_xp(j) = Kech_m_x(j)/(1.-BcoefV_x(j)*Kech_m_x(j)*dtime) 1707 Kech_V_wp(j) = Kech_m_w(j)/(1.-BcoefV_w(j)*Kech_m_w(j)*dtime) 1708 ! 1709 dd_KHp = Kech_H_wp(j) - Kech_H_xp(j) 1710 dd_KQp = Kech_Q_wp(j) - Kech_Q_xp(j) 1711 dd_KUp = Kech_U_wp(j) - Kech_U_xp(j) 1712 dd_KVp = Kech_V_wp(j) - Kech_V_xp(j) 1713 ! 1714 Kech_Hp(j) = Kech_H_xp(j) + ywake_s(j)*dd_KHp 1715 Kech_Qp(j) = Kech_Q_xp(j) + ywake_s(j)*dd_KQp 1716 Kech_Up(j) = Kech_U_xp(j) + ywake_s(j)*dd_KUp 1717 Kech_Vp(j) = Kech_V_xp(j) + ywake_s(j)*dd_KVp 1718 ! 1719 ! Calcul des differences w-x 1720 dd_CM = ycdragm_w(j) - ycdragm_x(j) 1721 dd_CH = ycdragh_w(j) - ycdragh_x(j) 1722 dd_u = yu_w(j,1) - yu_x(j,1) 1723 dd_v = yv_w(j,1) - yv_x(j,1) 1724 dd_t = yt_w(j,1) - yt_x(j,1) 1725 dd_q = yq_w(j,1) - yq_x(j,1) 1726 dd_AH = AcoefH_w(j) - AcoefH_x(j) 1727 dd_AQ = AcoefQ_w(j) - AcoefQ_x(j) 1728 dd_AU = AcoefU_w(j) - AcoefU_x(j) 1729 dd_AV = AcoefV_w(j) - AcoefV_x(j) 1730 dd_BH = BcoefH_w(j) - BcoefH_x(j) 1731 dd_BQ = BcoefQ_w(j) - BcoefQ_x(j) 1732 dd_BU = BcoefU_w(j) - BcoefU_x(j) 1733 dd_BV = BcoefV_w(j) - BcoefV_x(j) 1734 ! 1773 1735 IF (prt_level >=10) THEN 1774 PRINT *,'pbl_surface (fuse->): yt(1,:) ',yt(1,:) 1775 PRINT *,'pbl_surface (fuse->): yq(1,:) ',yq(1,:) 1776 PRINT *,'pbl_surface (fuse->): yu(1,:) ',yu(1,:) 1777 PRINT *,'pbl_surface (fuse->): yv(1,:) ',yv(1,:) 1778 PRINT *,'pbl_surface (fuse->): AcoefH(1) ',AcoefH(1) 1779 PRINT *,'pbl_surface (fuse->): BcoefH(1) ',BcoefH(1) 1736 print *,'Variables pour la fusion : Kech_H_xp(j)' ,Kech_H_xp(j) 1737 print *,'Variables pour la fusion : Kech_H_wp(j)' ,Kech_H_wp(j) 1738 print *,'Variables pour la fusion : Kech_Hp(j)' ,Kech_Hp(j) 1739 print *,'Variables pour la fusion : Kech_h(j)' ,Kech_h(j) 1780 1740 ENDIF 1741 ! 1742 ! Calcul des coef A, B \'equivalents dans la couche 1 1743 ! 1744 AcoefH(j) = AcoefH_x(j) + ywake_s(j)*(Kech_H_wp(j)/Kech_Hp(j))*dd_AH 1745 AcoefQ(j) = AcoefQ_x(j) + ywake_s(j)*(Kech_Q_wp(j)/Kech_Qp(j))*dd_AQ 1746 AcoefU(j) = AcoefU_x(j) + ywake_s(j)*(Kech_U_wp(j)/Kech_Up(j))*dd_AU 1747 AcoefV(j) = AcoefV_x(j) + ywake_s(j)*(Kech_V_wp(j)/Kech_Vp(j))*dd_AV 1748 ! 1749 BcoefH(j) = BcoefH_x(j) + ywake_s(j)*BcoefH_x(j)*(dd_Kh/Kech_h(j))*(1.+Kech_H_wp(j)/Kech_Hp(j)) & 1750 + ywake_s(j)*(Kech_H_wp(j)/Kech_Hp(j))*(Kech_h_w(j)/Kech_h(j))*dd_BH 1751 1752 BcoefQ(j) = BcoefQ_x(j) + ywake_s(j)*BcoefQ_x(j)*(dd_Kh/Kech_h(j))*(1.+Kech_Q_wp(j)/Kech_Qp(j)) & 1753 + ywake_s(j)*(Kech_Q_wp(j)/Kech_Qp(j))*(Kech_h_w(j)/Kech_h(j))*dd_BQ 1754 1755 BcoefU(j) = BcoefU_x(j) + ywake_s(j)*BcoefU_x(j)*(dd_Km/Kech_h(j))*(1.+Kech_U_wp(j)/Kech_Up(j)) & 1756 + ywake_s(j)*(Kech_U_wp(j)/Kech_Up(j))*(Kech_m_w(j)/Kech_m(j))*dd_BU 1757 1758 BcoefV(j) = BcoefV_x(j) + ywake_s(j)*BcoefV_x(j)*(dd_Km/Kech_h(j))*(1.+Kech_V_wp(j)/Kech_Vp(j)) & 1759 + ywake_s(j)*(Kech_V_wp(j)/Kech_Vp(j))*(Kech_m_w(j)/Kech_m(j))*dd_BV 1760 1761 ! 1762 ! Calcul des cdrag \'equivalents dans la couche 1763 ! 1764 ycdragm(j) = ycdragm_x(j) + ywake_s(j)*dd_CM 1765 ycdragh(j) = ycdragh_x(j) + ywake_s(j)*dd_CH 1766 ! 1767 ! Calcul de T, q, u et v \'equivalents dans la couche 1 1768 yt(j,1) = yt_x(j,1) + ywake_s(j)*(Kech_h_w(j)/Kech_h(j))*dd_t 1769 yq(j,1) = yq_x(j,1) + ywake_s(j)*(Kech_h_w(j)/Kech_h(j))*dd_q 1770 yu(j,1) = yu_x(j,1) + ywake_s(j)*(Kech_m_w(j)/Kech_m(j))*dd_u 1771 yv(j,1) = yv_x(j,1) + ywake_s(j)*(Kech_m_w(j)/Kech_m(j))*dd_v 1772 1773 1774 ENDDO 1775 !!! 1776 ENDIF ! (iflag_split .eq.1) 1777 !!! 1781 1778 1782 1779 !**************************************************************************************** … … 1815 1812 rlon, rlat, yrmu0, & 1816 1813 debut, lafin, ydelp(:,1), r_co2_ppm, ysolsw, ysollw, yalb, & 1817 !!jyg yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),& 1818 yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,& 1814 yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),& 1819 1815 AcoefH, AcoefQ, BcoefH, BcoefQ, & 1820 1816 AcoefU, AcoefV, BcoefU, BcoefV, & … … 1862 1858 yrmu0, ylwdown, yalb, ypphi(:,1), & 1863 1859 ysolsw, ysollw, yts, ypplay(:,1), & 1864 !!jyg ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),& 1865 ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,& 1860 ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),& 1866 1861 AcoefH, AcoefQ, BcoefH, BcoefQ, & 1867 1862 AcoefU, AcoefV, BcoefU, BcoefV, & … … 1938 1933 itap, dtime, jour, knon, ni, & 1939 1934 lafin, & 1940 !!jyg yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),& 1941 yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,& 1935 yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),& 1942 1936 AcoefH, AcoefQ, BcoefH, BcoefQ, & 1943 1937 AcoefU, AcoefV, BcoefU, BcoefV, & … … 1998 1992 yfluxlat(:) = flat 1999 1993 ! 2000 !! Test sur iflag_split retire le 2/02/2018, sans vraiment comprendre la raison de ce test. (jyg) 2001 !! IF (iflag_split .eq.0) THEN 1994 IF (iflag_split .eq.0) THEN 2002 1995 do j=1,knon 2003 1996 Kech_h(j) = ycdragh(j) * (1.0+SQRT(yu(j,1)**2+yv(j,1)**2)) * & 2004 1997 ypplay(j,1)/(RD*yt(j,1)) 2005 1998 enddo 2006 !!ENDIF ! (iflag_split .eq.0)1999 ENDIF ! (iflag_split .eq.0) 2007 2000 2008 2001 DO j = 1, knon … … 2027 2020 & , y_flux_t1(j), yfluxlat(j), ywake_s(j) 2028 2021 print*,'beta,ytsurf_new', ybeta(j), ytsurf_new(j) 2029 print*,' inertia,facteur,cstar', inertia, facteur,wake_cstar(j)2022 print*,'effusivity,facteur,cstar', effusivity, facteur,wake_cstar(j) 2030 2023 ENDDO 2031 2024 ENDIF 2032 2025 2033 2026 !!! jyg le 07/02/2012 puis le 10/04/2013 2034 !! IF (iflag_split .eq.1) THEN 2035 !!!!! 2036 !!!jyg< 2037 !! CALL wx_pbl_split_no_dts(knon, ywake_s, & 2038 !! AcoefH_x, AcoefH_w, & 2039 !! AcoefQ_x, AcoefQ_w, & 2040 !! AcoefU_x, AcoefU_w, & 2041 !! AcoefV_x, AcoefV_w, & 2042 !! y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, & 2043 !! y_flux_t1_x, y_flux_t1_w, & 2044 !! y_flux_q1_x, y_flux_q1_w, & 2045 !! y_flux_u1_x, y_flux_u1_w, & 2046 !! y_flux_v1_x, y_flux_v1_w, & 2047 !! yfluxlat_x, yfluxlat_w & 2048 !! ) 2049 !! ELSE IF (iflag_split .ge. 2) THEN 2050 IF (iflag_split .GE. 1) THEN 2051 CALL wx_pbl0_split(knon, dtime, ywake_s, & 2052 y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, & 2053 y_flux_t1_x, y_flux_t1_w, & 2054 y_flux_q1_x, y_flux_q1_w, & 2055 y_flux_u1_x, y_flux_u1_w, & 2056 y_flux_v1_x, y_flux_v1_w, & 2057 yfluxlat_x, yfluxlat_w, & 2058 y_delta_tsurf & 2059 ) 2060 ENDIF ! (iflag_split .ge. 1) 2061 !>jyg 2027 IF (iflag_split .eq.1) THEN 2028 !!! 2029 DO j=1,knon 2030 y_delta_flux_t1(j) = ( Kech_H_wp(j)*Kech_H_xp(j)*(AcoefH_w(j)-AcoefH_x(j)) + & 2031 y_flux_t1(j)*(Kech_H_wp(j)-Kech_H_xp(j)) ) / Kech_Hp(j) 2032 y_delta_flux_q1(j) = ( Kech_Q_wp(j)*Kech_Q_xp(j)*(AcoefQ_w(j)-AcoefQ_x(j)) + & 2033 y_flux_q1(j)*(Kech_Q_wp(j)-Kech_Q_xp(j)) ) / Kech_Qp(j) 2034 y_delta_flux_u1(j) = ( Kech_U_wp(j)*Kech_U_xp(j)*(AcoefU_w(j)-AcoefU_x(j)) + & 2035 y_flux_u1(j)*(Kech_U_wp(j)-Kech_U_xp(j)) ) / Kech_Up(j) 2036 y_delta_flux_v1(j) = ( Kech_V_wp(j)*Kech_V_xp(j)*(AcoefV_w(j)-AcoefV_x(j)) + & 2037 y_flux_v1(j)*(Kech_V_wp(j)-Kech_V_xp(j)) ) / Kech_Vp(j) 2038 ! 2039 y_flux_t1_x(j)=y_flux_t1(j) - ywake_s(j)*y_delta_flux_t1(j) 2040 y_flux_t1_w(j)=y_flux_t1(j) + (1.-ywake_s(j))*y_delta_flux_t1(j) 2041 y_flux_q1_x(j)=y_flux_q1(j) - ywake_s(j)*y_delta_flux_q1(j) 2042 y_flux_q1_w(j)=y_flux_q1(j) + (1.-ywake_s(j))*y_delta_flux_q1(j) 2043 y_flux_u1_x(j)=y_flux_u1(j) - ywake_s(j)*y_delta_flux_u1(j) 2044 y_flux_u1_w(j)=y_flux_u1(j) + (1.-ywake_s(j))*y_delta_flux_u1(j) 2045 y_flux_v1_x(j)=y_flux_v1(j) - ywake_s(j)*y_delta_flux_v1(j) 2046 y_flux_v1_w(j)=y_flux_v1(j) + (1.-ywake_s(j))*y_delta_flux_v1(j) 2047 ! 2048 yfluxlat_x(j)=y_flux_q1_x(j)*RLVTT 2049 yfluxlat_w(j)=y_flux_q1_w(j)*RLVTT 2050 2051 ENDDO 2062 2052 ! 2063 2053 … … 2072 2062 !!jyg!! tau_eq(j)=(ywake_s(j)/2.)*(1./max(wake_cstar(j),0.01))*sqrt(0.4/(3.14*max(wake_dens(j),8e-12))) 2073 2063 !!jyg!! 2074 !!jyg!!! delta_coef(j)=dtime/( inertia*sqrt(tau_eq(j)))2075 !!jyg!! delta_coef(j)=facteur*sqrt(tau_eq(j))/ inertia2064 !!jyg!!! delta_coef(j)=dtime/(effusivity*sqrt(tau_eq(j))) 2065 !!jyg!! delta_coef(j)=facteur*sqrt(tau_eq(j))/effusivity 2076 2066 !!jyg!!! delta_coef(j)=0. 2077 2067 !!jyg!! ELSE … … 2102 2092 !!jyg!!!!! fin nrlmd le 13/06/2011 2103 2093 !!jyg!! 2104 IF (iflag_split .ge. 1) THEN2105 2094 IF (prt_level >=10) THEN 2106 2095 DO j = 1, knon … … 2118 2107 & , y_flux_t1_x(j), y_flux_t1_w(j), y_flux_t1(j), y_flux_q1_x(j)*RLVTT, y_flux_q1_w(j)*RLVTT, yfluxlat(j), ywake_s(j) 2119 2108 print*,'beta,ytsurf_new,yqsatsurf', ybeta(j), ytsurf_new(j), yqsatsurf(j) 2120 print*,' inertia,facteur,cstar', inertia, facteur,wake_cstar(j)2109 print*,'effusivity,facteur,cstar', effusivity, facteur,wake_cstar(j) 2121 2110 ENDDO 2122 2111 ENDIF ! (prt_level >=10) 2123 2112 2124 2113 !!! jyg le 07/02/2012 2125 ENDIF ! (iflag_split . ge.1)2114 ENDIF ! (iflag_split .eq.1) 2126 2115 !!! 2127 2116 … … 2376 2365 !!! 2377 2366 !!! nrlmd le 13/06/2011 2378 !!jyg20170131 delta_tsurf(i,nsrf)=y_delta_tsurf(j)*ypct(j) 2379 delta_tsurf(i,nsrf)=y_delta_tsurf(j) 2380 ! 2367 delta_tsurf(i,nsrf)=y_delta_tsurf(j)*ypct(j) 2381 2368 cdragh_x(i) = cdragh_x(i) + ycdragh_x(j)*ypct(j) 2382 2369 cdragh_w(i) = cdragh_w(i) + ycdragh_w(j)*ypct(j) … … 2413 2400 IF (iflag_split .eq.0) THEN 2414 2401 wake_dltke(:,:,nsrf) = 0. 2415 DO k = 1, klev +12402 DO k = 1, klev 2416 2403 DO j = 1, knon 2417 2404 i = ni(j) … … 2426 2413 2427 2414 ELSE ! (iflag_split .eq.0) 2428 DO k = 1, klev +12415 DO k = 1, klev 2429 2416 DO j = 1, knon 2430 2417 i = ni(j) … … 2588 2575 ! print*, tair1,yt(:,1),y_d_t(:,1) 2589 2576 2590 ! Calculate the temperature andrelative humidity at 2m and the wind at 10m2577 ! Calculate the temperatureflag_pbl_surface_t2m_bugiflag_pbl_surface_t2m_bug et relative humidity at 2m and the wind at 10m 2591 2578 !!! jyg le 07/02/2012 2592 2579 IF (iflag_split .eq.0) THEN … … 3104 3091 IF (ALLOCATED(qsurf)) DEALLOCATE(qsurf) 3105 3092 IF (ALLOCATED(ftsoil)) DEALLOCATE(ftsoil) 3106 3107 !jyg<3108 !****************************************************************************************3109 ! Deallocate variables for pbl splitting3110 !3111 !****************************************************************************************3112 3113 CALL wx_pbl_final3114 !>jyg3115 3093 3116 3094 END SUBROUTINE pbl_surface_final -
Property
svn:executable
set to
Note: See TracChangeset
for help on using the changeset viewer.
