Changeset 5022 for LMDZ6/trunk/libf/phylmd/pbl_surface_mod.F90
- Timestamp:
- Jul 5, 2024, 4:38:48 PM (2 months ago)
- File:
-
- 1 edited
-
LMDZ6/trunk/libf/phylmd/pbl_surface_mod.F90 (modified) (68 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/pbl_surface_mod.F90
r5015 r5022 33 33 wx_pbl_check, wx_pbl_dts_check, wx_evappot 34 34 use config_ocean_skin_m, only: activate_ocean_skin 35 #ifdef ISO 36 USE infotrac_phy, ONLY: niso,ntraciso=>ntiso 37 #endif 35 38 36 39 IMPLICIT NONE … … 49 52 !$OMP THREADPRIVATE(ydTs0, ydqs0) 50 53 54 #ifdef ISO 55 REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: xtsnow ! snow at surface 56 !$OMP THREADPRIVATE(xtsnow) 57 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: Rland_ice ! snow at surface 58 !$OMP THREADPRIVATE(Rland_ice) 59 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: Roce ! snow at surface 60 !$OMP THREADPRIVATE(Roce) 61 #endif 62 51 63 INTEGER, SAVE :: iflag_pbl_surface_t2m_bug 52 64 !$OMP THREADPRIVATE(iflag_pbl_surface_t2m_bug) … … 178 190 179 191 END SUBROUTINE pbl_surface_init 192 193 #ifdef ISO 194 SUBROUTINE pbl_surface_init_iso(xtsnow_rst,Rland_ice_rst) 195 196 ! This routine should be called after the restart file has been read. 197 ! This routine initialize the restart variables and does some validation tests 198 ! for the index of the different surfaces and tests the choice of type of ocean. 199 200 USE indice_sol_mod 201 USE print_control_mod, ONLY: lunout 202 #ifdef ISOVERIF 203 USE isotopes_mod, ONLY: iso_eau,ridicule 204 USE isotopes_verif_mod 205 #endif 206 IMPLICIT NONE 207 208 INCLUDE "dimsoil.h" 209 210 ! Input variables 211 !**************************************************************************************** 212 REAL, DIMENSION(niso,klon, nbsrf), INTENT(IN) :: xtsnow_rst 213 REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice_rst 214 215 ! Local variables 216 !**************************************************************************************** 217 INTEGER :: ierr 218 CHARACTER(len=80) :: abort_message 219 CHARACTER(len = 20) :: modname = 'pbl_surface_init' 220 integer i,ixt 221 222 !**************************************************************************************** 223 ! Allocate and initialize module variables with fields read from restart file. 224 ! 225 !**************************************************************************************** 226 227 ALLOCATE(xtsnow(niso,klon,nbsrf), stat=ierr) 228 IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1) 229 230 ALLOCATE(Rland_ice(niso,klon), stat=ierr) 231 IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1) 232 233 ALLOCATE(Roce(niso,klon), stat=ierr) 234 IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1) 235 236 xtsnow(:,:,:) = xtsnow_rst(:,:,:) 237 Rland_ice(:,:) = Rland_ice_rst(:,:) 238 Roce(:,:) = 0.0 239 240 #ifdef ISOVERIF 241 IF (iso_eau >= 0) THEN 242 CALL iso_verif_egalite_vect2D( & 243 & xtsnow,snow, & 244 & 'pbl_surface_mod 170',niso,klon,nbsrf) 245 DO i=1,klon 246 IF (iso_eau >= 0) THEN 247 CALL iso_verif_egalite(Rland_ice(iso_eau,i),1.0, & 248 & 'pbl_surf_mod 177') 249 ENDIF 250 ENDDO 251 ENDIF 252 #endif 253 254 END SUBROUTINE pbl_surface_init_iso 255 #endif 256 180 257 ! 181 258 !**************************************************************************************** … … 241 318 !FC 242 319 !!! 243 ) 320 #ifdef ISO 321 & ,xtrain_f, xtsnow_f,xt, & 322 & wake_dlxt,zxxtevap,xtevap, & 323 & d_xt,d_xt_w,d_xt_x, & 324 & xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, & 325 & h1_diag,runoff_diag,xtrunoff_diag & 326 #endif 327 & ) 244 328 !**************************************************************************************** 245 329 ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818 … … 316 400 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dto2d_glo 317 401 USE print_control_mod, ONLY : prt_level,lunout 402 #ifdef ISO 403 USE isotopes_mod, ONLY: Rdefault,iso_eau 404 #ifdef ISOVERIF 405 USE isotopes_verif_mod 406 #endif 407 #ifdef ISOTRAC 408 USE isotrac_mod, only: index_iso 409 #endif 410 #endif 318 411 USE ioipsl_getin_p_mod, ONLY : getin_p 319 412 use phys_state_var_mod, only: ds_ns, dt_ns, delta_sst, delta_sal, dter, & … … 368 461 REAL, DIMENSION(klon), INTENT(IN) :: gustiness ! gustiness 369 462 370 REAL, DIMENSION(klon), INTENT(IN) :: cldt ! total cloud fraction 463 REAL, DIMENSION(klon), INTENT(IN) :: cldt ! total cloud 464 465 #ifdef ISO 466 REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: xt ! water vapour (kg/kg) 467 REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtrain_f ! rain fall 468 REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtsnow_f ! snow fall 469 #endif 371 470 372 471 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 … … 381 480 REAL, DIMENSION(klon), INTENT(IN) :: wake_dens 382 481 !!! 383 482 #ifdef ISO 483 REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: wake_dlxt 484 #endif 384 485 ! Input/Output variables 385 486 !**************************************************************************************** … … 450 551 REAL, INTENT(OUT):: zcoefm(:, :, :) ! (klon, klev, nbsrf + 1) 451 552 ! coef for turbulent diffusion of U and V (?), mean for each grid point 553 #ifdef ISO 554 REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: zxxtevap ! water vapour flux at surface, positiv upwards 555 REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: d_xt ! change in water vapour 556 REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag 557 REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag 558 REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_w 559 REAL, DIMENSION(ntraciso,klon,klev), INTENT(OUT) :: d_xt_x 560 #endif 561 562 452 563 453 564 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 … … 513 624 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v ! v wind tension (kg m/s)/(m**2 s) or Pascal 514 625 !FC 515 REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: treedrg ! tree drag (m) 626 REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: treedrg ! tree drag (m) 627 #ifdef ISO 628 REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtsol ! water height in the soil (mm) 629 REAL, DIMENSION(ntraciso,klon, nbsrf) :: xtevap ! evaporation at surface 630 REAL, DIMENSION(klon), INTENT(OUT) :: h1_diag ! just diagnostic, not useful 631 #endif 516 632 517 633 … … 527 643 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_qbs ! blowind snow vertical flux (kg/m**2 528 644 645 #ifdef ISO 646 REAL, DIMENSION(ntraciso,klon), INTENT(OUT) :: dflux_xt ! change of water vapour flux 647 REAL, DIMENSION(niso,klon), INTENT(OUT) :: zxxtsnow ! snow at surface, mean for each grid point 648 REAL, DIMENSION(ntraciso,klon, klev), INTENT(OUT) :: zxfluxxt ! water vapour flux, mean for each grid point 649 REAL, DIMENSION(ntraciso,klon, klev, nbsrf), INTENT(OUT) :: flux_xt ! water vapour flux(latent flux) (kg/m**2/s) 650 #endif 529 651 530 652 ! Martin … … 575 697 REAL, DIMENSION(klon) :: ysnow, yqsurf, yagesno, yqsol 576 698 REAL, DIMENSION(klon) :: yrain_f, ysnow_f, ybs_f 699 #ifdef ISO 700 REAL, DIMENSION(ntraciso,klon) :: yxt1 701 REAL, DIMENSION(niso,klon) :: yxtsnow, yxtsol 702 REAL, DIMENSION(ntraciso,klon) :: yxtrain_f, yxtsnow_f 703 REAL, DIMENSION(klon) :: yrunoff_diag 704 REAL, DIMENSION(niso,klon) :: yxtrunoff_diag 705 REAL, DIMENSION(niso,klon) :: yRland_ice 706 #endif 577 707 REAL, DIMENSION(klon) :: ysolsw, ysollw 578 708 REAL, DIMENSION(klon) :: yfder … … 583 713 REAL, DIMENSION(klon) :: y_flux_t1, y_flux_q1 584 714 REAL, DIMENSION(klon) :: y_dflux_t, y_dflux_q 715 #ifdef ISO 716 REAL, DIMENSION(ntraciso,klon) :: y_flux_xt1 717 REAL, DIMENSION(ntraciso,klon) :: y_dflux_xt 718 #endif 585 719 REAL, DIMENSION(klon) :: y_flux_u1, y_flux_v1 586 720 REAL, DIMENSION(klon) :: y_flux_bs, y_flux0 … … 610 744 REAL, DIMENSION(klon) :: AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0 611 745 REAL, DIMENSION(klon) :: AcoefH, AcoefQ, BcoefH, BcoefQ 746 #ifdef ISO 747 REAL, DIMENSION(ntraciso,klon) :: AcoefXT, BcoefXT 748 #endif 612 749 REAL, DIMENSION(klon) :: AcoefU, AcoefV, BcoefU, BcoefV 613 750 REAL, DIMENSION(klon) :: AcoefQBS, BcoefQBS … … 628 765 REAL, DIMENSION(klon,klev) :: yu, yv 629 766 REAL, DIMENSION(klon,klev) :: yt, yq, yqbs 767 #ifdef ISO 768 REAL, DIMENSION(ntraciso,klon) :: yxtevap 769 REAL, DIMENSION(ntraciso,klon,klev) :: y_d_xt 770 REAL, DIMENSION(ntraciso,klon,klev) :: y_flux_xt 771 REAL, DIMENSION(ntraciso,klon,klev) :: yxt 772 #endif 630 773 REAL, DIMENSION(klon,klev) :: ypplay, ydelp 631 774 REAL, DIMENSION(klon,klev) :: delp … … 699 842 REAL, DIMENSION(klon,klev) :: Kcoef_hq_w, Kcoef_m_w, gama_h_w, gama_q_w 700 843 REAL, DIMENSION(klon) :: alf_1, alf_2, alf_1_x, alf_2_x, alf_1_w, alf_2_w 844 #ifdef ISO 845 REAL, DIMENSION(ntraciso,klon,klev) :: yxt_x, yxt_w 846 REAL, DIMENSION(ntraciso,klon) :: y_flux_xt1_x , y_flux_xt1_w 847 REAL, DIMENSION(ntraciso,klon,klev) :: y_flux_xt_x,y_d_xt_x,zxfluxxt_x 848 REAL, DIMENSION(ntraciso,klon,klev) :: y_flux_xt_w,y_d_xt_w,zxfluxxt_w 849 REAL, DIMENSION(ntraciso,klon,klev,nbsrf) :: flux_xt_x, flux_xt_w 850 REAL, DIMENSION(ntraciso,klon) :: AcoefXT_x, BcoefXT_x 851 REAL, DIMENSION(ntraciso,klon) :: AcoefXT_w, BcoefXT_w 852 REAL, DIMENSION(ntraciso,klon,klev) :: CcoefXT, DcoefXT 853 REAL, DIMENSION(ntraciso,klon,klev) :: CcoefXT_x, DcoefXT_x 854 REAL, DIMENSION(ntraciso,klon,klev) :: CcoefXT_w, DcoefXT_w 855 REAL, DIMENSION(ntraciso,klon,klev) :: gama_xt,gama_xt_x,gama_xt_w 856 #endif 701 857 !!! 702 858 !!!jyg le 08/02/2012 … … 891 1047 REAL, DIMENSION(klon) :: yrmu0 892 1048 ! Martin 893 REAL, DIMENSIO n(klon) :: yri01049 REAL, DIMENSION(klon) :: yri0 894 1050 895 1051 REAL, DIMENSION(klon):: ydelta_sst, ydelta_sal, yds_ns, ydt_ns, ydter, & … … 898 1054 ! dt_ds, tkt, tks, taur, sss on ocean points 899 1055 REAL :: missing_val 1056 #ifdef ISO 1057 REAL, DIMENSION(klon) :: h1 1058 INTEGER :: ixt 1059 !#ifdef ISOVERIF 1060 ! integer iso_verif_positif_nostop 1061 !#endif 1062 #endif 1063 900 1064 !**************************************************************************************** 901 1065 ! End of declarations … … 925 1089 iflag_split_ref = mod(iflag_pbl_split,10) 926 1090 iflag_split = iflag_split_ref 1091 1092 #ifdef ISO 1093 #ifdef ISOVERIF 1094 DO i=1,klon 1095 DO ixt=1,niso 1096 CALL iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 608') 1097 ENDDO 1098 ENDDO 1099 #endif 1100 #ifdef ISOVERIF 1101 DO i=1,klon 1102 IF (iso_eau >= 0) THEN 1103 CALL iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, & 1104 & 'pbl_surf_mod 585',errmax,errmaxrel) 1105 CALL iso_verif_egalite_choix(xtsnow_f(iso_eau,i),snow_f(i), & 1106 & 'pbl_surf_mod 594',errmax,errmaxrel) 1107 IF (iso_verif_egalite_choix_nostop(xtsol(iso_eau,i),qsol(i), & 1108 & 'pbl_surf_mod 596',errmax,errmaxrel) == 1) THEN 1109 WRITE(*,*) 'i=',i 1110 STOP 1111 ENDIF 1112 DO nsrf=1,nbsrf 1113 CALL iso_verif_egalite_choix(xtsnow(iso_eau,i,nsrf),snow(i,nsrf), & 1114 & 'pbl_surf_mod 598',errmax,errmaxrel) 1115 ENDDO 1116 ENDIF !IF (iso_eau >= 0) THEN 1117 ENDDO !DO i=1,knon 1118 DO k=1,klev 1119 DO i=1,klon 1120 IF (iso_eau >= 0) THEN 1121 CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), & 1122 & 'pbl_surf_mod 595',errmax,errmaxrel) 1123 ENDIF !IF (iso_eau >= 0) THEN 1124 ENDDO !DO i=1,knon 1125 ENDDO !DO k=1,klev 1126 #endif 1127 #endif 1128 927 1129 928 1130 !**************************************************************************************** … … 990 1192 PRINT*,'WARNING : On impose qsol=',qsol0 991 1193 qsol(:)=qsol0 1194 #ifdef ISO 1195 DO ixt=1,niso 1196 xtsol(ixt,:)=qsol0*Rdefault(ixt) 1197 ENDDO 1198 #ifdef ISOTRAC 1199 DO ixt=1+niso,ntraciso 1200 xtsol(ixt,:)=qsol0*Rdefault(index_iso(ixt)) 1201 ENDDO 1202 #endif 1203 #endif 992 1204 ENDIF 993 1205 !**************************************************************************************** … … 1040 1252 qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0. 1041 1253 runoff(:)=0. 1254 #ifdef ISO 1255 zxxtevap(:,:)=0. 1256 d_xt(:,:,:)=0. 1257 d_xt_x(:,:,:)=0. 1258 d_xt_w(:,:,:)=0. 1259 flux_xt(:,:,:,:)=0. 1260 ! xtsnow(:,:,:)=0.! attention, xtsnow est l'équivalent de snow et non de qsnow 1261 xtevap(:,:,:)=0. 1262 #endif 1042 1263 IF (iflag_pbl<20.or.iflag_pbl>=30) THEN 1043 1264 zcoefh(:,:,:) = 0.0 … … 1129 1350 !FC 1130 1351 1352 #ifdef ISO 1353 yxtrain_f = 0.0 ; yxtsnow_f = 0.0 1354 yxtsnow = 0.0 1355 yxt = 0.0 1356 yxtsol = 0.0 1357 flux_xt = 0.0 1358 yRland_ice = 0.0 1359 ! d_xt = 0.0 1360 y_dflux_xt = 0.0 1361 dflux_xt=0.0 1362 y_d_xt_x=0. ; y_d_xt_w=0. 1363 #endif 1364 1131 1365 ! >> PC 1132 1366 !the yfields_out variable is defined in (klon,nbcf_out) even if it is used on … … 1155 1389 fluxlat_x(:,:)=0. ; fluxlat_w(:,:)=0. 1156 1390 !>jyg 1391 #ifdef ISO 1392 flux_xt_x(:,:,:,:)=0. ; flux_xt_w(:,:,:,:)=0. 1393 #endif 1157 1394 ! 1158 1395 !jyg< … … 1454 1691 yfluxbs(j)=0.0 1455 1692 y_flux_bs(j) = 0.0 1693 !!! 1694 #ifdef ISO 1695 DO ixt=1,ntraciso 1696 yxtrain_f(ixt,j) = xtrain_f(ixt,i) 1697 yxtsnow_f(ixt,j) = xtsnow_f(ixt,i) 1698 ENDDO 1699 DO ixt=1,niso 1700 yxtsnow(ixt,j) = xtsnow(ixt,i,nsrf) 1701 ENDDO 1702 !IF (nsrf == is_lic) THEN 1703 DO ixt=1,niso 1704 yRland_ice(ixt,j)= Rland_ice(ixt,i) 1705 ENDDO 1706 !endif !IF (nsrf == is_lic) THEN 1707 #ifdef ISOVERIF 1708 IF (iso_eau >= 0) THEN 1709 call iso_verif_egalite_choix(ysnow_f(j), & 1710 & yxtsnow_f(iso_eau,j),'pbl_surf_mod 862', & 1711 & errmax,errmaxrel) 1712 call iso_verif_egalite_choix(ysnow(j), & 1713 & yxtsnow(iso_eau,j),'pbl_surf_mod 872', & 1714 & errmax,errmaxrel) 1715 ENDIF 1716 #endif 1717 #ifdef ISOVERIF 1718 DO ixt=1,ntraciso 1719 call iso_verif_noNaN(yxtsnow_f(ixt,j),'pbl_surf_mod 921') 1720 ENDDO 1721 #endif 1722 #endif 1456 1723 ENDDO 1457 1724 ! >> PC … … 1493 1760 yq(j,k) = q(i,k) 1494 1761 yqbs(j,k)=qbs(i,k) 1762 #ifdef ISO 1763 DO ixt=1,ntraciso 1764 yxt(ixt,j,k) = xt(ixt,i,k) 1765 ENDDO !DO ixt=1,ntraciso 1766 #endif 1495 1767 ENDDO 1496 1768 ENDDO … … 1510 1782 yq_w(j,k) = q(i,k)+(1.-wake_s(i))*wake_dlq(i,k) 1511 1783 !!! 1784 #ifdef ISO 1785 DO ixt=1,ntraciso 1786 yxt_x(ixt,j,k) = xt(ixt,i,k)-wake_s(i)*wake_dlxt(ixt,i,k) 1787 yxt_w(ixt,j,k) = xt(ixt,i,k)+(1.-wake_s(i))*wake_dlxt(ixt,i,k) 1788 ENDDO 1789 #endif 1512 1790 ENDDO 1513 1791 ENDDO … … 1565 1843 i = ni(j) 1566 1844 yqsol(j) = qsol(i) 1845 #ifdef ISO 1846 DO ixt=1,niso 1847 yxtsol(ixt,j) = xtsol(ixt,i) 1848 ENDDO 1849 #endif 1567 1850 ENDDO 1568 1851 ENDIF … … 1859 2142 Kcoef_hq, gama_q, gama_h, & 1860 2143 !!! 1861 AcoefH, AcoefQ, BcoefH, BcoefQ) 2144 AcoefH, AcoefQ, BcoefH, BcoefQ & 2145 #ifdef ISO 2146 & ,yxt, CcoefXT, DcoefXT, gama_xt, AcoefXT, BcoefXT & 2147 #endif 2148 & ) 1862 2149 ELSE !(iflag_split .eq.0) 1863 2150 CALL climb_hq_down(knon, ycoefh_x, ypaprs, ypplay, & … … 1867 2154 Kcoef_hq_x, gama_q_x, gama_h_x, & 1868 2155 !!! 1869 AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x) 2156 AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x & 2157 #ifdef ISO 2158 & ,yxt_x, CcoefXT_x, DcoefXT_x, gama_xt_x, AcoefXT_x, BcoefXT_x & 2159 #endif 2160 & ) 1870 2161 !!! 1871 2162 IF (prt_level >=10) THEN … … 1882 2173 Kcoef_hq_w, gama_q_w, gama_h_w, & 1883 2174 !!! 1884 AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w) 2175 AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w & 2176 #ifdef ISO 2177 & ,yxt_w, CcoefXT_w, DcoefXT_w, gama_xt_w, AcoefXT_w, BcoefXT_w & 2178 #endif 2179 & ) 1885 2180 !!! 1886 2181 IF (prt_level >=10) THEN … … 1964 2259 yt1(:) = yt(:,1) 1965 2260 yq1(:) = yq(:,1) 2261 #ifdef ISO 2262 yxt1(:,:) = yxt(:,:,1) 2263 #endif 2264 1966 2265 ELSE IF (iflag_split .ge. 1) THEN 2266 #ifdef ISO 2267 call abort_gcm('pbl_surface_mod 2149','isos pas encore dans iflag_split=1',1) 2268 #endif 2269 1967 2270 ! 1968 2271 ! Cdragq computation … … 2126 2429 yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, & 2127 2430 y_flux_u1, y_flux_v1, & 2128 yveget,ylai,yheight ) 2431 yveget,ylai,yheight & 2432 #ifdef ISO 2433 & ,yxtrain_f, yxtsnow_f,yxt1, & 2434 & yxtsnow,yxtsol,yxtevap,h1, & 2435 & yrunoff_diag,yxtrunoff_diag,yRland_ice & 2436 #endif 2437 & ) 2129 2438 2130 2439 !FC quid qd yveget ylai yheight ne sont pas definit … … 2156 2465 ENDDO 2157 2466 ENDIF 2158 2467 2468 #ifdef ISOVERIF 2469 DO j=1,knon 2470 DO ixt=1,ntraciso 2471 CALL iso_verif_noNaN(yxtevap(ixt,j), & 2472 & 'pbl_surface 1056a: apres surf_land') 2473 ENDDO 2474 DO ixt=1,niso 2475 CALL iso_verif_noNaN(yxtsol(ixt,j), & 2476 & 'pbl_surface 1056b: apres surf_land') 2477 ENDDO 2478 ENDDO 2479 #endif 2480 #ifdef ISOVERIF 2481 ! write(*,*) 'pbl_surface_mod 1038: sortie surf_land' 2482 DO j=1,knon 2483 IF (iso_eau >= 0) THEN 2484 CALL iso_verif_egalite(yxtsnow(iso_eau,j), & 2485 & ysnow(j),'pbl_surf_mod 1043') 2486 ENDIF !if (iso_eau.gt.0) then 2487 ENDDO !DO i=1,klon 2488 #endif 2489 2159 2490 CASE(is_lic) 2160 2491 ! Martin … … 2177 2508 ysnowhgt, yqsnow, ytoice, ysissnow, & 2178 2509 yalb3_new, yrunoff, & 2179 y_flux_u1, y_flux_v1) 2510 y_flux_u1, y_flux_v1 & 2511 #ifdef ISO 2512 & ,yxtrain_f, yxtsnow_f,yxt1,yRland_ice & 2513 & ,yxtsnow,yxtsol,yxtevap & 2514 #endif 2515 & ) 2180 2516 2181 2517 !jyg< … … 2199 2535 ENDDO 2200 2536 ENDIF 2201 2537 2538 #ifdef ISOVERIF 2539 DO j=1,knon 2540 DO ixt=1,ntraciso 2541 CALL iso_verif_noNaN(yxtevap(ixt,j), & 2542 & 'pbl_surface 1095a: apres surf_landice') 2543 ENDDO 2544 do ixt=1,niso 2545 call iso_verif_noNaN(yxtsol(ixt,j), & 2546 & 'pbl_surface 1095b: apres surf_landice') 2547 enddo 2548 enddo 2549 #endif 2550 #ifdef ISOVERIF 2551 !write(*,*) 'pbl_surface_mod 1060: sortie surf_landice' 2552 do j=1,knon 2553 IF (iso_eau >= 0) THEN 2554 CALL iso_verif_egalite(yxtsnow(iso_eau,j), & 2555 & ysnow(j),'pbl_surf_mod 1064') 2556 ENDIF !if (iso_eau >= 0) THEN 2557 ENDDO !DO i=1,klon 2558 #endif 2559 2202 2560 END IF 2203 2561 … … 2216 2574 y_flux_u1, y_flux_v1, ydelta_sst(:knon), ydelta_sal(:knon), & 2217 2575 yds_ns(:knon), ydt_ns(:knon), ydter(:knon), ydser(:knon), & 2218 ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss) 2576 ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss & 2577 #ifdef ISO 2578 & ,yxtrain_f, yxtsnow_f,yxt1,Roce, & 2579 & yxtsnow,yxtevap,h1 & 2580 #endif 2581 & ) 2219 2582 IF (prt_level >=10) THEN 2220 2583 print *,'arg de surf_ocean: ycdragh ',ycdragh(1:knon) … … 2257 2620 !albedo SB <<< 2258 2621 ytsurf_new, y_dflux_t, y_dflux_q, & 2259 y_flux_u1, y_flux_v1) 2622 y_flux_u1, y_flux_v1 & 2623 #ifdef ISO 2624 & ,yxtrain_f, yxtsnow_f,yxt1,Roce, & 2625 & yxtsnow,yxtsol,yxtevap,Rland_ice & 2626 #endif 2627 & ) 2260 2628 2261 2629 ! Special DICE MPL 05082013 puis BOMEX MPL 20150410 … … 2265 2633 y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1) 2266 2634 ENDDO 2267 ENDIF 2635 ENDIF 2636 2637 #ifdef ISOVERIF 2638 DO j=1,knon 2639 DO ixt=1,ntraciso 2640 CALL iso_verif_noNaN(yxtevap(ixt,j), & 2641 & 'pbl_surface 1165a: apres surf_seaice') 2642 ENDDO 2643 DO ixt=1,niso 2644 CALL iso_verif_noNaN(yxtsol(ixt,j), & 2645 & 'pbl_surface 1165b: apres surf_seaice') 2646 ENDDO 2647 ENDDO 2648 #endif 2649 #ifdef ISOVERIF 2650 !write(*,*) 'pbl_surface_mod 1077: sortie surf_seaice' 2651 DO j=1,knon 2652 IF (iso_eau >= 0) THEN 2653 CALL iso_verif_egalite(yxtsnow(iso_eau,j), & 2654 & ysnow(j),'pbl_surf_mod 1106') 2655 ENDIF !IF (iso_eau >= 0) THEN 2656 ENDDO !DO i=1,klon 2657 #endif 2268 2658 2269 2659 CASE DEFAULT … … 2335 2725 y_flux_t1(j) = yfluxsens(j) 2336 2726 y_flux_q1(j) = -yevap(j) 2727 #ifdef ISO 2728 y_flux_xt1(:,:) = -yxtevap(:,:) 2729 #endif 2337 2730 ENDDO 2338 2731 ENDIF ! (ok_flux_surf) … … 2350 2743 2351 2744 IF (iflag_split .GE. 1) THEN 2745 #ifdef ISO 2746 call abort_gcm('pbl_surface_mod 2607','isos pas encore dans iflag_split=1',1) 2747 #endif 2748 ! 2352 2749 ! 2353 2750 IF (nsrf .ne. is_oce) THEN … … 2567 2964 Kcoef_hq, gama_q, gama_h, & 2568 2965 !!! 2569 y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:)) 2966 y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:) & 2967 #ifdef ISO 2968 & ,yxt,y_flux_xt1 & 2969 & ,AcoefXT,BcoefXT,CcoefXT,DcoefXT,gama_xt & 2970 & ,y_flux_xt(:,:,:),y_d_xt(:,:,:) & 2971 #endif 2972 & ) 2570 2973 ELSE !(iflag_split .eq.0) 2571 2974 CALL climb_hq_up(knon, dtime, yt_x, yq_x, & … … 2576 2979 Kcoef_hq_x, gama_q_x, gama_h_x, & 2577 2980 !!! 2578 y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:)) 2981 y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:) & 2982 #ifdef ISO 2983 & ,yxt_x,y_flux_xt1_x & 2984 & ,AcoefXT_x,BcoefXT_x,CcoefXT_x,DcoefXT_x,gama_xt_x & 2985 & ,y_flux_xt_x(:,:,:),y_d_xt_x(:,:,:) & 2986 #endif 2987 & ) 2579 2988 ! 2580 2989 CALL climb_hq_up(knon, dtime, yt_w, yq_w, & … … 2585 2994 Kcoef_hq_w, gama_q_w, gama_h_w, & 2586 2995 !!! 2587 y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:)) 2996 y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:) & 2997 #ifdef ISO 2998 & ,yxt_w,y_flux_xt1_w & 2999 & ,AcoefXT_w,BcoefXT_w,CcoefXT_w,DcoefXT_w,gama_xt_w & 3000 & ,y_flux_xt_w(:,:,:),y_d_xt_w(:,:,:) & 3001 #endif 3002 & ) 2588 3003 !!! 2589 3004 ENDIF ! (iflag_split .eq.0) … … 2703 3118 flux_u(i,k,nsrf) = y_flux_u(j,k) 2704 3119 flux_v(i,k,nsrf) = y_flux_v(j,k) 3120 3121 #ifdef ISO 3122 DO ixt=1,ntraciso 3123 y_d_xt(ixt,j,k) = y_d_xt(ixt,j,k) * ypct(j) 3124 flux_xt(ixt,i,k,nsrf) = y_flux_xt(ixt,j,k) 3125 ENDDO ! DO ixt=1,ntraciso 3126 h1_diag(i)=h1(j) 3127 #endif 3128 2705 3129 ENDDO 2706 3130 ENDDO 3131 3132 #ifdef ISO 3133 #ifdef ISOVERIF 3134 if (iso_eau.gt.0) then 3135 call iso_verif_egalite_vect2D( & 3136 y_d_xt,y_d_q, & 3137 'pbl_surface_mod 2600',ntraciso,klon,klev) 3138 endif 3139 #endif 3140 #endif 2707 3141 2708 3142 ELSE !(iflag_split .eq.0) … … 2722 3156 flux_u_x(i,k,nsrf) = y_flux_u_x(j,k) 2723 3157 flux_v_x(i,k,nsrf) = y_flux_v_x(j,k) 3158 3159 #ifdef ISO 3160 DO ixt=1,ntraciso 3161 y_d_xt_x(ixt,j,k) = y_d_xt_x(ixt,j,k) * ypct(j) 3162 flux_xt_x(ixt,i,k,nsrf) = y_flux_xt_x(ixt,j,k) 3163 ENDDO ! DO ixt=1,ntraciso 3164 #endif 2724 3165 ENDDO 2725 3166 ENDDO … … 2739 3180 flux_u_w(i,k,nsrf) = y_flux_u_w(j,k) 2740 3181 flux_v_w(i,k,nsrf) = y_flux_v_w(j,k) 3182 3183 #ifdef ISO 3184 DO ixt=1,ntraciso 3185 y_d_xt_w(ixt,j,k) = y_d_xt_w(ixt,j,k) * ypct(j) 3186 flux_xt_w(ixt,i,k,nsrf) = y_flux_xt_w(ixt,j,k) 3187 ENDDO ! do ixt=1,ntraciso 3188 #endif 3189 2741 3190 ENDDO 2742 3191 ENDDO … … 2750 3199 flux_u(i,k,nsrf) = flux_u_x(i,k,nsrf)+ywake_s(j)*(flux_u_w(i,k,nsrf)-flux_u_x(i,k,nsrf)) 2751 3200 flux_v(i,k,nsrf) = flux_v_x(i,k,nsrf)+ywake_s(j)*(flux_v_w(i,k,nsrf)-flux_v_x(i,k,nsrf)) 3201 #ifdef ISO 3202 DO ixt=1,ntraciso 3203 flux_xt(ixt,i,k,nsrf) = flux_xt_x(ixt,i,k,nsrf)+ywake_s(j)*(flux_xt_w(ixt,i,k,nsrf)-flux_xt_x(ixt,i,k,nsrf)) 3204 ENDDO ! do ixt=1,ntraciso 3205 #endif 2752 3206 ENDDO 2753 3207 ENDDO … … 2807 3261 dflux_t(i) = dflux_t(i) + y_dflux_t(j)*ypct(j) 2808 3262 dflux_q(i) = dflux_q(i) + y_dflux_q(j)*ypct(j) 3263 #ifdef ISO 3264 DO ixt=1,niso 3265 xtsnow(ixt,i,nsrf) = yxtsnow(ixt,j) 3266 ENDDO 3267 DO ixt=1,ntraciso 3268 xtevap(ixt,i,nsrf) = - flux_xt(ixt,i,1,nsrf) 3269 dflux_xt(ixt,i) = dflux_xt(ixt,i) + y_dflux_xt(ixt,j)*ypct(j) 3270 ENDDO 3271 IF (nsrf == is_lic) THEN 3272 DO ixt=1,niso 3273 Rland_ice(ixt,i) = yRland_ice(ixt,j) 3274 ENDDO 3275 ENDIF !IF (nsrf == is_lic) THEN 3276 #ifdef ISOVERIF 3277 IF (iso_eau.gt.0) THEN 3278 call iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, & 3279 & 'pbl_surf_mod 1230',errmax,errmaxrel) 3280 ENDIF !if (iso_eau.gt.0) then 3281 #endif 3282 #endif 2809 3283 ENDDO 2810 3284 … … 2911 3385 i = ni(j) 2912 3386 qsol(i) = yqsol(j) 3387 #ifdef ISO 3388 runoff_diag(i)=yrunoff_diag(j) 3389 DO ixt=1,niso 3390 xtsol(ixt,i) = yxtsol(ixt,j) 3391 xtrunoff_diag(ixt,i)=yxtrunoff_diag(ixt,j) 3392 ENDDO 3393 #endif 2913 3394 ENDDO 2914 3395 ENDIF … … 2923 3404 ENDDO 2924 3405 ENDDO 2925 3406 3407 #ifdef ISO 3408 #ifdef ISOVERIF 3409 !write(*,*) 'pbl_surface 2858' 3410 DO i = 1, klon 3411 DO ixt=1,niso 3412 call iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 1405') 3413 ENDDO 3414 ENDDO 3415 #endif 3416 #ifdef ISOVERIF 3417 IF (iso_eau.gt.0) THEN 3418 call iso_verif_egalite_vect2D( & 3419 y_d_xt,y_d_q, & 3420 'pbl_surface_mod 1261',ntraciso,klon,klev) 3421 ENDIF !if (iso_eau.gt.0) then 3422 #endif 3423 #endif 2926 3424 !!! jyg le 07/02/2012 2927 3425 IF (iflag_split .ge.1) THEN … … 2942 3440 d_u_w(i,k) = d_u_w(i,k) + y_d_u_w(j,k) 2943 3441 d_v_w(i,k) = d_v_w(i,k) + y_d_v_w(j,k) 3442 #ifdef ISO 3443 DO ixt=1,ntraciso 3444 d_xt_x(ixt,i,k) = d_xt_x(ixt,i,k) + y_d_xt_x(ixt,j,k) 3445 d_xt_w(ixt,i,k) = d_xt_w(ixt,i,k) + y_d_xt_w(ixt,j,k) 3446 ENDDO ! DO ixt=1,ntraciso 3447 #endif 3448 2944 3449 ! 2945 3450 !! d_wake_dlt(i,k) = d_wake_dlt(i,k) + y_d_t_w(i,k)-y_d_t_x(i,k) … … 2957 3462 d_t(i,k) = d_t(i,k) + y_d_t(j,k) 2958 3463 d_q(i,k) = d_q(i,k) + y_d_q(j,k) 3464 #ifdef ISO 3465 DO ixt=1,ntraciso 3466 d_xt(ixt,i,k) = d_xt(ixt,i,k) + y_d_xt(ixt,j,k) 3467 ENDDO !DO ixt=1,ntraciso 3468 #endif 2959 3469 d_u(i,k) = d_u(i,k) + y_d_u(j,k) 2960 3470 d_v(i,k) = d_v(i,k) + y_d_v(j,k) … … 2971 3481 ENDDO 2972 3482 ENDIF 3483 3484 #ifdef ISO 3485 #ifdef ISOVERIF 3486 ! write(*,*) 'd_q,d_xt(iso_eau,554,19)=',d_q(554,19),d_xt(iso_eau,554,19) 3487 ! write(*,*) 'pbl_surface 2929: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1) 3488 ! write(*,*) 'y_d_q,y_d_xt(iso_eau,2,1)=',y_d_q(2,1),y_d_xt(iso_eau,2,1) 3489 ! write(*,*) 'iso_eau.gt.0=',iso_eau.gt.0 3490 call iso_verif_noNaN_vect2D( & 3491 & d_xt, & 3492 & 'pbl_surface 1385',ntraciso,klon,klev) 3493 IF (iso_eau >= 0) THEN 3494 call iso_verif_egalite_vect2D( & 3495 y_d_xt,y_d_q, & 3496 'pbl_surface_mod 2945',ntraciso,klon,klev) 3497 call iso_verif_egalite_vect2D( & 3498 d_xt,d_q, & 3499 'pbl_surface_mod 1276',ntraciso,klon,klev) 3500 ENDIF !IF (iso_eau >= 0) THEN 3501 #endif 3502 #endif 2973 3503 2974 3504 ! print*,'Dans pbl OK4' … … 3358 3888 iflag_split=iflag_split_ref 3359 3889 3890 #ifdef ISO 3891 #ifdef ISOVERIF 3892 ! write(*,*) 'pbl_surface tmp 3249: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1) 3893 IF (iso_eau >= 0) THEN 3894 call iso_verif_egalite_vect2D( & 3895 d_xt,d_q, & 3896 'pbl_surface_mod 1276',ntraciso,klon,klev) 3897 ENDIF !IF (iso_eau >= 0) THEN 3898 #endif 3899 #endif 3900 3360 3901 !**************************************************************************************** 3361 3902 ! 16) Calculate the mean value over all sub-surfaces for some variables … … 3379 3920 zxfluxt_w(:,:) = 0.0 ; zxfluxq_w(:,:) = 0.0 3380 3921 zxfluxu_w(:,:) = 0.0 ; zxfluxv_w(:,:) = 0.0 3922 #ifdef ISO 3923 zxfluxxt(:,:,:) = 0.0 3924 zxfluxxt_x(:,:,:) = 0.0 3925 zxfluxxt_w(:,:,:) = 0.0 3926 #endif 3927 3381 3928 3382 3929 !!! jyg le 07/02/2012 … … 3397 3944 zxfluxu_w(i,k) = zxfluxu_w(i,k) + flux_u_w(i,k,nsrf) * pctsrf(i,nsrf) 3398 3945 zxfluxv_w(i,k) = zxfluxv_w(i,k) + flux_v_w(i,k,nsrf) * pctsrf(i,nsrf) 3946 #ifdef ISO 3947 DO ixt=1,ntraciso 3948 zxfluxxt_x(ixt,i,k) = zxfluxxt_x(ixt,i,k) + flux_xt_x(ixt,i,k,nsrf) * pctsrf(i,nsrf) 3949 zxfluxxt_w(ixt,i,k) = zxfluxxt_w(ixt,i,k) + flux_xt_w(ixt,i,k,nsrf) * pctsrf(i,nsrf) 3950 ENDDO ! DO ixt=1,ntraciso 3951 #endif 3399 3952 ENDDO 3400 3953 ENDDO … … 3416 3969 zxfluxu(i,k) = zxfluxu(i,k) + flux_u(i,k,nsrf) * pctsrf(i,nsrf) 3417 3970 zxfluxv(i,k) = zxfluxv(i,k) + flux_v(i,k,nsrf) * pctsrf(i,nsrf) 3971 #ifdef ISO 3972 DO ixt=1,niso 3973 zxfluxxt(ixt,i,k) = zxfluxxt(ixt,i,k) + flux_xt(ixt,i,k,nsrf) * pctsrf(i,nsrf) 3974 ENDDO ! DO ixt=1,niso 3975 #endif 3418 3976 ENDDO 3419 3977 ENDDO … … 3440 3998 END DO 3441 3999 endif 4000 4001 #ifdef ISO 4002 DO i = 1, klon 4003 DO ixt=1,ntraciso 4004 zxxtevap(ixt,i) = - zxfluxxt(ixt,i,1) 4005 ENDDO 4006 ENDDO 4007 #endif 3442 4008 3443 4009 !!! … … 3615 4181 zxqsurf(:) = 0.0 3616 4182 zxsnow(:) = 0.0 4183 #ifdef ISO 4184 zxxtsnow(:,:) = 0.0 4185 #endif 4186 3617 4187 DO nsrf = 1, nbsrf 3618 4188 DO i = 1, klon 3619 4189 zxqsurf(i) = zxqsurf(i) + MAX(qsurf(i,nsrf),0.0) * pctsrf(i,nsrf) 3620 4190 zxsnow(i) = zxsnow(i) + snow(i,nsrf) * pctsrf(i,nsrf) 4191 #ifdef ISO 4192 DO ixt=1,niso 4193 zxxtsnow(ixt,i) = zxxtsnow(ixt,i) + xtsnow(ixt,i,nsrf) * pctsrf(i,nsrf) 4194 ENDDO ! DO ixt=1,niso 4195 #endif 3621 4196 ENDDO 3622 4197 ENDDO … … 3630 4205 !**************************************************************************************** 3631 4206 ! 3632 SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst) 4207 SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst & 4208 #ifdef ISO 4209 ,xtsnow_rst,Rland_ice_rst & 4210 #endif 4211 ) 3633 4212 3634 4213 USE indice_sol_mod 4214 #ifdef ISO 4215 #ifdef ISOVERIF 4216 USE isotopes_mod, ONLY: iso_eau,ridicule 4217 USE isotopes_verif_mod, ONLY: errmax,errmaxrel 4218 #endif 4219 #endif 3635 4220 3636 4221 INCLUDE "dimsoil.h" … … 3642 4227 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: qsurf_rst 3643 4228 REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(OUT) :: ftsoil_rst 4229 #ifdef ISO 4230 REAL, DIMENSION(niso,klon, nbsrf), INTENT(OUT) :: xtsnow_rst 4231 REAL, DIMENSION(niso,klon), INTENT(OUT) :: Rland_ice_rst 4232 #endif 3644 4233 3645 4234 … … 3652 4241 qsurf_rst(:,:) = qsurf(:,:) 3653 4242 ftsoil_rst(:,:,:) = ftsoil(:,:,:) 4243 #ifdef ISO 4244 xtsnow_rst(:,:,:) = xtsnow(:,:,:) 4245 Rland_ice_rst(:,:) = Rland_ice(:,:) 4246 #endif 3654 4247 3655 4248 !**************************************************************************************** … … 3664 4257 IF (ALLOCATED(ydTs0)) DEALLOCATE(ydTs0) 3665 4258 IF (ALLOCATED(ydqs0)) DEALLOCATE(ydqs0) 4259 #ifdef ISO 4260 IF (ALLOCATED(xtsnow)) DEALLOCATE(xtsnow) 4261 IF (ALLOCATED(Rland_ice)) DEALLOCATE(Rland_ice) 4262 IF (ALLOCATED(Roce)) DEALLOCATE(Roce) 4263 #endif 3666 4264 3667 4265 !jyg< … … 3682 4280 SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, & 3683 4281 evap, z0m, z0h, agesno, & 3684 tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke) 4282 tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke & 4283 #ifdef ISO 4284 ,xtevap & 4285 #endif 4286 & ) 3685 4287 !albedo SB <<< 3686 4288 ! Give default values where new fraction has appread … … 3711 4313 REAL, DIMENSION(klon,nbsrf+1), INTENT(INOUT) :: z0m,z0h 3712 4314 REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: tke 4315 #ifdef ISO 4316 REAL, DIMENSION(ntraciso,klon,nbsrf), INTENT(INOUT) :: xtevap 4317 #endif 3713 4318 3714 4319 ! Local variables … … 3718 4323 CHARACTER(len=20) :: modname = 'pbl_surface_newfrac' 3719 4324 INTEGER, DIMENSION(nbsrf) :: nfois=0, mfois=0, pfois=0 4325 #ifdef ISO 4326 INTEGER :: ixt 4327 #endif 3720 4328 ! 3721 4329 ! All at once !! … … 3763 4371 u10m(i,nsrf) = u10m(i,nsrf_comp1) 3764 4372 v10m(i,nsrf) = v10m(i,nsrf_comp1) 4373 #ifdef ISO 4374 DO ixt=1,ntraciso 4375 xtevap(ixt,i,nsrf) = xtevap(ixt,i,nsrf_comp1) 4376 ENDDO 4377 #endif 3765 4378 IF (iflag_pbl > 1) THEN 3766 4379 tke(i,:,nsrf) = tke(i,:,nsrf_comp1) … … 3818 4431 u10m(i,nsrf) = u10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + u10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3) 3819 4432 v10m(i,nsrf) = v10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + v10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3) 4433 #ifdef ISO 4434 DO ixt=1,ntraciso 4435 xtevap(ixt,i,nsrf) = xtevap(ixt,i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) & 4436 + xtevap(ixt,i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3) 4437 ENDDO 4438 #endif 3820 4439 IF (iflag_pbl > 1) THEN 3821 4440 tke(i,:,nsrf) = tke(i,:,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tke(i,:,nsrf_comp3)*pctsrf_old(i,nsrf_comp3) … … 3830 4449 agesno(i,nsrf) = 0. 3831 4450 ftsoil(i,:,nsrf) = tsurf(i,nsrf) 4451 #ifdef ISO 4452 xtsnow(:,i,nsrf) = 0. 4453 #endif 3832 4454 ELSE 3833 4455 pfois(nsrf) = pfois(nsrf)+ 1
Note: See TracChangeset
for help on using the changeset viewer.
