Changeset 14542 for NEMO/branches
- Timestamp:
- 2021-02-24T18:49:51+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.1_FKOSM_m11715/src/OCE/ZDF/zdfosm.F90
r14533 r14542 403 403 404 404 #ifdef key_osm_debug 405 IF(narea==nn_narea_db)THEN 405 IF(mi0(nn_idb)==mi1(nn_idb) .AND. mj0(nn_jdb)==mj1(nn_jdb) .AND. & 406 & mi0(nn_idb) > 1 .AND. mi0(nn_idb) < jpi .AND. mj0(nn_jdb) > 1 .AND. mj0(nn_jdb) < jpj) THEN 407 nn_narea_db = narea 406 408 iloc_db=mi0(nn_idb); jloc_db=mj0(nn_jdb) 407 409 … … 415 417 WRITE(narea+100,*) 416 418 FLUSH(narea+100) 419 ELSE 420 nn_narea_db = -1000 417 421 END IF 418 422 #endif … … 1055 1059 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm ) 1056 1060 WRITE(narea+100,'(a,*(g11.3))') ' ghamv[imld-1..ibld+2] =', ( ghamv(ji,jj,jk), jk=jl,jm ) 1061 WRITE(narea+100,*) 1057 1062 FLUSH(narea+100) 1058 1063 END IF … … 1099 1104 ! 1100 1105 IF ( dh(ji,jj) < 0.2*hbl(ji,jj) ) THEN 1101 zbuoy_pyc_sc = zalpha_pyc(ji,jj) * zdb_ml(ji,jj) / zdh(ji,jj) + zdbdz_bl_ext(ji,jj)1106 zbuoy_pyc_sc = 2.0_wp * MAX(zdb_ml(ji,jj), 0._wp) / zdh(ji,jj) 1102 1107 zdelta_pyc = ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird / SQRT( MAX( zbuoy_pyc_sc, ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / zdh(ji,jj)**2 ) ) 1103 1108 ! … … 1203 1208 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm ) 1204 1209 WRITE(narea+100,'(a,*(g11.3))') ' ghamv[imld-1..ibld+2] =', ( ghamv(ji,jj,jk), jk=jl,jm ) 1210 WRITE(narea+100,*) 1205 1211 FLUSH(narea+100) 1206 1212 END IF … … 1213 1219 ! Transport term in flux-gradient relationship [note : includes ROI ratio (X0.3) ] 1214 1220 1215 DO jj = 1, jpjm11216 DO ji = 1, jpim11221 DO jj = 2, jpjm1 1222 DO ji = 2, jpim1 1217 1223 1218 1224 IF ( lconv(ji,jj) ) THEN … … 1316 1322 END DO 1317 1323 END DO 1324 #ifdef key_osm_debug 1325 IF(narea==nn_narea_db) THEN 1326 ji=iloc_db; jj=jloc_db 1327 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 1328 WRITE(narea+100,'(2(a,g11.3))')'Stokes + buoy + pyc + transport contribs to ghamt/contrib to ghamt/s: zsc_wth_1=',zsc_wth_1(ji,jj), ' zsc_ws_1=',zsc_ws_1(ji,jj) 1329 IF (lpyc(ji,jj)) WRITE(narea+100,'(2(a,g11.3))') 'zsc_wth_pyc=', zsc_wth_pyc(ji,jj), ' zsc_wth_pyc=',zsc_wth_pyc(ji,jj) 1330 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm ) 1331 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm ) 1332 IF( lconv(ji,jj) ) THEN 1333 WRITE(narea+100,'(2(a,g11.3))')'Unstable; transport contrib to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj) 1334 ELSE 1335 WRITE(narea+100,'(3(a,g11.3))')'Stable; transport contrib to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj), & 1336 &' zsc_uw_2=',zsc_uw_2(ji,jj) 1337 END IF 1338 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm ) 1339 WRITE(narea+100,*) 1340 FLUSH(narea+100) 1341 END IF 1342 #endif 1318 1343 1319 1344 IF(ln_dia_osm) THEN … … 1376 1401 END DO ! ji loop 1377 1402 END DO ! jj loop 1403 #ifdef key_osm_debug 1404 IF(narea==nn_narea_db) THEN 1405 ji=iloc_db; jj=jloc_db 1406 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 1407 WRITE(narea+100,'(a)')'Tweak gham[uv] to go to zero near surface, add pycnocline viscosity/diffusivity & set=0 at ibld' 1408 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm ) 1409 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm ) 1410 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm ) 1411 WRITE(narea+100,'(a,*(g11.3))') ' ghamv[imld-1..ibld+2] =', ( ghamv(ji,jj,jk), jk=jl,jm ) 1412 WRITE(narea+100,*) 1413 FLUSH(narea+100) 1414 END IF 1415 #endif 1378 1416 1379 1417 IF(ln_dia_osm) THEN … … 1462 1500 END DO 1463 1501 END IF ! ln_convmix = .true. 1502 #ifdef key_osm_debug 1503 IF(narea==nn_narea_db) THEN 1504 ji=iloc_db; jj=jloc_db 1505 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 1506 WRITE(narea+100,'(a)') ' After including KPP Ri# diffusivity & viscosity' 1507 WRITE(narea+100,'(a,*(g11.3))') ' zdiffut[imld-1..ibld+2] =', ( zdiffut(ji,jj,jk), jk=jl,jm ) 1508 WRITE(narea+100,'(a,*(g11.3))') ' zviscos[imld-1..ibld+2] =', ( zviscos(ji,jj,jk), jk=jl,jm ) 1509 WRITE(narea+100,*) 1510 FLUSH(narea+100) 1511 END IF 1512 #endif 1464 1513 1465 1514 … … 1495 1544 END DO 1496 1545 END DO 1546 #ifdef key_osm_debug 1547 IF(narea==nn_narea_db) THEN 1548 ji=iloc_db; jj=jloc_db 1549 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 1550 WRITE(narea+100,'(a)') ' After including FK diffusivity & non-local terms' 1551 WRITE(narea+100,'(a,*(g11.3))') ' zdiffut[imld-1..ibld+2] =', ( zdiffut(ji,jj,jk), jk=jl,jm ) 1552 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm ) 1553 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm ) 1554 WRITE(narea+100,*) 1555 FLUSH(narea+100) 1556 END IF 1557 #endif 1497 1558 ENDIF 1498 1559 … … 1540 1601 CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W', 1. , ghams, 'W', 1., & 1541 1602 & ghamu, 'U', -1. , ghamv, 'V', -1. ) 1603 #ifdef key_osm_debug 1604 IF(narea==nn_narea_db) THEN 1605 ji=iloc_db; jj=jloc_db 1606 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 1607 WRITE(narea+100,'(a)') ' Final diffusivity & viscosity, & non-local terms' 1608 WRITE(narea+100,'(a,*(g11.3))') ' p_avt[imld-1..ibld+2] =', ( p_avt(ji,jj,jk), jk=jl,jm ) 1609 WRITE(narea+100,'(a,*(g11.3))') ' p_avm[imld-1..ibld+2] =', ( p_avm(ji,jj,jk), jk=jl,jm ) 1610 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm ) 1611 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm ) 1612 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm ) 1613 WRITE(narea+100,'(a,*(g11.3))') ' ghamv[imld-1..ibld+2] =', ( ghamv(ji,jj,jk), jk=jl,jm ) 1614 WRITE(narea+100,*) 1615 FLUSH(narea+100) 1616 END IF 1617 #endif 1542 1618 1543 1619 IF(ln_dia_osm) THEN … … 2475 2551 ! OSBL is deepening, entrainment > restratification 2476 2552 IF ( zdb_bl(ji,jj) > 1.0e-15 ) THEN 2477 zgamma_b_nd = MAX( zdbdz_bl_ext(ji,jj), 0._wp ) * zdh(ji,jj) / zdb_ml(ji,jj)2553 zgamma_b_nd = MAX( zdbdz_bl_ext(ji,jj), 0._wp ) * zdh(ji,jj) / ( zvel_max + MAX( zdb_bl(ji,jj), 1.0e-15 ) ) 2478 2554 zpsi = ( 1.0 - 0.5 * zdh(ji,jj) / zhbl(ji,jj) ) * ( zwb0(ji,jj) - MIN( ( zwb_min(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ), 0._wp ) ) * zdh(ji,jj) / zhbl(ji,jj) 2479 2555 zpsi = zpsi + 1.75 * ( 1.0 - 0.5 * zdh(ji,jj) / zhbl(ji,jj) )*( zdh(ji,jj) / zhbl(ji,jj) + zgamma_b_nd ) * MIN( ( zwb_min(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ), 0._wp ) … … 2494 2570 ENDIF 2495 2571 ! Relaxation to dh_ref = zari * hbl 2496 zddhdt = -a_ddh_2 * ( 1.0 - zdh(ji,jj) / ( zari * zhbl(ji,jj) ) ) * zwb_ent(ji,jj) / zdb_bl(ji,jj)2572 zddhdt = -a_ddh_2 * ( 1.0 - zdh(ji,jj) / ( zari * zhbl(ji,jj) ) ) * zwb_ent(ji,jj) / ( zvel_max + MAX( zdb_bl(ji,jj), 1.0e-15 ) ) 2497 2573 #ifdef key_osm_debug 2498 2574 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN … … 2504 2580 ELSE IF ( j_ddh(ji,jj) == 0 ) THEN 2505 2581 ! Growing shear layer 2506 zddhdt = -a_ddh * ( 1.0 - 1.6 * zdh(ji,jj) / zhbl(ji,jj) ) * zwb_ent(ji,jj) / zdb_bl(ji,jj)2582 zddhdt = -a_ddh * ( 1.0 - 1.6 * zdh(ji,jj) / zhbl(ji,jj) ) * zwb_ent(ji,jj) / ( zvel_max + MAX( zdb_bl(ji,jj), 1.0e-15 ) ) 2507 2583 zddhdt = EXP( - 4.0 * ABS( ff_t(ji,jj) ) * zhbl(ji,jj) / MAX(zustar(ji,jj), 1.e-8 ) ) * zddhdt 2508 2584 ELSE … … 2510 2586 ENDIF ! j_ddh 2511 2587 zdhdt(ji,jj) = zdhdt(ji,jj) + zalpha_b * ( 1.0 -0.5 * zdh(ji,jj) / zhbl(ji,jj) ) * & 2512 & zdb_ml(ji,jj) * zddhdt/ ( zvel_max + MAX( zdb_bl(ji,jj), 1.0e-15 ) )2588 & zdb_ml(ji,jj) * MAX(zddhdt,0._wp) / ( zvel_max + MAX( zdb_bl(ji,jj), 1.0e-15 ) ) 2513 2589 ELSE ! zdb_bl >0 2514 2590 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / MAX( zvel_max, 1.0e-15)
Note: See TracChangeset
for help on using the changeset viewer.
