- Timestamp:
- 2019-07-22T17:00:21+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/ABL/ablmod.F90
r11305 r11322 81 81 ! 82 82 REAL(wp), DIMENSION(1:jpi,1:jpj ) :: zrhoa, zwnd_i, zwnd_j 83 REAL(wp), DIMENSION(1:jpi,1:jpka ) :: zFC83 ! REAL(wp), DIMENSION(1:jpi,1:jpka ) :: zFC 84 84 REAL(wp), DIMENSION(1:jpi,2:jpka ) :: zCF 85 REAL(wp), DIMENSION(1:jpi, jptq ) :: zBC 85 ! REAL(wp), DIMENSION(1:jpi, jptq ) :: zBC 86 REAL(wp), DIMENSION(1:jpi,1:jpj,1:jpka) :: z_cft !--FL--to be removed after the test phase 86 87 ! 87 88 REAL(wp), DIMENSION(1:jpi,1:jpka ) :: z_elem_a … … 89 90 REAL(wp), DIMENSION(1:jpi,1:jpka ) :: z_elem_c 90 91 ! 91 REAL(wp), DIMENSION(1:jpi,1:jpj,1:jpka ) :: z_cft !--FL--to be removed after the test phase92 !93 92 INTEGER :: ji, jj, jk, jtra, jbak ! dummy loop indices 94 93 REAL(wp) :: zztmp, zcff, ztemp, zhumi, zcff1 95 94 REAL(wp) :: zcff2, zfcor, zmsk, zsig, zcffu, zcffv 96 LOGICAL :: ln_old_coriolis = .FALSE. ! possibility to switch off Coriolis term97 95 ! 98 96 !!--------------------------------------------------------------------- … … 211 209 DO jj = 1, jpj 212 210 DO ji = 1, jpi 213 zcff = ( ff _t(ji,jj) * rdt )*( ff_t(ji,jj) * rdt ) ! (f dt)**2211 zcff = ( fft_abl(ji,jj) * rdt )*( fft_abl(ji,jj) * rdt ) ! (f dt)**2 214 212 215 213 u_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *( & 216 214 & (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff)*u_abl( ji, jj, jk, nt_n ) & 217 & + rdt * ff _t(ji, jj) * v_abl ( ji , jj , jk, nt_n ) ) &215 & + rdt * fft_abl(ji, jj) * v_abl ( ji , jj , jk, nt_n ) ) & 218 216 & / (1._wp + gamma_Cor*gamma_Cor*zcff) 219 217 220 218 v_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *( & 221 219 & (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff)*v_abl( ji, jj, jk, nt_n ) & 222 & - rdt * ff _t(ji, jj) * u_abl ( ji , jj, jk, nt_n ) ) &220 & - rdt * fft_abl(ji, jj) * u_abl ( ji , jj, jk, nt_n ) ) & 223 221 & / (1._wp + gamma_Cor*gamma_Cor*zcff) 224 222 END DO … … 234 232 DO ji = 1, jpi 235 233 u_abl( ji, jj, jk, nt_a ) = u_abl( ji, jj, jk, nt_a ) & 236 & - rdt * e3t_abl(jk) * ff _t(ji , jj) * pgv_dta(ji ,jj ,jk)234 & - rdt * e3t_abl(jk) * fft_abl(ji , jj) * pgv_dta(ji ,jj ,jk) 237 235 v_abl( ji, jj, jk, nt_a ) = v_abl( ji, jj, jk, nt_a ) & 238 & + rdt * e3t_abl(jk) * ff _t(ji, jj ) * pgu_dta(ji ,jj ,jk)236 & + rdt * e3t_abl(jk) * fft_abl(ji, jj ) * pgu_dta(ji ,jj ,jk) 239 237 END DO 240 238 END DO … … 394 392 zcff = (1._wp-zmsk) + zmsk * rdt * zcff2 ! zcff = 1 for masked points 395 393 394 zcff = zcff * rest_eq(ji,jj) ; z_cft( ji, jj, jk ) = zcff 395 396 396 u_abl( ji, jj, jk, nt_a ) = (1._wp - zcff ) * u_abl( ji, jj, jk, nt_a ) & 397 397 & + zcff * pu_dta( ji, jj, jk ) … … 423 423 & + zcff * pq_dta( ji, jj, jk ) 424 424 425 z_cft( ji, jj, jk ) = zcff425 ! z_cft( ji, jj, jk ) = zcff 426 426 END DO 427 427 END DO … … 472 472 DO ji = 1, jpi 473 473 zcff = SQRT( zwnd_i(ji,jj) * zwnd_i(ji,jj) & 474 & + zwnd_j(ji,jj) * zwnd_j(ji,jj) ) * msk_abl(ji,jj)474 & + zwnd_j(ji,jj) * zwnd_j(ji,jj) ) ! * msk_abl(ji,jj) 475 475 zztmp = zrhoa(ji,jj) * pcd_du(ji,jj) 476 476 … … 504 504 CALL prt_ctl( tab2d_2=ptauj , clinfo2= 'vtau : ' ) 505 505 ENDIF 506 506 507 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 507 508 ! ! 8 *** Swap time indices for the next timestep … … 509 510 nt_n = 1 + MOD( kt , 2) 510 511 nt_a = 1 + MOD( kt+1, 2) 511 ! 512 ! 512 513 !--------------------------------------------------------------------------------------------------- 513 514 END SUBROUTINE abl_stp … … 673 674 zcff1 = zcff / ( zcff + rn_epssfc * pblh ( ji, jj ) ) 674 675 zcff = ghw_abl( jk ) 676 zcff2 = zcff / ( zcff + rn_epssfc * pblh ( ji, jj ) ) 675 677 zFC( ji, jk ) = zFC( ji, jk-1) + 0.5_wp * e3t_abl( jk )*( & 676 678 zcff2 * ( zsh2( ji, jk ) - ziRic * zbn2( ji, jj, jk ) & 677 - rn_Cek * ( ff _t( ji, jj ) * ff_t( ji, jj ) ) ) &679 - rn_Cek * ( fft_abl( ji, jj ) * fft_abl( ji, jj ) ) ) & 678 680 + zcff1 * ( zsh2( ji, jk-1) - ziRic * zbn2( ji, jj, jk-1 ) & 679 - rn_Cek * ( ff _t( ji, jj ) * ff_t( ji, jj ) ) ) &681 - rn_Cek * ( fft_abl( ji, jj ) * fft_abl( ji, jj ) ) ) & 680 682 & ) 681 683 IF( ikbl(ji) == 0 .and. zFC( ji, jk ).lt.0._wp ) ikbl(ji)=jk … … 700 702 !------------- 701 703 END DO 702 !------------- 704 !------------- 705 IF(ln_smth_pblh) THEN 706 CALL lbc_lnk( 'ablmod', pblh, 'T', 1.) 707 CALL smooth_pblh( pblh, msk_abl ) 708 CALL lbc_lnk( 'ablmod', pblh, 'T', 1.) 709 ENDIF 703 710 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 704 711 ! ! Diagnostic mixing length computation … … 886 893 887 894 895 !=================================================================================================== 896 SUBROUTINE smooth_pblh( pvar2d, msk ) 897 !--------------------------------------------------------------------------------------------------- 898 899 !!---------------------------------------------------------------------- 900 !! *** ROUTINE smooth_pblh *** 901 !! 902 !! ** Purpose : 2D Hanning filter on atmospheric PBL height 903 !! 904 !! --------------------------------------------------------------------- 905 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: msk 906 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pvar2d 907 INTEGER :: ji,jj 908 REAL(wp) :: smth_a, smth_b 909 REAL(wp), DIMENSION(jpi,jpj) :: zdX,zdY,zFX,zFY 910 REAL(wp) :: zumsk,zvmsk 911 !! 912 !!========================================================= 913 !! 914 !! Hanning filter 915 smth_a = 1._wp / 8._wp 916 smth_b = 1._wp / 4._wp 917 ! 918 DO jj=1,jpj 919 DO ji=1,jpi-1 920 zumsk = msk(ji,jj) * msk(ji+1,jj) 921 zdX ( ji, jj ) = ( pvar2d( ji+1,jj ) - pvar2d( ji ,jj ) ) * zumsk 922 END DO 923 END DO 924 925 DO jj=1,jpj-1 926 DO ji=1,jpi 927 zvmsk = msk(ji,jj) * msk(ji,jj+1) 928 zdY ( ji, jj ) = ( pvar2d( ji, jj+1 ) - pvar2d( ji ,jj ) ) * zvmsk 929 END DO 930 END DO 931 932 DO jj=1,jpj-1 933 DO ji=2,jpi-1 934 zFY ( ji, jj ) = zdY ( ji, jj ) & 935 & + smth_a* ( (zdX ( ji, jj+1 ) - zdX( ji-1, jj+1 )) & 936 & - (zdX ( ji, jj ) - zdX( ji-1, jj )) ) 937 END DO 938 END DO 939 940 DO jj=2,jpj-1 941 DO ji=1,jpi-1 942 zFX( ji, jj ) = zdX( ji, jj ) & 943 & + smth_a*( (zdY( ji+1, jj ) - zdY( ji+1, jj-1)) & 944 & - (zdY( ji , jj ) - zdY( ji , jj-1)) ) 945 END DO 946 END DO 947 948 DO jj = 2, jpj-1 949 DO ji = 2,jpi-1 950 pvar2d( ji ,jj ) = pvar2d( ji ,jj ) & 951 & + msk(ji,jj) * smth_b * ( & 952 & zFX( ji, jj ) - zFX( ji-1, jj ) & 953 & +zFY( ji, jj ) - zFY( ji, jj-1 ) ) 954 END DO 955 END DO 956 !! 957 !--------------------------------------------------------------------------------------------------- 958 END SUBROUTINE smooth_pblh 959 !=================================================================================================== 960 888 961 !!====================================================================== 889 962 END MODULE ablmod
Note: See TracChangeset
for help on using the changeset viewer.
