- Timestamp:
- 2015-02-17T10:06:39+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
r4624 r5086 26 26 USE phycst ! physical constants 27 27 USE eosbn2 ! equation of state 28 USE zdfddm ! double diffusion mixing 28 USE zdfddm ! double diffusion mixing (avs array) 29 USE lib_mpp ! MPP library 30 USE trd_oce ! ocean trends definition 31 USE trdtra ! tracers trends 32 ! 29 33 USE in_out_manager ! I/O manager 30 USE lib_mpp ! MPP library31 USE wrk_nemo ! work arrays32 34 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 35 USE prtctl ! Print control 34 USE trdmod_oce ! ocean trends definition 35 USE trdtra ! tracers trends 36 USE wrk_nemo ! work arrays 36 37 USE timing ! Timing 37 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 38 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 38 39 39 40 IMPLICIT NONE … … 246 247 REAL(wp) :: zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t 247 248 #if defined key_zdfddm 248 REAL(wp) :: zrrau, zds, zavdds, zavddt,zinr ! double diffusion mixing 249 REAL(wp), POINTER, DIMENSION(:,:) :: zdifs 249 REAL(wp) :: zrw, zkm1s ! local scalars 250 REAL(wp) :: zrrau, zdt, zds, zavdds, zavddt, zinr ! double diffusion mixing 251 REAL(wp), POINTER, DIMENSION(:,:) :: zdifs 250 252 REAL(wp), POINTER, DIMENSION(:) :: za2s, za3s, zkmps 251 REAL(wp) :: zkm1s252 253 REAL(wp), POINTER, DIMENSION(:,:) :: zblcs 253 254 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdiffus … … 274 275 #endif 275 276 276 zviscos(:,:,:) = 0. 277 zblcm (:,: ) = 0. 278 zdiffut(:,:,:) = 0. 279 zblct (:,: ) = 0. 277 zviscos(:,:,:) = 0._wp 278 zblcm (:,: ) = 0._wp 279 zdiffut(:,:,:) = 0._wp 280 zblct (:,: ) = 0._wp 280 281 #if defined key_zdfddm 281 zdiffus(:,:,:) = 0. 282 zblcs (:,: ) = 0. 283 #endif 284 ghats(:,:,:) = 0. 285 286 zBo (:,:) = 0. 287 zBosol(:,:) = 0. 288 zustar(:,:) = 0. 289 290 282 zdiffus(:,:,:) = 0._wp 283 zblcs (:,: ) = 0._wp 284 #endif 285 ghats (:,:,:) = 0._wp 286 zBo (:,: ) = 0._wp 287 zBosol (:,: ) = 0._wp 288 zustar (:,: ) = 0._wp 289 ! 291 290 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 292 291 ! I. Interior diffusivity and viscosity at w points ( T interfaces) … … 332 331 avt (ji,jj,jk) = avt (ji,jj,jk) + rn_difri * zfri 333 332 ENDIF 333 ! 334 334 #if defined key_zdfddm 335 avs (ji,jj,jk) = avt (ji,jj,jk)335 ! 336 336 ! Double diffusion mixing ; NOT IN ROUTINE ZDFDDM.F90 337 ! ------------------------------------------------------------------ 338 ! only retains positive value of rrau 339 zrrau = MAX( rrau(ji,jj,jk), epsln ) 340 zds = tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) 341 IF( zrrau > 1. .AND. zds > 0.) THEN 342 ! 343 ! Salt fingering case. 344 !--------------------- 345 ! Compute interior diffusivity for double diffusive mixing of 346 ! salinity. Upper bound "zrrau" by "Rrho0"; (Rrho0=1.9, difcoefnuf=0.001). 347 ! After that set interior diffusivity for double diffusive mixing 348 ! of temperature 337 ! ------------------------- 338 avs (ji,jj,jk) = avt (ji,jj,jk) 339 340 ! R=zrau = (alpha / beta) (dk[t] / dk[s]) 341 zrw = ( fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk) ) & 342 & / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 343 ! 344 zaw = ( rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw ) * tmask(ji,jj,jk) 345 zbw = ( rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw ) * tmask(ji,jj,jk) 346 ! 347 zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) 348 zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) 349 IF( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp 350 zrrau = MAX( epsln , zdt / zds ) ! only retains positive value of zrau 351 ! 352 IF( zrrau > 1. .AND. zds > 0.) THEN ! Salt fingering case. 353 ! !--------------------- 354 ! Compute interior diffusivity for double diffusive mixing of salinity. 355 ! Upper bound "zrrau" by "Rrho0"; (Rrho0=1.9, difcoefnuf=0.001). 356 ! After that set interior diffusivity for double diffusive mixing of temperature 349 357 zavdds = MIN( zrrau, Rrho0 ) 350 358 zavdds = ( zavdds - 1.0 ) / ( Rrho0 - 1.0 ) … … 353 361 zavdds = difssf * zavdds 354 362 zavddt = 0.7 * zavdds 355 ELSEIF( zrrau < 1. .AND. zrrau > 0. .AND. zds < 0.) THEN356 363 ! 357 ! Diffusive convection case. 358 !--------------------------- 359 ! Compute interior diffusivity for double diffusive mixing of 360 ! temperature (Marmorino and Caldwell, 1976); 364 ELSEIF( zrrau < 1. .AND. zrrau > 0. .AND. zds < 0.) THEN ! Diffusive convection case. 365 ! !--------------------------- 366 ! Compute interior diffusivity for double diffusive mixing of temperature (Marmorino and Caldwell, 1976); 361 367 ! Compute interior diffusivity for double diffusive mixing of salinity 362 368 zinr = 1. / zrrau 363 369 zavddt = 0.909 * EXP( 4.6 * EXP( -0.54* ( zinr - 1. ) ) ) 364 370 zavddt = difsdc * zavddt 365 IF( zrrau < 0.5) THEN 366 zavdds = zavddt * 0.15 * zrrau 367 ELSE 368 zavdds = zavddt * (1.85 * zrrau - 0.85 ) 371 IF( zrrau < 0.5) THEN ; zavdds = zavddt * 0.15 * zrrau 372 ELSE ; zavdds = zavddt * (1.85 * zrrau - 0.85 ) 369 373 ENDIF 370 374 ELSE … … 385 389 !--------------------------------------------------------------------- 386 390 DO jj = 2, jpjm1 387 DO ji = fs_2, fs_jpim1 388 IF( nn_eos < 1) THEN 389 zt = tsn(ji,jj,1,jp_tem) 390 zs = tsn(ji,jj,1,jp_sal) - 35.0 391 zh = fsdept(ji,jj,1) 392 ! potential volumic mass 393 zrhos = rhop(ji,jj,1) 394 zalbet = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt & ! ratio alpha/beta 395 & - 0.203814e-03 ) * zt & 396 & + 0.170907e-01 ) * zt & 397 & + 0.665157e-01 & 398 & + ( - 0.678662e-05 * zs & 399 & - 0.846960e-04 * zt + 0.378110e-02 ) * zs & 400 & + ( ( - 0.302285e-13 * zh & 401 & - 0.251520e-11 * zs & 402 & + 0.512857e-12 * zt * zt ) * zh & 403 & - 0.164759e-06 * zs & 404 & +( 0.791325e-08 * zt - 0.933746e-06 ) * zt & 405 & + 0.380374e-04 ) * zh 406 407 zbeta = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt & ! beta 408 & - 0.301985e-05 ) * zt & 409 & + 0.785567e-03 & 410 & + ( 0.515032e-08 * zs & 411 & + 0.788212e-08 * zt - 0.356603e-06 ) * zs & 412 & +( ( 0.121551e-17 * zh & 413 & - 0.602281e-15 * zs & 414 & - 0.175379e-14 * zt + 0.176621e-12 ) * zh & 415 & + 0.408195e-10 * zs & 416 & + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt & 417 & - 0.121555e-07 ) * zh 418 419 zthermal = zbeta * zalbet / ( rcp * zrhos + epsln ) 420 zhalin = zbeta * tsn(ji,jj,1,jp_sal) * rcs 421 ELSE 422 zrhos = rhop(ji,jj,1) + rau0 * ( 1. - tmask(ji,jj,1) ) 423 zthermal = rn_alpha / ( rcp * zrhos + epsln ) 424 zhalin = rn_beta * tsn(ji,jj,1,jp_sal) * rcs 425 zbeta = rn_beta 426 ENDIF 391 DO ji = fs_2, fs_jpim1 392 zrhos = rau0 * ( 1._wp + rhd(ji,jj,1) ) * tmask(ji,jj,1) 393 zthermal = rab_n(ji,jj,1,jp_tem) / ( rcp * zrhos + epsln ) 394 zbeta = rab_n(ji,jj,1,jp_sal) 395 zhalin = zbeta * tsn(ji,jj,1,jp_sal) * rcs 396 ! 427 397 ! Radiative surface buoyancy force 428 398 zBosol(ji,jj) = grav * zthermal * qsr(ji,jj) … … 435 405 ws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) & 436 406 & + sfx(ji,jj) ) * rcs * tmask(ji,jj,1) 437 END DO438 END DO407 END DO 408 END DO 439 409 440 410 zflageos = 0.5 + SIGN( 0.5, nn_eos - 1. ) … … 447 417 ! Friction velocity (zustar), at T-point : LMD94 eq. 2 448 418 zustar(ji,jj) = SQRT( taum(ji,jj) / ( zrhos + epsln ) ) 449 END DO450 END DO419 END DO 420 END DO 451 421 452 422 !CDIR NOVERRCHK … … 1270 1240 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 1271 1241 !!bug gm jpttdzdf ==> jpttkpp 1272 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ trd_zdf, ztrdt )1273 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ trd_zdf, ztrds )1242 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt ) 1243 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds ) 1274 1244 DEALLOCATE( ztrdt ) ; DEALLOCATE( ztrds ) 1275 1245 ENDIF … … 1340 1310 IF( l_trdtrc ) THEN ! save the non-local tracer flux trends for diagnostic 1341 1311 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 1342 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_zdf, ztrtrd(:,:,:) )1312 CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:) ) 1343 1313 ENDIF 1344 1314 ! … … 1375 1345 !!---------------------------------------------------------------------- 1376 1346 INTEGER :: ji, jj, jk ! dummy loop indices 1347 INTEGER :: ios ! local integer 1377 1348 #if ! defined key_kppcustom 1378 1349 INTEGER :: jm ! dummy loop indices … … 1382 1353 REAL(wp) :: zustar, zucube, zustvk, zeta, zehat ! tempory scalars 1383 1354 #endif 1384 INTEGER :: ios ! Local integer output status for namelist read1385 1355 REAL(wp) :: zhbf ! tempory scalars 1386 1356 LOGICAL :: ll_kppcustom ! 1st ocean level taken as surface layer
Note: See TracChangeset
for help on using the changeset viewer.
