- Timestamp:
- Jul 24, 2024, 4:23:34 PM (4 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/pbl_surface_mod.F90
r5116 r5117 30 30 USE wx_pbl_mod, ONLY: wx_pbl0_merge, wx_pbl_split, wx_pbl_dts_merge, & 31 31 wx_pbl_check, wx_pbl_dts_check, wx_evappot 32 useconfig_ocean_skin_m, ONLY: activate_ocean_skin32 USE config_ocean_skin_m, ONLY: activate_ocean_skin 33 33 USE lmdz_abort_physic, ONLY: abort_physic 34 34 #ifdef ISO … … 68 68 69 69 !FC 70 ! integer, save :: iflag_frein70 ! INTEGER, save :: iflag_frein 71 71 ! !$OMP THREADPRIVATE(iflag_frein) 72 72 … … 217 217 CHARACTER(len=80) :: abort_message 218 218 CHARACTER(len = 20) :: modname = 'pbl_surface_init' 219 integeri,ixt219 INTEGER i,ixt 220 220 221 221 !**************************************************************************************** … … 393 393 USE carbon_cycle_mod, ONLY: carbon_cycle_cpl, carbon_cycle_tr, level_coupling_esm 394 394 USE carbon_cycle_mod, ONLY: co2_send, nbcf_out, fields_out, yfields_out, cfname_out 395 usehbtm_mod, ONLY: hbtm395 USE hbtm_mod, ONLY: hbtm 396 396 USE indice_sol_mod 397 397 USE time_phylmdz_mod, ONLY: day_ini, annee_ref, itau_phy … … 408 408 #endif 409 409 USE lmdz_ioipsl_getin_p, ONLY:getin_p 410 usephys_state_var_mod, ONLY: ds_ns, dt_ns, delta_sst, delta_sal, dter, &410 USE phys_state_var_mod, ONLY: ds_ns, dt_ns, delta_sst, delta_sal, dter, & 411 411 dser, dt_ds, zsig, zmea 412 usephys_output_var_mod, ONLY: tkt, tks, taur, sss413 uselmdz_blowing_snow_ini, ONLY: zeta_bs414 USE wxios, ONLY: missing_val_xios => missing_val, using_xios412 USE phys_output_var_mod, ONLY: tkt, tks, taur, sss 413 USE lmdz_blowing_snow_ini, ONLY: zeta_bs 414 USE lmdz_wxios, ONLY: missing_val_xios => missing_val, using_xios 415 415 USE netcdf, ONLY: missing_val_netcdf => nf90_fill_real 416 416 … … 487 487 !wake and off-wake regions 488 488 !albedo SB >>> 489 REAL, DIMENSIOn(6), intent(in) :: SFRWL489 REAL, DIMENSIOn(6), INTENT(IN) :: SFRWL 490 490 REAL, DIMENSION(klon, nsw, nbsrf), INTENT(INOUT) :: alb_dir, alb_dif 491 491 !albedo SB <<< … … 1254 1254 xtevap(:,:,:)=0. 1255 1255 #endif 1256 IF (iflag_pbl<20. or.iflag_pbl>=30) THEN1256 IF (iflag_pbl<20.OR.iflag_pbl>=30) THEN 1257 1257 zcoefh(:, :, :) = 0.0 1258 1258 zcoefh(:, 1, :) = 999999. ! zcoefh(:,k=1) should never be used … … 1844 1844 ENDIF 1845 1845 1846 if (nsrf == is_oce .and. activate_ocean_skin >= 1) THEN1847 if (activate_ocean_skin == 2 .and. type_ocean == "couple") THEN1846 IF (nsrf == is_oce .AND. activate_ocean_skin >= 1) THEN 1847 IF (activate_ocean_skin == 2 .AND. type_ocean == "couple") THEN 1848 1848 ydelta_sal(:knon) = delta_sal(ni(:knon)) 1849 1849 ydelta_sst(:knon) = delta_sst(ni(:knon)) … … 1899 1899 1900 1900 IF (prt_level >=10) print *, 'cdrag -> ycdragh ', ycdragh(1:knon) 1901 ELSE !(iflag_split . eq.0)1901 ELSE !(iflag_split .EQ.0) 1902 1902 1903 1903 ! Faire disparaitre les lignes commentees fin 2015 (le temps des tests) … … 1962 1962 IF (prt_level >=10) print *, 'clcdrag -> ycdragh_w ', ycdragh_w(1:knon) 1963 1963 !!! 1964 ENDIF ! (iflag_split . eq.0)1964 ENDIF ! (iflag_split .EQ.0) 1965 1965 !!! 1966 1966 … … 2014 2014 IF (prt_level >=10) print *, 'coef_diff_turb -> ycoefh ', ycoefh(1:knon, :) 2015 2015 2016 ELSE !(iflag_split . eq.0)2016 ELSE !(iflag_split .EQ.0) 2017 2017 2018 2018 IF (prt_level >=10) THEN … … 2105 2105 ENDDO 2106 2106 2107 ENDIF ! (iflag_split . eq.0)2107 ENDIF ! (iflag_split .EQ.0) 2108 2108 2109 2109 … … 2134 2134 #endif 2135 2135 ) 2136 ELSE !(iflag_split . eq.0)2136 ELSE !(iflag_split .EQ.0) 2137 2137 CALL climb_hq_down(knon, ycoefh_x, ypaprs, ypplay, & 2138 2138 ydelp, yt_x, yq_x, dtime, & … … 2173 2173 ENDIF 2174 2174 !!! 2175 ENDIF ! (iflag_split . eq.0)2175 ENDIF ! (iflag_split .EQ.0) 2176 2176 !!! 2177 2177 … … 2186 2186 !!! 2187 2187 AcoefU, AcoefV, BcoefU, BcoefV) 2188 ELSE ! (iflag_split . eq.0)2188 ELSE ! (iflag_split .EQ.0) 2189 2189 CALL climb_wind_down(knon, dtime, ycoefm_x, ypplay, ypaprs, yt_x, ydelp, yu_x, yv_x, & 2190 2190 !!! nrlmd le 02/05/2011 … … 2201 2201 AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w) 2202 2202 !!! 2203 ENDIF ! (iflag_split . eq.0)2203 ENDIF ! (iflag_split .EQ.0) 2204 2204 !!! 2205 2205 … … 2265 2265 !****************************************************************************** 2266 2266 2267 IF (f_z0qh_oce /= 1. . and. nsrf ==is_oce) THEN2267 IF (f_z0qh_oce /= 1. .AND. nsrf ==is_oce) THEN 2268 2268 ! Si on suit les formulations par exemple de Tessel, on 2269 2269 ! a z0h=0.4*nu/u*, z0q=0.62*nu/u*, d'ou f_z0qh_oce=0.62/0.4=1.55 … … 2286 2286 ycdragq_x(1:knon) = ycdragh_x(1:knon) 2287 2287 ycdragq_w(1:knon) = ycdragh_w(1:knon) 2288 ENDIF ! ( f_z0qh_oce . ne. 1. .and. nsrf .eq.is_oce)2288 ENDIF ! ( f_z0qh_oce .NE. 1. .AND. nsrf .EQ.is_oce) 2289 2289 2290 2290 CALL wx_pbl_prelim_0(knon, nsrf, dtime, ypplay, ypaprs, ywake_s, & … … 2342 2342 ydTs_ins(:) = 0. 2343 2343 ydqs_ins(:) = 0. 2344 ENDIF ! (iflag_split . eq. 2)2345 ENDIF ! (iflag_split . eq.0)2344 ENDIF ! (iflag_split .EQ. 2) 2345 ENDIF ! (iflag_split .EQ.0) 2346 2346 !!! 2347 2347 IF (prt_level >=10) THEN … … 2691 2691 2692 2692 !! Test sur iflag_split retire le 2/02/2018, sans vraiment comprendre la raison de ce test. (jyg) 2693 !! IF (iflag_split . eq.0) THEN2693 !! IF (iflag_split .EQ.0) THEN 2694 2694 DO j = 1, knon 2695 2695 Kech_h(j) = ycdragh(j) * (1.0 + SQRT(yu(j, 1)**2 + yv(j, 1)**2)) * & 2696 2696 ypplay(j, 1) / (RD * yt(j, 1)) 2697 2697 ENDDO 2698 !! ENDIF ! (iflag_split . eq.0)2698 !! ENDIF ! (iflag_split .EQ.0) 2699 2699 2700 2700 DO j = 1, knon … … 2800 2800 ydTs_ins(:) = 0. 2801 2801 ydqs_ins(:) = 0. 2802 ENDIF ! (iflag_split . eq. 2)2803 2804 ELSE ! (nsrf . ne. is_oce)2802 ENDIF ! (iflag_split .EQ. 2) 2803 2804 ELSE ! (nsrf .NE. is_oce) 2805 2805 ybeta(1:knon) = 1. 2806 2806 yevap_pot(1:knon) = yevap(1:knon) … … 2815 2815 ydTs_ins(:) = 0. 2816 2816 ydqs_ins(:) = 0. 2817 ENDIF ! (nsrf . ne. is_oce)2817 ENDIF ! (nsrf .NE. is_oce) 2818 2818 2819 2819 CALL wx_pbl_split(knon, nsrf, dtime, ywake_s, ybeta, iflag_split, & … … 2862 2862 y_flux_t1_x, y_flux_t1_w, & 2863 2863 y_flux_q1_x, y_flux_q1_w) 2864 ENDIF ! (nsrf . ne. is_oce)2864 ENDIF ! (nsrf .NE. is_oce) 2865 2865 2866 2866 ELSE ! (iflag_split .ge. 1) … … 2882 2882 !!jyg!! 2883 2883 !!jyg!!!----Diffusion dans le sol dans le cas continental seulement 2884 !!jyg!! IF (nsrf. eq.is_ter) THEN2884 !!jyg!! IF (nsrf.EQ.is_ter) THEN 2885 2885 !!jyg!!!----Calcul du coefficient delta_coeff 2886 2886 !!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))) … … 2956 2956 #endif 2957 2957 ) 2958 ELSE !(iflag_split . eq.0)2958 ELSE !(iflag_split .EQ.0) 2959 2959 CALL climb_hq_up(knon, dtime, yt_x, yq_x, & 2960 2960 y_flux_q1_x, y_flux_t1_x, ypaprs, ypplay, & … … 2987 2987 ) 2988 2988 !!! 2989 ENDIF ! (iflag_split . eq.0)2989 ENDIF ! (iflag_split .EQ.0) 2990 2990 !!! 2991 2991 … … 3002 3002 y_flux_u, y_flux_v, y_d_u, y_d_v) 3003 3003 y_d_t_diss(:, :) = 0. 3004 IF (iflag_pbl>=20 . and. iflag_pbl<30) THEN3004 IF (iflag_pbl>=20 .AND. iflag_pbl<30) THEN 3005 3005 CALL yamada_c(knon, dtime, ypaprs, ypplay & 3006 3006 , yu, yv, yt, y_d_u, y_d_v, y_d_t, ycdragm, ytke, ycoefm, ycoefh, ycoefq, y_d_t_diss, yustar & … … 3009 3009 ! PRINT*,'yamada_c OK' 3010 3010 3011 ELSE !(iflag_split . eq.0)3011 ELSE !(iflag_split .EQ.0) 3012 3012 CALL climb_wind_up(knon, dtime, yu_x, yv_x, y_flux_u1_x, y_flux_v1_x, & 3013 3013 !!! nrlmd le 02/05/2011 … … 3019 3019 3020 3020 y_d_t_diss_x(:, :) = 0. 3021 IF (iflag_pbl>=20 . and. iflag_pbl<30) THEN3021 IF (iflag_pbl>=20 .AND. iflag_pbl<30) THEN 3022 3022 CALL yamada_c(knon, dtime, ypaprs, ypplay & 3023 3023 , yu_x, yv_x, yt_x, y_d_u_x, y_d_v_x, y_d_t_x, ycdragm_x, ytke_x, ycoefm_x, ycoefh_x & … … 3036 3036 !!! 3037 3037 y_d_t_diss_w(:, :) = 0. 3038 IF (iflag_pbl>=20 . and. iflag_pbl<30) THEN3038 IF (iflag_pbl>=20 .AND. iflag_pbl<30) THEN 3039 3039 CALL yamada_c(knon, dtime, ypaprs, ypplay & 3040 3040 , yu_w, yv_w, yt_w, y_d_u_w, y_d_v_w, y_d_t_w, ycdragm_w, ytke_w, ycoefm_w, ycoefh_w & … … 3049 3049 ENDIF 3050 3050 3051 ENDIF ! (iflag_split . eq.0)3051 ENDIF ! (iflag_split .EQ.0) 3052 3052 3053 3053 IF (ok_bs) THEN … … 3088 3088 y_d_v(j, k) = y_d_v(j, k) * ypct(j) 3089 3089 !FC 3090 IF (nsrf == is_ter . and. ifl_pbltree >= 1) THEN3091 ! if (y_d_u_frein(j,k). ne.0. ) THEN3090 IF (nsrf == is_ter .AND. ifl_pbltree >= 1) THEN 3091 ! if (y_d_u_frein(j,k).NE.0. ) THEN 3092 3092 ! PRINT*, nsrf,'IS_TER ++', y_d_u_frein(j,k)*ypct(j),y_d_u(j,k),j,k 3093 3093 ! ENDIF … … 3117 3117 #ifdef ISO 3118 3118 #ifdef ISOVERIF 3119 if(iso_eau.gt.0) THEN3119 IF (iso_eau.gt.0) THEN 3120 3120 CALL iso_verif_egalite_vect2D( & 3121 3121 y_d_xt,y_d_q, & … … 3125 3125 #endif 3126 3126 3127 ELSE !(iflag_split . eq.0)3127 ELSE !(iflag_split .EQ.0) 3128 3128 3129 3129 ! Tendances hors poches … … 3209 3209 ENDDO 3210 3210 3211 ENDIF ! (iflag_split . eq.0)3211 ENDIF ! (iflag_split .EQ.0) 3212 3212 !!! 3213 3213 … … 3226 3226 i = ni(j) 3227 3227 evap(i, nsrf) = - flux_q(i, 1, nsrf) !jyg 3228 if(ok_bs) then ; snowerosion(i, nsrf) = flux_qbs(i, 1, nsrf);3228 IF (ok_bs) then ; snowerosion(i, nsrf) = flux_qbs(i, 1, nsrf); 3229 3229 endif 3230 3230 beta(i, nsrf) = ybeta(j) !jyg … … 3334 3334 ENDDO 3335 3335 3336 ELSE ! (iflag_split . eq.0)3336 ELSE ! (iflag_split .EQ.0) 3337 3337 DO k = 1, klev + 1 3338 3338 DO j = 1, knon … … 3352 3352 ENDDO 3353 3353 ENDDO 3354 ENDIF ! (iflag_split . eq.0)3354 ENDIF ! (iflag_split .EQ.0) 3355 3355 !!! 3356 3356 DO k = 2, klev … … 3492 3492 ENDIF 3493 3493 3494 if (nsrf == is_oce .and. activate_ocean_skin >= 1) THEN3494 IF (nsrf == is_oce .AND. activate_ocean_skin >= 1) THEN 3495 3495 delta_sal = missing_val 3496 3496 ds_ns = missing_val … … 3515 3515 sss(ni(:knon)) = ysss(:knon) 3516 3516 3517 if (activate_ocean_skin == 2 .and. type_ocean == "couple") THEN3517 IF (activate_ocean_skin == 2 .AND. type_ocean == "couple") THEN 3518 3518 dt_ds = missing_val 3519 3519 dt_ds(ni(:knon)) = ydt_ds(:knon) … … 3549 3549 qairsol(j) = yqsurf(j) 3550 3550 ENDDO 3551 ELSE ! (iflag_split . eq.0)3551 ELSE ! (iflag_split .EQ.0) 3552 3552 DO j = 1, knon 3553 3553 uzon_x(j) = yu_x(j, 1) + y_d_u_x(j, 1) … … 3573 3573 ENDDO 3574 3574 !!! 3575 ENDIF ! (iflag_split . eq.0)3575 ENDIF ! (iflag_split .EQ.0) 3576 3576 !!! 3577 3577 DO j = 1, knon … … 3610 3610 yt2m, yq2m, yt10m, yq10m, yu10m, yustar, ypblh, rain_f, zxtsol) 3611 3611 ENDIF 3612 ELSE !(iflag_split . eq.0)3612 ELSE !(iflag_split .EQ.0) 3613 3613 IF (iflag_new_t2mq2m==1) THEN 3614 3614 CALL stdlevvarn(klon, knon, nsrf, zxli, & … … 3633 3633 ENDIF 3634 3634 !!! 3635 ENDIF ! (iflag_split . eq.0)3635 ENDIF ! (iflag_split .EQ.0) 3636 3636 !!! 3637 3637 !!! jyg le 07/02/2012 … … 3651 3651 3652 3652 ENDDO 3653 ELSE !(iflag_split . eq.0)3653 ELSE !(iflag_split .EQ.0) 3654 3654 DO j = 1, knon 3655 3655 i = ni(j) … … 3685 3685 ENDDO 3686 3686 !!! 3687 ENDIF ! (iflag_split . eq.0)3687 ENDIF ! (iflag_split .EQ.0) 3688 3688 !!! 3689 3689 … … 3705 3705 qsat2m(i) = qsat2m(i) + zx_qs1 * pctsrf(i, nsrf) 3706 3706 ENDDO 3707 ELSE ! (iflag_split . eq.0)3707 ELSE ! (iflag_split .EQ.0) 3708 3708 DO j = 1, knon 3709 3709 i = ni(j) … … 3729 3729 ENDDO 3730 3730 !!! 3731 ENDIF ! (iflag_split . eq.0)3731 ENDIF ! (iflag_split .EQ.0) 3732 3732 !!! 3733 3733 ENDIF … … 3760 3760 print *, ' Arg. de HBTM: yq ', yq(1:knon, :) 3761 3761 ENDIF 3762 ELSE ! (iflag_split . eq.0)3762 ELSE ! (iflag_split .EQ.0) 3763 3763 CALL HBTM(knon, ypaprs, ypplay, & 3764 3764 yt2m_x, yt10m_x, yq2m_x, yq10m_x, yustar_x, ywstar_x, & … … 3785 3785 ytherm_w, ytrmb1_w, ytrmb2_w, ytrmb3_w, ylcl_w) 3786 3786 !!! 3787 ENDIF ! (iflag_split . eq.0)3787 ENDIF ! (iflag_split .EQ.0) 3788 3788 !!! 3789 3789 … … 3810 3810 print *, 'After HBTM: cteiCL ', cteiCL(1:knon, :) 3811 3811 ENDIF 3812 ELSE !(iflag_split . eq.0)3812 ELSE !(iflag_split .EQ.0) 3813 3813 DO j = 1, knon 3814 3814 i = ni(j) … … 3850 3850 ENDIF 3851 3851 !!! 3852 ENDIF ! (iflag_split . eq.0)3852 ENDIF ! (iflag_split .EQ.0) 3853 3853 !!! 3854 3854 … … 3968 3968 3969 3969 ! if blowing snow 3970 if(ok_bs) THEN3970 IF (ok_bs) THEN 3971 3971 DO nsrf = 1, nbsrf 3972 3972 DO k = 1, klev … … 4068 4068 ENDDO 4069 4069 ENDDO 4070 ELSE !(iflag_split . eq.0)4070 ELSE !(iflag_split .EQ.0) 4071 4071 DO nsrf = 1, nbsrf 4072 4072 DO i = 1, klon … … 4114 4114 ENDDO 4115 4115 !!! 4116 ENDIF ! (iflag_split . eq.0)4116 ENDIF ! (iflag_split .EQ.0) 4117 4117 !!! 4118 4118 … … 4271 4271 4272 4272 USE indice_sol_mod 4273 usephys_state_var_mod, ONLY: delta_sal, ds_ns, dt_ns, delta_sst, dter, &4273 USE phys_state_var_mod, ONLY: delta_sal, ds_ns, dt_ns, delta_sst, dter, & 4274 4274 dser, dt_ds 4275 useconfig_ocean_skin_m, ONLY: activate_ocean_skin4275 USE config_ocean_skin_m, ONLY: activate_ocean_skin 4276 4276 4277 4277 INCLUDE "dimsoil.h" … … 4371 4371 alb_dif(i, k, nsrf) = 0.06 4372 4372 ENDDO 4373 if(activate_ocean_skin >= 1) THEN4374 if(activate_ocean_skin == 2 &4375 . and. type_ocean == "couple") THEN4373 IF (activate_ocean_skin >= 1) THEN 4374 IF (activate_ocean_skin == 2 & 4375 .AND. type_ocean == "couple") THEN 4376 4376 delta_sal(i) = 0. 4377 4377 delta_sst(i) = 0.
Note: See TracChangeset
for help on using the changeset viewer.
