Changeset 5202 for LMDZ6/branches/cirrus/libf/phylmd/pbl_surface_mod.F90
- Timestamp:
- Sep 20, 2024, 12:32:04 PM (8 weeks ago)
- Location:
- LMDZ6/branches/cirrus
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/pbl_surface_mod.F90 (modified) (74 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/cirrus
- Property svn:mergeinfo changed
-
LMDZ6/branches/cirrus/libf/phylmd/pbl_surface_mod.F90
r4916 r5202 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) 53 65 INTEGER, SAVE :: iflag_new_t2mq2m 54 66 !$OMP THREADPRIVATE(iflag_new_t2mq2m) 67 LOGICAL, SAVE :: ok_bug_zg_wk_pbl 68 !$OMP THREADPRIVATE(ok_bug_zg_wk_pbl) 55 69 56 70 !FC … … 176 190 177 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 178 257 ! 179 258 !**************************************************************************************** … … 239 318 !FC 240 319 !!! 241 ) 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 & ) 242 328 !**************************************************************************************** 243 329 ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818 … … 314 400 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dto2d_glo 315 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 316 411 USE ioipsl_getin_p_mod, ONLY : getin_p 317 412 use phys_state_var_mod, only: ds_ns, dt_ns, delta_sst, delta_sal, dter, & … … 366 461 REAL, DIMENSION(klon), INTENT(IN) :: gustiness ! gustiness 367 462 368 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 369 470 370 471 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 … … 379 480 REAL, DIMENSION(klon), INTENT(IN) :: wake_dens 380 481 !!! 381 482 #ifdef ISO 483 REAL, DIMENSION(ntraciso,klon,klev), INTENT(IN) :: wake_dlxt 484 #endif 382 485 ! Input/Output variables 383 486 !**************************************************************************************** … … 448 551 REAL, INTENT(OUT):: zcoefm(:, :, :) ! (klon, klev, nbsrf + 1) 449 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 450 563 451 564 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 … … 511 624 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v ! v wind tension (kg m/s)/(m**2 s) or Pascal 512 625 !FC 513 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 514 632 515 633 … … 525 643 REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_qbs ! blowind snow vertical flux (kg/m**2 526 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 527 651 528 652 ! Martin … … 573 697 REAL, DIMENSION(klon) :: ysnow, yqsurf, yagesno, yqsol 574 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 575 707 REAL, DIMENSION(klon) :: ysolsw, ysollw 576 708 REAL, DIMENSION(klon) :: yfder … … 581 713 REAL, DIMENSION(klon) :: y_flux_t1, y_flux_q1 582 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 583 719 REAL, DIMENSION(klon) :: y_flux_u1, y_flux_v1 584 720 REAL, DIMENSION(klon) :: y_flux_bs, y_flux0 … … 608 744 REAL, DIMENSION(klon) :: AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0 609 745 REAL, DIMENSION(klon) :: AcoefH, AcoefQ, BcoefH, BcoefQ 746 #ifdef ISO 747 REAL, DIMENSION(ntraciso,klon) :: AcoefXT, BcoefXT 748 #endif 610 749 REAL, DIMENSION(klon) :: AcoefU, AcoefV, BcoefU, BcoefV 611 750 REAL, DIMENSION(klon) :: AcoefQBS, BcoefQBS … … 626 765 REAL, DIMENSION(klon,klev) :: yu, yv 627 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 628 773 REAL, DIMENSION(klon,klev) :: ypplay, ydelp 629 774 REAL, DIMENSION(klon,klev) :: delp … … 697 842 REAL, DIMENSION(klon,klev) :: Kcoef_hq_w, Kcoef_m_w, gama_h_w, gama_q_w 698 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 699 857 !!! 700 858 !!!jyg le 08/02/2012 … … 889 1047 REAL, DIMENSION(klon) :: yrmu0 890 1048 ! Martin 891 REAL, DIMENSIO n(klon) :: yri01049 REAL, DIMENSION(klon) :: yri0 892 1050 893 1051 REAL, DIMENSION(klon):: ydelta_sst, ydelta_sal, yds_ns, ydt_ns, ydter, & … … 896 1054 ! dt_ds, tkt, tks, taur, sss on ocean points 897 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 898 1064 !**************************************************************************************** 899 1065 ! End of declarations … … 924 1090 iflag_split = iflag_split_ref 925 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 1129 926 1130 !**************************************************************************************** 927 1131 ! 1) Initialisation and validation tests … … 935 1139 CALL getin_p('iflag_new_t2mq2m',iflag_new_t2mq2m) 936 1140 WRITE(lunout,*) 'pbl_iflag_new_t2mq2m=',iflag_new_t2mq2m 1141 1142 ok_bug_zg_wk_pbl=.TRUE. 1143 CALL getin_p('ok_bug_zg_wk_pbl',ok_bug_zg_wk_pbl) 1144 WRITE(lunout,*) 'ok_bug_zg_wk_pbl=',ok_bug_zg_wk_pbl 937 1145 938 1146 print*,'PBL SURFACE AVEC GUSTINESS' … … 984 1192 PRINT*,'WARNING : On impose qsol=',qsol0 985 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 986 1204 ENDIF 987 1205 !**************************************************************************************** … … 1034 1252 qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0. 1035 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 1036 1263 IF (iflag_pbl<20.or.iflag_pbl>=30) THEN 1037 1264 zcoefh(:,:,:) = 0.0 … … 1123 1350 !FC 1124 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 1125 1365 ! >> PC 1126 1366 !the yfields_out variable is defined in (klon,nbcf_out) even if it is used on … … 1149 1389 fluxlat_x(:,:)=0. ; fluxlat_w(:,:)=0. 1150 1390 !>jyg 1391 #ifdef ISO 1392 flux_xt_x(:,:,:,:)=0. ; flux_xt_w(:,:,:,:)=0. 1393 #endif 1151 1394 ! 1152 1395 !jyg< … … 1448 1691 yfluxbs(j)=0.0 1449 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 1450 1723 ENDDO 1451 1724 ! >> PC … … 1487 1760 yq(j,k) = q(i,k) 1488 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 1489 1767 ENDDO 1490 1768 ENDDO … … 1504 1782 yq_w(j,k) = q(i,k)+(1.-wake_s(i))*wake_dlq(i,k) 1505 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 1506 1790 ENDDO 1507 1791 ENDDO … … 1559 1843 i = ni(j) 1560 1844 yqsol(j) = qsol(i) 1845 #ifdef ISO 1846 DO ixt=1,niso 1847 yxtsol(ixt,j) = xtsol(ixt,i) 1848 ENDDO 1849 #endif 1561 1850 ENDDO 1562 1851 ENDIF … … 1664 1953 ycdragm_w, ycdragh_w, zri1_w, pref_w, rain_f, zxtsol, ypplay(:,1) ) 1665 1954 ! 1666 !!!bug !! zgeo1(:) = wake_s(:)*zgeo1_w(:) + (1.-wake_s(:))*zgeo1_x(:) 1667 zgeo1(1:knon) = wake_s(1:knon)*zgeo1_w(1:knon) + (1.-wake_s(1:knon))*zgeo1_x(1:knon) 1955 IF(ok_bug_zg_wk_pbl) THEN 1956 zgeo1(1:knon) = wake_s(1:knon)*zgeo1_w(1:knon) + (1.-wake_s(1:knon))*zgeo1_x(1:knon) 1957 ELSE 1958 zgeo1(1:knon) = ywake_s(1:knon)*zgeo1_w(1:knon) + (1.-ywake_s(1:knon))*zgeo1_x(1:knon) 1959 ENDIF 1668 1960 1669 1961 ! --- special Dice. JYG+MPL 25112013 puis BOMEX … … 1704 1996 1705 1997 IF (iflag_pbl>=50) THEN 1706 CALL call_atke(dtime,knon,klev, ycdragm(1:knon), ycdragh(1:knon),yus0(1:knon),yvs0(1:knon),yts(1:knon), &1998 CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm(1:knon), ycdragh(1:knon),yus0(1:knon),yvs0(1:knon),yts(1:knon), & 1707 1999 yu(1:knon,:),yv(1:knon,:),yt(1:knon,:),yq(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:), & 1708 2000 ytke(1:knon,:),yeps(1:knon,:), ycoefm(1:knon,:), ycoefh(1:knon,:)) … … 1749 2041 IF (iflag_pbl>=50) THEN 1750 2042 1751 CALL call_atke(dtime,knon,klev, ycdragm_x(1:knon),ycdragh_x(1:knon),yus0(1:knon),yvs0(1:knon),yts_x(1:knon), &2043 CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm_x(1:knon),ycdragh_x(1:knon),yus0(1:knon),yvs0(1:knon),yts_x(1:knon), & 1752 2044 yu_x(1:knon,:),yv_x(1:knon,:),yt_x(1:knon,:),yq_x(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:), & 1753 2045 ytke_x(1:knon,:),yeps_x(1:knon,:),ycoefm_x(1:knon,:), ycoefh_x(1:knon,:)) … … 1789 2081 IF (iflag_pbl>=50) THEN 1790 2082 1791 CALL call_atke(dtime,knon,klev, ycdragm_w(1:knon),ycdragh_w(1:knon),yus0(1:knon),yvs0(1:knon),yts_w(1:knon), &2083 CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm_w(1:knon),ycdragh_w(1:knon),yus0(1:knon),yvs0(1:knon),yts_w(1:knon), & 1792 2084 yu_w(1:knon,:),yv_w(1:knon,:),yt_w(1:knon,:),yq_w(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:), & 1793 2085 ytke_w(1:knon,:),yeps_w(1:knon,:),ycoefm_w(1:knon,:),ycoefh_w(1:knon,:)) … … 1850 2142 Kcoef_hq, gama_q, gama_h, & 1851 2143 !!! 1852 AcoefH, AcoefQ, BcoefH, BcoefQ) 2144 AcoefH, AcoefQ, BcoefH, BcoefQ & 2145 #ifdef ISO 2146 & ,yxt, CcoefXT, DcoefXT, gama_xt, AcoefXT, BcoefXT & 2147 #endif 2148 & ) 1853 2149 ELSE !(iflag_split .eq.0) 1854 2150 CALL climb_hq_down(knon, ycoefh_x, ypaprs, ypplay, & … … 1858 2154 Kcoef_hq_x, gama_q_x, gama_h_x, & 1859 2155 !!! 1860 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 & ) 1861 2161 !!! 1862 2162 IF (prt_level >=10) THEN … … 1873 2173 Kcoef_hq_w, gama_q_w, gama_h_w, & 1874 2174 !!! 1875 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 & ) 1876 2180 !!! 1877 2181 IF (prt_level >=10) THEN … … 1955 2259 yt1(:) = yt(:,1) 1956 2260 yq1(:) = yq(:,1) 2261 #ifdef ISO 2262 yxt1(:,:) = yxt(:,:,1) 2263 #endif 2264 1957 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 1958 2270 ! 1959 2271 ! Cdragq computation … … 2117 2429 yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, & 2118 2430 y_flux_u1, y_flux_v1, & 2119 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 & ) 2120 2438 2121 2439 !FC quid qd yveget ylai yheight ne sont pas definit … … 2147 2465 ENDDO 2148 2466 ENDIF 2149 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 2150 2490 CASE(is_lic) 2151 2491 ! Martin … … 2168 2508 ysnowhgt, yqsnow, ytoice, ysissnow, & 2169 2509 yalb3_new, yrunoff, & 2170 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 & ) 2171 2516 2172 2517 !jyg< … … 2190 2535 ENDDO 2191 2536 ENDIF 2192 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 2193 2560 END IF 2194 2561 … … 2207 2574 y_flux_u1, y_flux_v1, ydelta_sst(:knon), ydelta_sal(:knon), & 2208 2575 yds_ns(:knon), ydt_ns(:knon), ydter(:knon), ydser(:knon), & 2209 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 & ) 2210 2582 IF (prt_level >=10) THEN 2211 2583 print *,'arg de surf_ocean: ycdragh ',ycdragh(1:knon) … … 2248 2620 !albedo SB <<< 2249 2621 ytsurf_new, y_dflux_t, y_dflux_q, & 2250 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 & ) 2251 2628 2252 2629 ! Special DICE MPL 05082013 puis BOMEX MPL 20150410 … … 2256 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) 2257 2634 ENDDO 2258 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 2259 2658 2260 2659 CASE DEFAULT … … 2316 2715 yt1_new=(1./RCPD)*(AcoefH(j)+BcoefH(j)*y_flux_t1(j)*dtime) 2317 2716 ytsurf_new(j)=yt1_new-y_flux_t1(j)/(Kech_h(j)*RCPD) 2717 ! for cases forced in flux and for which forcing in Ts is needed 2718 ! to prevent the latter to reach unrealistic value (even if not used, 2719 ! Ts is calculated and hgardfou can appear during the calculation 2720 ! of surface saturation humidity for example 2721 if (ok_forc_tsurf) ytsurf_new(j)=tg 2318 2722 ENDDO 2319 2723 … … 2326 2730 y_flux_t1(j) = yfluxsens(j) 2327 2731 y_flux_q1(j) = -yevap(j) 2732 #ifdef ISO 2733 y_flux_xt1(:,:) = -yxtevap(:,:) 2734 #endif 2328 2735 ENDDO 2329 2736 ENDIF ! (ok_flux_surf) … … 2341 2748 2342 2749 IF (iflag_split .GE. 1) THEN 2750 #ifdef ISO 2751 call abort_gcm('pbl_surface_mod 2607','isos pas encore dans iflag_split=1',1) 2752 #endif 2753 ! 2343 2754 ! 2344 2755 IF (nsrf .ne. is_oce) THEN … … 2558 2969 Kcoef_hq, gama_q, gama_h, & 2559 2970 !!! 2560 y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:)) 2971 y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:) & 2972 #ifdef ISO 2973 & ,yxt,y_flux_xt1 & 2974 & ,AcoefXT,BcoefXT,CcoefXT,DcoefXT,gama_xt & 2975 & ,y_flux_xt(:,:,:),y_d_xt(:,:,:) & 2976 #endif 2977 & ) 2561 2978 ELSE !(iflag_split .eq.0) 2562 2979 CALL climb_hq_up(knon, dtime, yt_x, yq_x, & … … 2567 2984 Kcoef_hq_x, gama_q_x, gama_h_x, & 2568 2985 !!! 2569 y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:)) 2986 y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:) & 2987 #ifdef ISO 2988 & ,yxt_x,y_flux_xt1_x & 2989 & ,AcoefXT_x,BcoefXT_x,CcoefXT_x,DcoefXT_x,gama_xt_x & 2990 & ,y_flux_xt_x(:,:,:),y_d_xt_x(:,:,:) & 2991 #endif 2992 & ) 2570 2993 ! 2571 2994 CALL climb_hq_up(knon, dtime, yt_w, yq_w, & … … 2576 2999 Kcoef_hq_w, gama_q_w, gama_h_w, & 2577 3000 !!! 2578 y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:)) 3001 y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:) & 3002 #ifdef ISO 3003 & ,yxt_w,y_flux_xt1_w & 3004 & ,AcoefXT_w,BcoefXT_w,CcoefXT_w,DcoefXT_w,gama_xt_w & 3005 & ,y_flux_xt_w(:,:,:),y_d_xt_w(:,:,:) & 3006 #endif 3007 & ) 2579 3008 !!! 2580 3009 ENDIF ! (iflag_split .eq.0) … … 2694 3123 flux_u(i,k,nsrf) = y_flux_u(j,k) 2695 3124 flux_v(i,k,nsrf) = y_flux_v(j,k) 3125 3126 #ifdef ISO 3127 DO ixt=1,ntraciso 3128 y_d_xt(ixt,j,k) = y_d_xt(ixt,j,k) * ypct(j) 3129 flux_xt(ixt,i,k,nsrf) = y_flux_xt(ixt,j,k) 3130 ENDDO ! DO ixt=1,ntraciso 3131 h1_diag(i)=h1(j) 3132 #endif 3133 2696 3134 ENDDO 2697 3135 ENDDO 3136 3137 #ifdef ISO 3138 #ifdef ISOVERIF 3139 if (iso_eau.gt.0) then 3140 call iso_verif_egalite_vect2D( & 3141 y_d_xt,y_d_q, & 3142 'pbl_surface_mod 2600',ntraciso,klon,klev) 3143 endif 3144 #endif 3145 #endif 2698 3146 2699 3147 ELSE !(iflag_split .eq.0) … … 2713 3161 flux_u_x(i,k,nsrf) = y_flux_u_x(j,k) 2714 3162 flux_v_x(i,k,nsrf) = y_flux_v_x(j,k) 3163 3164 #ifdef ISO 3165 DO ixt=1,ntraciso 3166 y_d_xt_x(ixt,j,k) = y_d_xt_x(ixt,j,k) * ypct(j) 3167 flux_xt_x(ixt,i,k,nsrf) = y_flux_xt_x(ixt,j,k) 3168 ENDDO ! DO ixt=1,ntraciso 3169 #endif 2715 3170 ENDDO 2716 3171 ENDDO … … 2730 3185 flux_u_w(i,k,nsrf) = y_flux_u_w(j,k) 2731 3186 flux_v_w(i,k,nsrf) = y_flux_v_w(j,k) 3187 3188 #ifdef ISO 3189 DO ixt=1,ntraciso 3190 y_d_xt_w(ixt,j,k) = y_d_xt_w(ixt,j,k) * ypct(j) 3191 flux_xt_w(ixt,i,k,nsrf) = y_flux_xt_w(ixt,j,k) 3192 ENDDO ! do ixt=1,ntraciso 3193 #endif 3194 2732 3195 ENDDO 2733 3196 ENDDO … … 2741 3204 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)) 2742 3205 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)) 3206 #ifdef ISO 3207 DO ixt=1,ntraciso 3208 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)) 3209 ENDDO ! do ixt=1,ntraciso 3210 #endif 2743 3211 ENDDO 2744 3212 ENDDO … … 2798 3266 dflux_t(i) = dflux_t(i) + y_dflux_t(j)*ypct(j) 2799 3267 dflux_q(i) = dflux_q(i) + y_dflux_q(j)*ypct(j) 3268 #ifdef ISO 3269 DO ixt=1,niso 3270 xtsnow(ixt,i,nsrf) = yxtsnow(ixt,j) 3271 ENDDO 3272 DO ixt=1,ntraciso 3273 xtevap(ixt,i,nsrf) = - flux_xt(ixt,i,1,nsrf) 3274 dflux_xt(ixt,i) = dflux_xt(ixt,i) + y_dflux_xt(ixt,j)*ypct(j) 3275 ENDDO 3276 IF (nsrf == is_lic) THEN 3277 DO ixt=1,niso 3278 Rland_ice(ixt,i) = yRland_ice(ixt,j) 3279 ENDDO 3280 ENDIF !IF (nsrf == is_lic) THEN 3281 #ifdef ISOVERIF 3282 IF (iso_eau.gt.0) THEN 3283 call iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, & 3284 & 'pbl_surf_mod 1230',errmax,errmaxrel) 3285 ENDIF !if (iso_eau.gt.0) then 3286 #endif 3287 #endif 2800 3288 ENDDO 2801 3289 … … 2902 3390 i = ni(j) 2903 3391 qsol(i) = yqsol(j) 3392 #ifdef ISO 3393 runoff_diag(i)=yrunoff_diag(j) 3394 DO ixt=1,niso 3395 xtsol(ixt,i) = yxtsol(ixt,j) 3396 xtrunoff_diag(ixt,i)=yxtrunoff_diag(ixt,j) 3397 ENDDO 3398 #endif 2904 3399 ENDDO 2905 3400 ENDIF … … 2914 3409 ENDDO 2915 3410 ENDDO 2916 3411 3412 #ifdef ISO 3413 #ifdef ISOVERIF 3414 !write(*,*) 'pbl_surface 2858' 3415 DO i = 1, klon 3416 DO ixt=1,niso 3417 call iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 1405') 3418 ENDDO 3419 ENDDO 3420 #endif 3421 #ifdef ISOVERIF 3422 IF (iso_eau.gt.0) THEN 3423 call iso_verif_egalite_vect2D( & 3424 y_d_xt,y_d_q, & 3425 'pbl_surface_mod 1261',ntraciso,klon,klev) 3426 ENDIF !if (iso_eau.gt.0) then 3427 #endif 3428 #endif 2917 3429 !!! jyg le 07/02/2012 2918 3430 IF (iflag_split .ge.1) THEN … … 2933 3445 d_u_w(i,k) = d_u_w(i,k) + y_d_u_w(j,k) 2934 3446 d_v_w(i,k) = d_v_w(i,k) + y_d_v_w(j,k) 3447 #ifdef ISO 3448 DO ixt=1,ntraciso 3449 d_xt_x(ixt,i,k) = d_xt_x(ixt,i,k) + y_d_xt_x(ixt,j,k) 3450 d_xt_w(ixt,i,k) = d_xt_w(ixt,i,k) + y_d_xt_w(ixt,j,k) 3451 ENDDO ! DO ixt=1,ntraciso 3452 #endif 3453 2935 3454 ! 2936 3455 !! d_wake_dlt(i,k) = d_wake_dlt(i,k) + y_d_t_w(i,k)-y_d_t_x(i,k) … … 2948 3467 d_t(i,k) = d_t(i,k) + y_d_t(j,k) 2949 3468 d_q(i,k) = d_q(i,k) + y_d_q(j,k) 3469 #ifdef ISO 3470 DO ixt=1,ntraciso 3471 d_xt(ixt,i,k) = d_xt(ixt,i,k) + y_d_xt(ixt,j,k) 3472 ENDDO !DO ixt=1,ntraciso 3473 #endif 2950 3474 d_u(i,k) = d_u(i,k) + y_d_u(j,k) 2951 3475 d_v(i,k) = d_v(i,k) + y_d_v(j,k) … … 2962 3486 ENDDO 2963 3487 ENDIF 3488 3489 #ifdef ISO 3490 #ifdef ISOVERIF 3491 ! write(*,*) 'd_q,d_xt(iso_eau,554,19)=',d_q(554,19),d_xt(iso_eau,554,19) 3492 ! write(*,*) 'pbl_surface 2929: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1) 3493 ! write(*,*) 'y_d_q,y_d_xt(iso_eau,2,1)=',y_d_q(2,1),y_d_xt(iso_eau,2,1) 3494 ! write(*,*) 'iso_eau.gt.0=',iso_eau.gt.0 3495 call iso_verif_noNaN_vect2D( & 3496 & d_xt, & 3497 & 'pbl_surface 1385',ntraciso,klon,klev) 3498 IF (iso_eau >= 0) THEN 3499 call iso_verif_egalite_vect2D( & 3500 y_d_xt,y_d_q, & 3501 'pbl_surface_mod 2945',ntraciso,klon,klev) 3502 call iso_verif_egalite_vect2D( & 3503 d_xt,d_q, & 3504 'pbl_surface_mod 1276',ntraciso,klon,klev) 3505 ENDIF !IF (iso_eau >= 0) THEN 3506 #endif 3507 #endif 2964 3508 2965 3509 ! print*,'Dans pbl OK4' … … 3349 3893 iflag_split=iflag_split_ref 3350 3894 3895 #ifdef ISO 3896 #ifdef ISOVERIF 3897 ! write(*,*) 'pbl_surface tmp 3249: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1) 3898 IF (iso_eau >= 0) THEN 3899 call iso_verif_egalite_vect2D( & 3900 d_xt,d_q, & 3901 'pbl_surface_mod 1276',ntraciso,klon,klev) 3902 ENDIF !IF (iso_eau >= 0) THEN 3903 #endif 3904 #endif 3905 3351 3906 !**************************************************************************************** 3352 3907 ! 16) Calculate the mean value over all sub-surfaces for some variables … … 3370 3925 zxfluxt_w(:,:) = 0.0 ; zxfluxq_w(:,:) = 0.0 3371 3926 zxfluxu_w(:,:) = 0.0 ; zxfluxv_w(:,:) = 0.0 3927 #ifdef ISO 3928 zxfluxxt(:,:,:) = 0.0 3929 zxfluxxt_x(:,:,:) = 0.0 3930 zxfluxxt_w(:,:,:) = 0.0 3931 #endif 3932 3372 3933 3373 3934 !!! jyg le 07/02/2012 … … 3388 3949 zxfluxu_w(i,k) = zxfluxu_w(i,k) + flux_u_w(i,k,nsrf) * pctsrf(i,nsrf) 3389 3950 zxfluxv_w(i,k) = zxfluxv_w(i,k) + flux_v_w(i,k,nsrf) * pctsrf(i,nsrf) 3951 #ifdef ISO 3952 DO ixt=1,ntraciso 3953 zxfluxxt_x(ixt,i,k) = zxfluxxt_x(ixt,i,k) + flux_xt_x(ixt,i,k,nsrf) * pctsrf(i,nsrf) 3954 zxfluxxt_w(ixt,i,k) = zxfluxxt_w(ixt,i,k) + flux_xt_w(ixt,i,k,nsrf) * pctsrf(i,nsrf) 3955 ENDDO ! DO ixt=1,ntraciso 3956 #endif 3390 3957 ENDDO 3391 3958 ENDDO … … 3407 3974 zxfluxu(i,k) = zxfluxu(i,k) + flux_u(i,k,nsrf) * pctsrf(i,nsrf) 3408 3975 zxfluxv(i,k) = zxfluxv(i,k) + flux_v(i,k,nsrf) * pctsrf(i,nsrf) 3976 #ifdef ISO 3977 DO ixt=1,niso 3978 zxfluxxt(ixt,i,k) = zxfluxxt(ixt,i,k) + flux_xt(ixt,i,k,nsrf) * pctsrf(i,nsrf) 3979 ENDDO ! DO ixt=1,niso 3980 #endif 3409 3981 ENDDO 3410 3982 ENDDO … … 3431 4003 END DO 3432 4004 endif 4005 4006 #ifdef ISO 4007 DO i = 1, klon 4008 DO ixt=1,ntraciso 4009 zxxtevap(ixt,i) = - zxfluxxt(ixt,i,1) 4010 ENDDO 4011 ENDDO 4012 #endif 3433 4013 3434 4014 !!! … … 3606 4186 zxqsurf(:) = 0.0 3607 4187 zxsnow(:) = 0.0 4188 #ifdef ISO 4189 zxxtsnow(:,:) = 0.0 4190 #endif 4191 3608 4192 DO nsrf = 1, nbsrf 3609 4193 DO i = 1, klon 3610 4194 zxqsurf(i) = zxqsurf(i) + MAX(qsurf(i,nsrf),0.0) * pctsrf(i,nsrf) 3611 4195 zxsnow(i) = zxsnow(i) + snow(i,nsrf) * pctsrf(i,nsrf) 4196 #ifdef ISO 4197 DO ixt=1,niso 4198 zxxtsnow(ixt,i) = zxxtsnow(ixt,i) + xtsnow(ixt,i,nsrf) * pctsrf(i,nsrf) 4199 ENDDO ! DO ixt=1,niso 4200 #endif 3612 4201 ENDDO 3613 4202 ENDDO … … 3621 4210 !**************************************************************************************** 3622 4211 ! 3623 SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst) 4212 SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst & 4213 #ifdef ISO 4214 ,xtsnow_rst,Rland_ice_rst & 4215 #endif 4216 ) 3624 4217 3625 4218 USE indice_sol_mod 4219 #ifdef ISO 4220 #ifdef ISOVERIF 4221 USE isotopes_mod, ONLY: iso_eau,ridicule 4222 USE isotopes_verif_mod, ONLY: errmax,errmaxrel 4223 #endif 4224 #endif 3626 4225 3627 4226 INCLUDE "dimsoil.h" … … 3633 4232 REAL, DIMENSION(klon, nbsrf), INTENT(OUT) :: qsurf_rst 3634 4233 REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(OUT) :: ftsoil_rst 4234 #ifdef ISO 4235 REAL, DIMENSION(niso,klon, nbsrf), INTENT(OUT) :: xtsnow_rst 4236 REAL, DIMENSION(niso,klon), INTENT(OUT) :: Rland_ice_rst 4237 #endif 3635 4238 3636 4239 … … 3643 4246 qsurf_rst(:,:) = qsurf(:,:) 3644 4247 ftsoil_rst(:,:,:) = ftsoil(:,:,:) 4248 #ifdef ISO 4249 xtsnow_rst(:,:,:) = xtsnow(:,:,:) 4250 Rland_ice_rst(:,:) = Rland_ice(:,:) 4251 #endif 3645 4252 3646 4253 !**************************************************************************************** … … 3655 4262 IF (ALLOCATED(ydTs0)) DEALLOCATE(ydTs0) 3656 4263 IF (ALLOCATED(ydqs0)) DEALLOCATE(ydqs0) 4264 #ifdef ISO 4265 IF (ALLOCATED(xtsnow)) DEALLOCATE(xtsnow) 4266 IF (ALLOCATED(Rland_ice)) DEALLOCATE(Rland_ice) 4267 IF (ALLOCATED(Roce)) DEALLOCATE(Roce) 4268 #endif 3657 4269 3658 4270 !jyg< … … 3673 4285 SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, & 3674 4286 evap, z0m, z0h, agesno, & 3675 tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke) 4287 tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke & 4288 #ifdef ISO 4289 ,xtevap & 4290 #endif 4291 & ) 3676 4292 !albedo SB <<< 3677 4293 ! Give default values where new fraction has appread … … 3702 4318 REAL, DIMENSION(klon,nbsrf+1), INTENT(INOUT) :: z0m,z0h 3703 4319 REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: tke 4320 #ifdef ISO 4321 REAL, DIMENSION(ntraciso,klon,nbsrf), INTENT(INOUT) :: xtevap 4322 #endif 3704 4323 3705 4324 ! Local variables … … 3709 4328 CHARACTER(len=20) :: modname = 'pbl_surface_newfrac' 3710 4329 INTEGER, DIMENSION(nbsrf) :: nfois=0, mfois=0, pfois=0 4330 #ifdef ISO 4331 INTEGER :: ixt 4332 #endif 3711 4333 ! 3712 4334 ! All at once !! … … 3754 4376 u10m(i,nsrf) = u10m(i,nsrf_comp1) 3755 4377 v10m(i,nsrf) = v10m(i,nsrf_comp1) 4378 #ifdef ISO 4379 DO ixt=1,ntraciso 4380 xtevap(ixt,i,nsrf) = xtevap(ixt,i,nsrf_comp1) 4381 ENDDO 4382 #endif 3756 4383 IF (iflag_pbl > 1) THEN 3757 4384 tke(i,:,nsrf) = tke(i,:,nsrf_comp1) … … 3809 4436 u10m(i,nsrf) = u10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + u10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3) 3810 4437 v10m(i,nsrf) = v10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + v10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3) 4438 #ifdef ISO 4439 DO ixt=1,ntraciso 4440 xtevap(ixt,i,nsrf) = xtevap(ixt,i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) & 4441 + xtevap(ixt,i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3) 4442 ENDDO 4443 #endif 3811 4444 IF (iflag_pbl > 1) THEN 3812 4445 tke(i,:,nsrf) = tke(i,:,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tke(i,:,nsrf_comp3)*pctsrf_old(i,nsrf_comp3) … … 3821 4454 agesno(i,nsrf) = 0. 3822 4455 ftsoil(i,:,nsrf) = tsurf(i,nsrf) 4456 #ifdef ISO 4457 xtsnow(:,i,nsrf) = 0. 4458 #endif 3823 4459 ELSE 3824 4460 pfois(nsrf) = pfois(nsrf)+ 1
Note: See TracChangeset
for help on using the changeset viewer.
