Changeset 10425 for NEMO/trunk/src/OCE/ZDF
- Timestamp:
- 2018-12-19T22:54:16+01:00 (5 years ago)
- Location:
- NEMO/trunk/src/OCE/ZDF
- Files:
-
- 7 edited
-
zdf_oce.F90 (modified) (1 diff)
-
zdfgls.F90 (modified) (1 diff)
-
zdfiwm.F90 (modified) (7 diffs)
-
zdfmxl.F90 (modified) (1 diff)
-
zdfosm.F90 (modified) (5 diffs)
-
zdfphy.F90 (modified) (2 diffs)
-
zdftke.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/ZDF/zdf_oce.F90
r10364 r10425 69 69 & avmb(jpk) , avtb(jpk) , avtb_2d(jpi,jpj) , STAT = zdf_oce_alloc ) 70 70 ! 71 IF( zdf_oce_alloc /= 0 ) CALL ctl_ warn('zdf_oce_alloc: failed to allocate arrays')71 IF( zdf_oce_alloc /= 0 ) CALL ctl_stop( 'STOP', 'zdf_oce_alloc: failed to allocate arrays' ) 72 72 ! 73 73 END FUNCTION zdf_oce_alloc -
NEMO/trunk/src/OCE/ZDF/zdfgls.F90
r10342 r10425 119 119 & zwall (jpi,jpj,jpk) , ustar2_top (jpi,jpj) , ustar2_bot(jpi,jpj) , STAT= zdf_gls_alloc ) 120 120 ! 121 IF( lk_mpp ) CALL mpp_sum (zdf_gls_alloc )122 IF( zdf_gls_alloc /= 0 ) CALL ctl_ warn('zdf_gls_alloc: failed to allocate arrays')121 CALL mpp_sum ( 'zdfgls', zdf_gls_alloc ) 122 IF( zdf_gls_alloc /= 0 ) CALL ctl_stop( 'STOP', 'zdf_gls_alloc: failed to allocate arrays' ) 123 123 END FUNCTION zdf_gls_alloc 124 124 -
NEMO/trunk/src/OCE/ZDF/zdfiwm.F90
r10069 r10425 64 64 & hbot_iwm(jpi,jpj), hcri_iwm(jpi,jpj) , STAT=zdf_iwm_alloc ) 65 65 ! 66 IF( lk_mpp ) CALL mpp_sum (zdf_iwm_alloc )67 IF( zdf_iwm_alloc /= 0 ) CALL ctl_ warn('zdf_iwm_alloc: failed to allocate arrays')66 CALL mpp_sum ( 'zdfiwm', zdf_iwm_alloc ) 67 IF( zdf_iwm_alloc /= 0 ) CALL ctl_stop( 'STOP', 'zdf_iwm_alloc: failed to allocate arrays' ) 68 68 END FUNCTION zdf_iwm_alloc 69 69 … … 122 122 ! 123 123 INTEGER :: ji, jj, jk ! dummy loop indices 124 REAL(wp) :: zztmp ! scalar workspace124 REAL(wp) :: zztmp, ztmp1, ztmp2 ! scalar workspace 125 125 REAL(wp), DIMENSION(jpi,jpj) :: zfact ! Used for vertical structure 126 126 REAL(wp), DIMENSION(jpi,jpj) :: zhdep ! Ocean depth … … 157 157 !!gm gde3w ==>>> check for ssh taken into account.... seem OK gde3w_n=gdept_n - sshn 158 158 DO jk = 2, jpkm1 ! complete with the level-dependent part 159 zemx_iwm(:,:,jk) = zfact(:,:) * ( EXP( ( gde3w_n(:,:,jk ) - zhdep(:,:) ) / hcri_iwm(:,:) ) & 160 & - EXP( ( gde3w_n(:,:,jk-1) - zhdep(:,:) ) / hcri_iwm(:,:) ) ) * wmask(:,:,jk) & 161 & / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) ) 162 159 DO jj = 1, jpj 160 DO ji = 1, jpi 161 IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization 162 zemx_iwm(ji,jj,jk) = 0._wp 163 ELSE 164 zemx_iwm(ji,jj,jk) = zfact(ji,jj) * ( EXP( ( gde3w_n(ji,jj,jk ) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) ) & 165 & - EXP( ( gde3w_n(ji,jj,jk-1) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) ) ) & 166 & / ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) ) 167 ENDIF 168 END DO 169 END DO 163 170 !!gm delta(gde3w_n) = e3t_n !! Please verify the grid-point position w versus t-point 164 171 !!gm it seems to me that only 1/hcri_iwm is used ==> compute it one for all … … 234 241 zwkb(:,:,1) = zhdep(:,:) * wmask(:,:,1) 235 242 ! 236 zweight(:,:,:) = 0._wp 237 DO jk = 2, jpkm1 238 zweight(:,:,jk) = MAX( 0._wp, rn2(:,:,jk) ) * hbot_iwm(:,:) * wmask(:,:,jk) & 239 & * ( EXP( -zwkb(:,:,jk) / hbot_iwm(:,:) ) - EXP( -zwkb(:,:,jk-1) / hbot_iwm(:,:) ) ) 243 DO jk = 2, jpkm1 244 DO jj = 1, jpj 245 DO ji = 1, jpi 246 IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization 247 zweight(ji,jj,jk) = 0._wp 248 ELSE 249 zweight(ji,jj,jk) = rn2(ji,jj,jk) * hbot_iwm(ji,jj) & 250 & * ( EXP( -zwkb(ji,jj,jk) / hbot_iwm(ji,jj) ) - EXP( -zwkb(ji,jj,jk-1) / hbot_iwm(ji,jj) ) ) 251 ENDIF 252 END DO 253 END DO 240 254 END DO 241 255 ! … … 305 319 END DO 306 320 END DO 307 IF( lk_mpp ) CALL mpp_sum(zztmp )321 CALL mpp_sum( 'zdfiwm', zztmp ) 308 322 zztmp = rau0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing 309 323 ! … … 322 336 ! 323 337 IF( ln_tsdiff ) THEN !* Option for differential mixing of salinity and temperature 338 ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 324 339 DO jk = 2, jpkm1 ! Calculate S/T diffusivity ratio as a function of Reb 325 340 DO jj = 1, jpj 326 341 DO ji = 1, jpi 327 zav_ratio(ji,jj,jk) = ( 0.505_wp + 0.495_wp * & 328 & TANH( 0.92_wp * ( LOG10( MAX( 1.e-20_wp, zReb(ji,jj,jk) * 5._wp * r1_6 ) ) - 0.60_wp ) ) & 329 & ) * wmask(ji,jj,jk) 342 ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 343 IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN 344 zav_ratio(ji,jj,jk) = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10(ztmp2) - 0.60_wp ) ) 345 ELSE 346 zav_ratio(ji,jj,jk) = ztmp1 * wmask(ji,jj,jk) 347 ENDIF 330 348 END DO 331 349 END DO … … 463 481 ecri_iwm(:,:) = ecri_iwm(:,:) * ssmask(:,:) 464 482 465 zbot = glob_sum( e1e2t(:,:) * ebot_iwm(:,:) )466 zpyc = glob_sum( e1e2t(:,:) * epyc_iwm(:,:) )467 zcri = glob_sum( e1e2t(:,:) * ecri_iwm(:,:) )483 zbot = glob_sum( 'zdfiwm', e1e2t(:,:) * ebot_iwm(:,:) ) 484 zpyc = glob_sum( 'zdfiwm', e1e2t(:,:) * epyc_iwm(:,:) ) 485 zcri = glob_sum( 'zdfiwm', e1e2t(:,:) * ecri_iwm(:,:) ) 468 486 IF(lwp) THEN 469 487 WRITE(numout,*) ' High-mode wave-breaking energy: ', zbot * 1.e-12_wp, 'TW' -
NEMO/trunk/src/OCE/ZDF/zdfmxl.F90
r10351 r10425 50 50 ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT= zdf_mxl_alloc ) 51 51 ! 52 IF( lk_mpp ) CALL mpp_sum (zdf_mxl_alloc )53 IF( zdf_mxl_alloc /= 0 ) CALL ctl_ warn('zdf_mxl_alloc: failed to allocate arrays.')52 CALL mpp_sum ( 'zdfmxl', zdf_mxl_alloc ) 53 IF( zdf_mxl_alloc /= 0 ) CALL ctl_stop( 'STOP', 'zdf_mxl_alloc: failed to allocate arrays.' ) 54 54 ! 55 55 ENDIF -
NEMO/trunk/src/OCE/ZDF/zdfosm.F90
r10364 r10425 118 118 & etmean(jpi,jpj,jpk), STAT= zdf_osm_alloc ) 119 119 IF( zdf_osm_alloc /= 0 ) CALL ctl_warn('zdf_osm_alloc: failed to allocate zdf_osm arrays') 120 IF( lk_mpp ) CALL mpp_sum (zdf_osm_alloc )120 CALL mpp_sum ( 'zdfosm', zdf_osm_alloc ) 121 121 END FUNCTION zdf_osm_alloc 122 122 … … 1287 1287 1288 1288 ! Lateral boundary conditions on zvicos (sign unchanged), needed to caclulate viscosities on u and v grids 1289 CALL lbc_lnk( zviscos(:,:,:), 'W', 1. )1289 CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1. ) 1290 1290 1291 1291 ! GN 25/8: need to change tmask --> wmask … … 1300 1300 END DO 1301 1301 ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid (sign unchanged), needed to caclulate gham[uv] on u and v grids 1302 CALL lbc_lnk_multi( p_avt, 'W', 1. , p_avm, 'W', 1., &1302 CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1. , p_avm, 'W', 1., & 1303 1303 & ghamu, 'W', 1. , ghamv, 'W', 1. ) 1304 1304 DO jk = 2, jpkm1 … … 1318 1318 ! Lateral boundary conditions on final outputs for gham[ts], on W-grid (sign unchanged) 1319 1319 ! Lateral boundary conditions on final outputs for gham[uv], on [UV]-grid (sign unchanged) 1320 CALL lbc_lnk_multi( ghamt, 'W', 1. , ghams, 'W', 1., &1320 CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W', 1. , ghams, 'W', 1., & 1321 1321 & ghamu, 'U', 1. , ghamv, 'V', 1. ) 1322 1322 … … 1359 1359 END IF 1360 1360 ! Lateral boundary conditions on p_avt (sign unchanged) 1361 CALL lbc_lnk( p_avt(:,:,:), 'W', 1. )1361 CALL lbc_lnk( 'zdfosm', p_avt(:,:,:), 'W', 1. ) 1362 1362 ! 1363 1363 END SUBROUTINE zdf_osm -
NEMO/trunk/src/OCE/ZDF/zdfphy.F90
r10364 r10425 300 300 ! !* Lateral boundary conditions (sign unchanged) 301 301 IF( l_zdfsh2 ) THEN 302 CALL lbc_lnk_multi( avm_k, 'W', 1. , avt_k, 'W', 1., &302 CALL lbc_lnk_multi( 'zdfphy', avm_k, 'W', 1. , avt_k, 'W', 1., & 303 303 & avm , 'W', 1. , avt , 'W', 1. , avs , 'W', 1. ) 304 304 ELSE 305 CALL lbc_lnk_multi( avm , 'W', 1. , avt , 'W', 1. , avs , 'W', 1. )305 CALL lbc_lnk_multi( 'zdfphy', avm , 'W', 1. , avt , 'W', 1. , avs , 'W', 1. ) 306 306 ENDIF 307 307 ! 308 308 IF( l_zdfdrg ) THEN ! drag have been updated (non-linear cases) 309 IF( ln_isfcav ) THEN ; CALL lbc_lnk_multi( rCdU_top, 'T', 1. , rCdU_bot, 'T', 1. ) ! top & bot drag310 ELSE ; CALL lbc_lnk ( rCdU_bot, 'T', 1. ) ! bottom drag only309 IF( ln_isfcav ) THEN ; CALL lbc_lnk_multi( 'zdfphy', rCdU_top, 'T', 1. , rCdU_bot, 'T', 1. ) ! top & bot drag 310 ELSE ; CALL lbc_lnk ( 'zdfphy', rCdU_bot, 'T', 1. ) ! bottom drag only 311 311 ENDIF 312 312 ENDIF … … 331 331 ALLOCATE( wi(jpi,jpj,jpk), Cu_adv(jpi,jpj,jpk), STAT= zdf_phy_alloc ) 332 332 IF( zdf_phy_alloc /= 0 ) CALL ctl_warn('zdf_phy_alloc: failed to allocate ln_zad_Aimp=T required arrays') 333 IF( lk_mpp ) CALL mpp_sum (zdf_phy_alloc )333 CALL mpp_sum ( 'zdfphy', zdf_phy_alloc ) 334 334 END FUNCTION zdf_phy_alloc 335 335 -
NEMO/trunk/src/OCE/ZDF/zdftke.F90
r10068 r10425 103 103 ALLOCATE( htau(jpi,jpj) , dissl(jpi,jpj,jpk) , apdlr(jpi,jpj,jpk) , STAT= zdf_tke_alloc ) 104 104 ! 105 IF( lk_mpp ) CALL mpp_sum (zdf_tke_alloc )106 IF( zdf_tke_alloc /= 0 ) CALL ctl_ warn('zdf_tke_alloc: failed to allocate arrays')105 CALL mpp_sum ( 'zdftke', zdf_tke_alloc ) 106 IF( zdf_tke_alloc /= 0 ) CALL ctl_stop( 'STOP', 'zdf_tke_alloc: failed to allocate arrays' ) 107 107 ! 108 108 END FUNCTION zdf_tke_alloc … … 202 202 REAL(wp) :: zzd_up, zzd_lw ! - - 203 203 INTEGER , DIMENSION(jpi,jpj) :: imlc 204 REAL(wp), DIMENSION(jpi,jpj) :: zhlc 204 REAL(wp), DIMENSION(jpi,jpj) :: zhlc, zfr_i 205 205 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpelc, zdiag, zd_up, zd_lw 206 206 !!-------------------------------------------------------------------- … … 290 290 END DO 291 291 zcof = 0.016 / SQRT( zrhoa * zcdrag ) 292 DO jj = 2, jpjm1 293 DO ji = fs_2, fs_jpim1 ! vector opt. 294 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift 295 zfr_i(ji,jj) = ( 1._wp - 4._wp * fr_i(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 296 IF (zfr_i(ji,jj) < 0. ) zfr_i(ji,jj) = 0. 297 END DO 298 END DO 292 299 DO jk = 2, jpkm1 !* TKE Langmuir circulation source term added to en 293 300 DO jj = 2, jpjm1 294 301 DO ji = fs_2, fs_jpim1 ! vector opt. 295 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift 296 ! ! vertical velocity due to LC 297 zind = 0.5 - SIGN( 0.5, pdepw(ji,jj,jk) - zhlc(ji,jj) ) 298 zwlc = zind * rn_lc * zus * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) ) 299 ! ! TKE Langmuir circulation source term 300 en(ji,jj,jk) = en(ji,jj,jk) + rdt * MAX(0.,1._wp - 4.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) & 301 & / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 302 IF ( zfr_i(ji,jj) /= 0. ) THEN 303 ! vertical velocity due to LC 304 IF ( pdepw(ji,jj,jk) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN 305 ! ! vertical velocity due to LC 306 zwlc = rn_lc * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) ) ! warning: optimization: zus^3 is in zfr_i 307 ! ! TKE Langmuir circulation source term 308 en(ji,jj,jk) = en(ji,jj,jk) + rdt * zfr_i(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) 309 ENDIF 310 ENDIF 302 311 END DO 303 312 END DO
Note: See TracChangeset
for help on using the changeset viewer.
