- Timestamp:
- 2021-05-10T15:59:00+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14122_HPC-08_Mueller_OSMOSIS_streamlining/src/OCE/ZDF/zdfosm.F90
r14822 r14824 218 218 REAL(wp) :: rn_difconv = 1.0_wp ! Diffusivity when unstable below BL (m2/s) 219 219 ! 220 #ifdef key_osm_debug221 INTEGER :: nn_idb = 297, nn_jdb = 193, nn_kdb = 35, nn_narea_db = 109222 INTEGER :: iloc_db, jloc_db223 #endif224 !225 220 ! OSMOSIS mixed layer eddy parametrization constants 226 221 INTEGER :: nn_osm_mle ! = 0/1 flag for horizontal average on avt … … 437 432 zdiff_mle(:,:) = 0.0_wp 438 433 ! 439 #ifdef key_osm_debug440 IF(mi0(nn_idb)==mi1(nn_idb) .AND. mj0(nn_jdb)==mj1(nn_jdb) .AND. &441 & mi0(nn_idb) > 1 .AND. mi0(nn_idb) < jpi .AND. mj0(nn_jdb) > 1 .AND. mj0(nn_jdb) < jpj) THEN442 nn_narea_db = narea443 iloc_db=mi0(nn_idb); jloc_db=mj0(nn_jdb)444 WRITE(narea+100,*)445 WRITE(narea+100,'(a,i7)')'timestep=',kt446 WRITE(narea+100,'(3(a,i7))')'narea=',narea,' nn_idb',nn_idb,' nn_jdb=',nn_jdb447 WRITE(narea+100,'(4(a,i7))')'iloc_db=',iloc_db,' jloc_db',jloc_db,' jpi=',jpi,' jpj=',jpj448 ji=iloc_db; jj=jloc_db449 WRITE(narea+100,'(a,i7,5(a,g10.2))')'mbkt=',mbkt(ji,jj),' ht_n',ht(ji,jj),&450 &' hu_n-',hu(ji-1,jj,Kmm),' hu_n+',hu(ji,jj,Kmm), ' hv_n-',hv(ji,jj-1,Kmm),' hv_n+',hv(ji,jj,Kmm)451 WRITE(narea+100,*)452 FLUSH(narea+100)453 ELSE454 nn_narea_db = -1000455 END IF456 #endif457 !458 434 ! hbl = MAX(hbl,epsln) 459 435 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 493 469 scos_wind(ji,jj) = -1.0_wp * suw0(ji,jj) / ( sustar(ji,jj) * sustar(ji,jj) ) 494 470 ssin_wind(ji,jj) = -1.0_wp * zvw0 / ( sustar(ji,jj) * sustar(ji,jj) ) 495 #ifdef key_osm_debug496 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN497 zthermal = rab_n(ji,jj,1,jp_tem)498 zbeta = rab_n(ji,jj,1,jp_sal)499 zradav = zrad0(ji,jj) * ( zz0 * ( 1.0_wp - EXP( -hbl(ji,jj)/rn_si0 ) ) * rn_si0 + &500 & zz1 * ( 1.0_wp - EXP( -hbl(ji,jj)/rn_si1 ) ) * rn_si1 ) / hbl(ji,jj)501 WRITE(narea+100,'(4(3(a,g11.3),/), 2(a,g11.3),/)') &502 & 'after calculating fluxes: hbl=', hbl(ji,jj),' zthermal=',zthermal, ' zbeta=', zbeta,&503 & ' zrad0=', zrad0(ji,jj),' zradh=', zradh(ji,jj), ' zradav=', zradav, &504 & ' swth0=', swth0(ji,jj), ' swthav=', swthav(ji,jj), ' sws0=', sws0(ji,jj), &505 & ' swb0=', swb0(ji,jj), ' zwb0tot=', zwb0tot(ji,jj), ' zwb0tot_in hbl=', zwb0tot(ji,jj) + grav * zthermal * zradh(ji,jj),&506 & ' swbav=', swbav(ji,jj)507 FLUSH(narea+100)508 END IF509 #endif510 471 END_2D 511 472 ! Calculate Stokes drift in direction of wind (sustke) and Stokes penetration depth (dstokes) … … 545 506 END_2D 546 507 END SELECT 547 #ifdef key_osm_debug548 IF(narea==nn_narea_db)THEN549 WRITE(narea+100,'(2(a,g11.3))') &550 & 'Before reduction: sustke=', sustke(iloc_db,jloc_db),' dstokes =',dstokes(iloc_db,jloc_db)551 FLUSH(narea+100)552 END IF553 #endif554 508 ! 555 509 IF (ln_zdfosm_ice_shelter) THEN … … 631 585 shol(ji,jj) = -1.0_wp * hbl(ji,jj) * 2.0_wp * swbav(ji,jj) / ( svstr(ji,jj)**3 + epsln ) 632 586 ENDIF 633 #ifdef key_osm_debug634 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN635 WRITE(narea+100,'(2(a,g11.3),/,3(a,g11.3),/,3(a,g11.3),/)') &636 & 'After reduction: sustke=', sustke(ji,jj), ' dstokes=', dstokes(ji,jj), &637 & ' zustar =', sustar(ji,jj), ' swstrl=', swstrl(ji,jj), ' swstrc=', swstrc(ji,jj),&638 & ' shol=', shol(ji,jj), ' sla=', sla(ji,jj), ' svstr=', svstr(ji,jj)639 FLUSH(narea+100)640 END IF641 #endif642 587 END_2D 643 588 ! … … 667 612 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 668 613 END_2D 669 #ifdef key_osm_debug670 IF(narea==nn_narea_db) THEN671 ji=iloc_db; jj=jloc_db672 WRITE(narea+100,'(2(a,g11.3),/,3(a,g11.3),/,2(a,i7),/)') &673 & 'Before updating hbl: hbl=', hbl(ji,jj), ' dh=', dh(ji,jj), &674 &' zhbl =',zhbl(ji,jj) , ' zhml=', zhml(ji,jj), ' zdh=', zdh(ji,jj),&675 &' imld=', nmld(ji,jj), ' ibld=', nbld(ji,jj)676 WRITE(narea+100,'(a,g11.3,a,2g11.3)') 'Physics: ssh ',ssh(ji,jj,Kmm),' T S surface=',ts(ji,jj,1,jp_tem,Kmm),ts(ji,jj,1,jp_sal,Kmm)677 jl = nmld(ji,jj) - 1; jm = MIN( nbld(ji,jj) + 2, mbkt(ji,jj) )678 WRITE(narea+100,'(a,*(g11.3))') ' T[imld-1..ibld+2] =', ( ts(ji,jj,jk,jp_tem,Kmm), jk=jl,jm )679 WRITE(narea+100,'(a,*(g11.3))') ' S[imld-1..ibld+2] =', ( ts(ji,jj,jk,jp_sal,Kmm), jk=jl,jm )680 WRITE(narea+100,'(a,*(g11.3))') ' U+[imld-1..ibld+2] =', ( uu(ji,jj,jk,Kmm), jk=jl,jm )681 WRITE(narea+100,'(a,*(g11.3))') ' U-[imld-1..ibld+2] =', ( uu(ji-1,jj,jk,Kmm), jk=jl,jm )682 WRITE(narea+100,'(a,*(g11.3))') ' V+[imld-1..ibld+2] =', ( vv(ji,jj,jk,Kmm), jk=jl,jm )683 WRITE(narea+100,'(a,*(g11.3))') ' V-[imld-1..ibld+2] =', ( vv(ji,jj-1,jk,Kmm), jk=jl,jm )684 WRITE(narea+100,'(a,*(g11.3))') ' W[imld-1..ibld+2] =', ( ww(ji,jj-1,jk), jk=jl,jm )685 WRITE(narea+100,*)686 FLUSH(narea+100)687 END IF688 #endif689 614 ! 690 615 ! Averages over well-mixed and boundary layer, note BL averages use jp_ext=2 everywhere … … 697 622 & av_b_ml, av_u_ml, av_v_ml, jp_ext, av_dt_ml, & 698 623 & av_ds_ml, av_db_ml, av_du_ml, av_dv_ml ) 699 #ifdef key_osm_debug700 IF(narea==nn_narea_db) THEN701 ji=iloc_db; jj=jloc_db702 WRITE(narea+100,'(4(3(a,g11.3),/), 2(4(a,g11.3),/))') &703 & 'After averaging, with old hbl (& jp_ext==2), hml: zt_bl=', av_t_bl(ji,jj),&704 & ' zs_bl=', av_s_bl(ji,jj), ' zb_bl=', av_b_bl(ji,jj),&705 & 'zdt_bl=', av_dt_bl(ji,jj), ' zds_bl=', av_ds_bl(ji,jj), ' zdb_bl=', av_db_bl(ji,jj),&706 & 'zt_ml=', av_t_ml(ji,jj), ' zs_ml=', av_s_ml(ji,jj), ' zb_ml=', av_b_ml(ji,jj),&707 & 'zdt_ml=', av_dt_ml(ji,jj), ' zds_ml=', av_ds_ml(ji,jj), ' zdb_ml=', av_db_ml(ji,jj),&708 & 'zu_bl =', av_u_bl(ji,jj) , ' zv_bl=', av_v_bl(ji,jj), ' zdu_bl=', av_du_bl(ji,jj), ' zdv_bl=', av_dv_bl(ji,jj),&709 & 'zu_ml =', av_u_ml(ji,jj) , ' zv_ml=', av_v_ml(ji,jj), ' zdu_ml=', av_du_ml(ji,jj), ' zdv_ml=', av_dv_ml(ji,jj)710 FLUSH(narea+100)711 END IF712 #endif713 624 ! Velocity components in frame aligned with surface stress 714 625 CALL zdf_osm_velocity_rotation( av_u_ml, av_v_ml ) … … 716 627 CALL zdf_osm_velocity_rotation( av_u_bl, av_v_bl ) 717 628 CALL zdf_osm_velocity_rotation( av_du_bl, av_dv_bl ) 718 #ifdef key_osm_debug719 IF(narea==nn_narea_db) THEN720 ji=iloc_db; jj=jloc_db721 WRITE(narea+100,'(a,/, 2(4(a,g11.3),/))') &722 & 'After rotation, with old hbl (& jp_ext==2), hml:', &723 & 'zu_bl =', av_u_bl(ji,jj) , ' zv_bl=', av_v_bl(ji,jj), ' zdu_bl=', av_du_bl(ji,jj), ' zdv_bl=', av_dv_bl(ji,jj),&724 & 'zu_ml =', av_u_ml(ji,jj) , ' zv_ml=', av_v_ml(ji,jj), ' zdu_ml=', av_du_ml(ji,jj), ' zdv_ml=', av_dv_ml(ji,jj)725 FLUSH(narea+100)726 END IF727 #endif728 629 ! 729 630 ! Determine the state of the OSBL, stable/unstable, shear/no shear … … 731 632 & zhml, zdh ) 732 633 ! 733 #ifdef key_osm_debug734 IF(narea==nn_narea_db) THEN735 ji=iloc_db; jj=jloc_db736 WRITE(narea+100,'(2(a,l7),a, i7,/,3(a,g11.3),/)') &737 & 'After zdf_osm_osbl_state: lconv=', l_conv(ji,jj), ' lshear=', l_shear(ji,jj), ' j_ddh=', n_ddh(ji,jj),&738 & 'zwb_ent=', zwb_ent(ji,jj), ' zwb_min=', zwb_min(ji,jj), ' zshear=', zshear(ji,jj)739 FLUSH(narea+100)740 END IF741 #endif742 634 IF ( ln_osm_mle ) THEN 743 635 ! Fox-Kemper Scheme … … 752 644 zhmle(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) 753 645 END_2D 754 #ifdef key_osm_debug755 IF(narea==nn_narea_db) THEN756 ji=iloc_db; jj=jloc_db757 WRITE(narea+100,'(2(a,g11.3), a, i7,/,(3(a,g11.3),/),2(a,g11.3),/)') &758 & 'Before updating hmle: hmle =',hmle(ji,jj) , ' zhmle=', zhmle(ji,jj), ' mld_prof=', mld_prof(ji,jj), &759 & 'averaging over hmle: zt_mle=', av_t_mle(ji,jj), ' zs_mle=', av_s_mle(ji,jj), ' zb_mle=', av_b_mle(ji,jj),&760 & 'zu_mle =', av_u_mle(ji,jj), ' zv_mle=', av_v_mle(ji,jj)761 FLUSH(narea+100)762 END IF763 #endif764 646 ! 765 647 ! Calculate fairly-well-mixed depth zmld & its index mld_prof + lateral zmld-averaged gradients … … 772 654 CALL zdf_osm_mle_parameters( Kmm, mld_prof, zmld, zhmle, zvel_mle, & 773 655 & zdiff_mle, zdbds_mle, zhbl, zwb0tot ) 774 #ifdef key_osm_debug775 IF(narea==nn_narea_db) THEN776 ji=iloc_db; jj=jloc_db777 WRITE(narea+100,'(a,g11.3,a,i7,/, 2(4(a,g11.3),/),2(a,g11.3),/,2(3(a,g11.3),/),a,i7,2(a,g11.3),/,3(a,g11.3),/,/)') &778 & 'Before updating hmle: zmld =',zmld(ji,jj),' mld_prof=', mld_prof(ji,jj), &779 & 'zdtdx+=', zdtdx(ji,jj),' zdtdx-=', zdtdx(ji-1,jj),' zdsdx+=', zdsdx(ji,jj),' zdsdx-=',zdsdx(ji-1,jj), &780 & 'zdtdy+=', zdtdy(ji,jj),' zdtdy-=', zdtdy(ji,jj-1),' zdsdy+=', zdsdy(ji,jj),' zdsdy-=',zdsdy(ji,jj-1), &781 & 'dbdx_mle+=', dbdx_mle(ji,jj),' dbdx_mle-=', dbdx_mle(ji-1,jj),&782 & 'dbdy_mle+=', dbdy_mle(ji,jj),' dbdy_mle-=',dbdy_mle(ji,jj-1),' zdbds_mle=',zdbds_mle(ji,jj), &783 & 'After updating hmle: mld_prof=', mld_prof(ji,jj),' hmle=', hmle(ji,jj), ' zhmle=', zhmle(ji,jj),&784 & 'zvel_mle =', zvel_mle(ji,jj), ' zdiff_mle=', zdiff_mle(ji,jj), ' zwb_fk=', zwb_fk(ji,jj)785 FLUSH(narea+100)786 END IF787 #endif788 656 ELSE ! ln_osm_mle 789 657 ! FK not selected, Boundary Layer only. … … 815 683 ! ENDIF 816 684 ! END_2D 817 #ifdef key_osm_debug818 IF(narea==nn_narea_db) THEN819 ji=iloc_db; jj=jloc_db820 WRITE(narea+100,'(4(a,l7),a,i7,/, 3(a,g11.3),/)') &821 & 'BL logical descriptors: lconv =',l_conv(ji,jj),' lpyc=', l_pyc(ji,jj),' lflux=', l_flux(ji,jj),' lmle=', l_mle(ji,jj),&822 & ' jp_ext=', jp_ext(ji,jj), &823 & 'sub-BL strat: zdtdz_bl_ext=', zdtdz_bl_ext(ji,jj),' zdsdz_bl_ext=', zdsdz_bl_ext(ji,jj),' zdbdz_bl_ext=', zdbdz_bl_ext(ji,jj)824 FLUSH(narea+100)825 END IF826 #endif827 685 ! 828 686 ! Recalculate bl averages using jp_ext & ml averages .... note no rotation of u & v here.. … … 835 693 & av_b_ml, av_u_ml, av_v_ml, jp_ext, av_dt_ml, & 836 694 & av_ds_ml, av_db_ml, av_du_ml, av_dv_ml ) ! ag 19/03 837 #ifdef key_osm_debug838 IF(narea==nn_narea_db) THEN839 ji=iloc_db; jj=jloc_db840 WRITE(narea+100,'(4(3(a,g11.3),/), 2(4(a,g11.3),/))') &841 & 'After averaging, with old hbl (&correct jp_ext), hml: zt_bl=', av_t_bl(ji,jj),&842 & ' zs_bl=', av_s_bl(ji,jj), ' zb_bl=', av_b_bl(ji,jj),&843 & 'zdt_bl=', av_dt_bl(ji,jj), ' zds_bl=', av_ds_bl(ji,jj), ' zdb_bl=', av_db_bl(ji,jj),&844 & 'zt_ml=', av_t_ml(ji,jj), ' zs_ml=', av_s_ml(ji,jj), ' zb_ml=', av_b_ml(ji,jj),&845 & 'zdt_ml=', av_dt_ml(ji,jj), ' zds_ml=', av_ds_ml(ji,jj), ' zdb_ml=', av_db_ml(ji,jj),&846 & 'zu_bl =', av_u_bl(ji,jj) , ' zv_bl=', av_v_bl(ji,jj), ' zdu_bl=', av_du_bl(ji,jj), ' zdv_bl=', av_dv_bl(ji,jj),&847 & 'zu_ml =', av_u_ml(ji,jj) , ' zv_ml=', av_v_ml(ji,jj), ' zdu_ml=', av_du_ml(ji,jj), ' zdv_ml=', av_dv_ml(ji,jj)848 FLUSH(narea+100)849 END IF850 #endif851 695 ! 852 696 ! Rate of change of hbl … … 865 709 END IF 866 710 END IF 867 #ifdef key_osm_debug868 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN869 WRITE(narea+100,'(2(a,g11.3),/,2(a,g11.3)),2(a,l7)')'after zdf_osm_calculate_dhdt: zhbl_t=',zhbl_t(ji,jj), 'hbl=', hbl(ji,jj),&870 & 'delta hbl from dzdhdt', zdhdt(ji,jj)*rn_Dt,' delta hbl from w ', ww(ji,jj,nbld(ji,jj))*rn_Dt, &871 & ' lcoup= ', l_coup(ji,jj), ' lpyc= ', l_pyc(ji,jj)872 FLUSH(narea+100)873 END IF874 #endif875 711 END_2D 876 712 ! … … 911 747 dh(ji,jj) = zdh(ji,jj) ! ag 19/03 912 748 hml(ji,jj) = hbl(ji,jj) - dh(ji,jj) ! ag 19/03 913 #ifdef key_osm_debug914 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN915 WRITE(narea+100,'(a)')'After setting pycnocline thickness BL running aground: lpyc= F5: ibld(ji,jj) >= mbkt(ji,jj) -2'916 WRITE(narea+100,'(2(a,i7),2(a,g11.3))')' ibld=',nbld(ji,jj),' imld=',nmld(ji,jj), ' zdh=',zdh(ji,jj), ' zhml=',zhml(ji,jj)917 WRITE(narea+100,'(2(a,g11.3))')'dh=',dh(ji,jj),' hml=',hml(ji,jj)918 FLUSH(narea+100)919 END IF920 #endif921 749 ENDIF 922 750 ENDIF ! ag 19/03 … … 935 763 ! 936 764 CALL zdf_osm_external_gradients( Kmm, nbld(A2D(0)) + 1, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext ) 937 #ifdef key_osm_debug938 IF(narea==nn_narea_db) THEN939 ji=iloc_db; jj=jloc_db940 WRITE(narea+100,'(4(3(a,g11.3),/), 2(4(a,g11.3),/))') &941 & 'After averaging, with new hbl (&correct jp_ext), hml: zt_bl=', av_t_bl(ji,jj),&942 & ' zs_bl=', av_s_bl(ji,jj), ' zb_bl=', av_b_bl(ji,jj),&943 & 'zdt_bl=', av_dt_bl(ji,jj), ' zds_bl=', av_ds_bl(ji,jj), ' zdb_bl=', av_db_bl(ji,jj),&944 & 'zt_ml=', av_t_ml(ji,jj), ' zs_ml=', av_s_ml(ji,jj), ' zb_ml=', av_b_ml(ji,jj),&945 & 'zdt_ml=', av_dt_ml(ji,jj), ' zds_ml=', av_ds_ml(ji,jj), ' zdb_ml=', av_db_ml(ji,jj),&946 & 'zu_bl =', av_u_bl(ji,jj) , ' zv_bl=', av_v_bl(ji,jj), ' zdu_bl=', av_du_bl(ji,jj), ' zdv_bl=', av_dv_bl(ji,jj),&947 & 'zu_ml =', av_u_ml(ji,jj) , ' zv_ml=', av_v_ml(ji,jj), ' zdu_ml=', av_du_ml(ji,jj), ' zdv_ml=', av_dv_ml(ji,jj)948 FLUSH(narea+100)949 END IF950 #endif951 765 ! Rotate mean currents and changes onto wind aligned co-ordinates 952 766 CALL zdf_osm_velocity_rotation( av_u_ml, av_v_ml ) … … 954 768 CALL zdf_osm_velocity_rotation( av_u_bl, av_v_bl ) 955 769 CALL zdf_osm_velocity_rotation( av_du_bl, av_dv_bl ) 956 #ifdef key_osm_debug957 IF(narea==nn_narea_db) THEN958 ji=iloc_db; jj=jloc_db959 WRITE(narea+100,'(a,/, 2(4(a,g11.3),/))') &960 & 'After rotation, with new hbl (& correct jp_ext), hml:', &961 & 'zu_bl =', av_u_bl(ji,jj) , ' zv_bl=', av_v_bl(ji,jj), ' zdu_bl=', av_du_bl(ji,jj), ' zdv_bl=', av_dv_bl(ji,jj),&962 & 'zu_ml =', av_u_ml(ji,jj) , ' zv_ml=', av_v_ml(ji,jj), ' zdu_ml=', av_du_ml(ji,jj), ' zdv_ml=', av_dv_ml(ji,jj)963 FLUSH(narea+100)964 END IF965 #endif966 770 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 967 771 ! Eddy viscosity/diffusivity and non-gradient terms in the flux-gradient relationship … … 970 774 & zhml, zdh, zdhdt, zshear, zwb_ent, & 971 775 & zwb_min ) 972 #ifdef key_osm_debug973 IF(narea==nn_narea_db) THEN974 ji=iloc_db; jj=jloc_db975 jl = nmld(ji,jj) - 1; jm = MIN( nbld(ji,jj) + 2, mbkt(ji,jj) )976 WRITE(narea+100,'(a,*(g11.3))') ' zdiffut[imld-1..ibld+2] =', ( zdiffut(ji,jj,jk), jk=jl,jm )977 WRITE(narea+100,'(a,*(g11.3))') ' zviscos[imld-1..ibld+2] =', ( zviscos(ji,jj,jk), jk=jl,jm )978 WRITE(narea+100,*)979 FLUSH(narea+100)980 END IF981 #endif982 776 ! 983 777 ! Calculate non-gradient components of the flux-gradient relationships … … 1036 830 END_2D 1037 831 END IF ! ln_convmix = .true. 1038 #ifdef key_osm_debug1039 IF(narea==nn_narea_db) THEN1040 ji=iloc_db; jj=jloc_db1041 jl = nmld(ji,jj) - 1; jm = MIN( nbld(ji,jj) + 2, mbkt(ji,jj) )1042 WRITE(narea+100,'(a)') ' After including KPP Ri# diffusivity & viscosity'1043 WRITE(narea+100,'(a,*(g11.3))') ' zdiffut[imld-1..ibld+2] =', ( zdiffut(ji,jj,jk), jk=jl,jm )1044 WRITE(narea+100,'(a,*(g11.3))') ' zviscos[imld-1..ibld+2] =', ( zviscos(ji,jj,jk), jk=jl,jm )1045 WRITE(narea+100,*)1046 FLUSH(narea+100)1047 END IF1048 #endif1049 832 ! 1050 833 IF ( ln_osm_mle ) THEN ! Set up diffusivity and non-gradient mixing … … 1077 860 END IF 1078 861 END_2D 1079 #ifdef key_osm_debug1080 IF(narea==nn_narea_db) THEN1081 ji=iloc_db; jj=jloc_db1082 jl = nmld(ji,jj) - 1; jm = MIN( nbld(ji,jj) + 2, mbkt(ji,jj) )1083 WRITE(narea+100,'(a)') ' After including FK diffusivity & non-local terms'1084 WRITE(narea+100,'(a,*(g11.3))') ' zdiffut[imld-1..ibld+2] =', ( zdiffut(ji,jj,jk), jk=jl,jm )1085 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm )1086 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm )1087 WRITE(narea+100,*)1088 FLUSH(narea+100)1089 END IF1090 #endif1091 862 ENDIF 1092 863 ! … … 1122 893 & ghamu, 'U', -1.0_wp, & 1123 894 & ghamv, 'V', -1.0_wp ) 1124 #ifdef key_osm_debug1125 IF(narea==nn_narea_db) THEN1126 ji=iloc_db; jj=jloc_db1127 jl = nmld(ji,jj) - 1; jm = MIN( nbld(ji,jj) + 2, mbkt(ji,jj) )1128 WRITE(narea+100,'(a)') ' Final diffusivity & viscosity, & non-local terms'1129 WRITE(narea+100,'(a,*(g11.3))') ' p_avt[imld-1..ibld+2] =', ( p_avt(ji,jj,jk), jk=jl,jm )1130 WRITE(narea+100,'(a,*(g11.3))') ' p_avm[imld-1..ibld+2] =', ( p_avm(ji,jj,jk), jk=jl,jm )1131 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm )1132 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm )1133 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm )1134 WRITE(narea+100,'(a,*(g11.3))') ' ghamv[imld-1..ibld+2] =', ( ghamv(ji,jj,jk), jk=jl,jm )1135 WRITE(narea+100,*)1136 FLUSH(narea+100)1137 END IF1138 #endif1139 895 ! 1140 896 IF ( ln_dia_osm ) THEN … … 1549 1305 zekman(:,:) = EXP( -1.0_wp * pp_ek * ABS( ff_t(A2D(0)) ) * phbl(:,:) / MAX( sustar(A2D(0)), 1.e-8 ) ) 1550 1306 ! 1551 #ifdef key_osm_debug1552 IF(narea==nn_narea_db) THEN1553 ji=iloc_db; jj=jloc_db1554 WRITE(narea+100,'(a,g11.3)') &1555 & 'zdf_osm_osbl_state start: zekman=', zekman(ji,jj)1556 FLUSH(narea+100)1557 END IF1558 #endif1559 !1560 1307 DO_2D( 0, 0, 0, 0 ) 1561 1308 IF ( l_conv(ji,jj) ) THEN … … 1576 1323 & pp_b_shr * MAX( -1.0_wp * ff_t(ji,jj) * sustke(ji,jj) * dstokes(ji,jj) * & 1577 1324 & av_dv_ml(ji,jj) / phbl(ji,jj), 0.0_wp ) ) 1578 #ifdef key_osm_debug1579 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN1580 WRITE(narea+100,'(a,g11.3)')'zdf_osm_osbl_state 1st zshear: zshear=',pshear(ji,jj)1581 WRITE(narea+100,'(2(a,g11.3))')'zdf_osm_osbl_state 1st zshear: zri_b=',zri_b(ji,jj),' zri_p=',zri_p(ji,jj)1582 FLUSH(narea+100)1583 END IF1584 #endif1585 1325 ! Stability dependence 1586 1326 pshear(ji,jj) = pshear(ji,jj) * EXP( -0.75_wp * MAX( 0.0_wp, ( zri_b(ji,jj) - pp_ri_c ) / pp_ri_c ) ) 1587 #ifdef key_osm_debug1588 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN1589 WRITE(narea+100,'(a,g11.3)')'zdf_osm_osbl_state 1st zshear: zshear inc ri part=',pshear(ji,jj)1590 FLUSH(narea+100)1591 END IF1592 #endif1593 1327 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1594 1328 ! Test ensures n_ddh=0 is not selected. Change to zri_p<27 when ! … … 1641 1375 & zr_stokes * ( pp_alpha_s * EXP( -1.5_wp * sla(ji,jj) ) * zrf_shear * sustar(ji,jj)**3 - & 1642 1376 & zrf_langmuir * pp_alpha_lc * swstrl(ji,jj)**3 ) / phml(ji,jj) 1643 #ifdef key_osm_debug1644 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN1645 WRITE(narea+100,'(a,g11.3)')'zdf_osm_osbl_state conv+shear0/lang: zwb_ent=',pwb_ent(ji,jj)1646 FLUSH(narea+100)1647 END IF1648 #endif1649 1377 ENDIF 1650 1378 END_2D … … 1655 1383 ! Unstable OSBL 1656 1384 zwb_shr = -1.0_wp * pp_a_wb_s * zri_b(ji,jj) * pshear(ji,jj) 1657 #ifdef key_osm_debug1658 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN1659 WRITE(narea+100,'(a,g11.3)')'zdf_osm_osbl_state 1st zwb_shr: zwb_shr=',zwb_shr1660 FLUSH(narea+100)1661 END IF1662 #endif1663 1385 IF ( n_ddh(ji,jj) == 0 ) THEN 1664 1386 ! Developing shear layer, additional shear production possible. … … 1670 1392 ! zwb_shr = zwb_shr - 0.25 * MAX ( pshear_u, 0._wp) * ( 1.0 - MIN( zri_p(ji,jj) / pp_ri_p_thresh, 1._wp )**2 ) 1671 1393 ! zwb_shr = MAX( zwb_shr, -0.25 * pshear_u ) 1672 #ifdef key_osm_debug1673 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN1674 WRITE(narea+100,'(3(a,g11.3))')'zdf_osm_osbl_state j_ddh(ji,jj) == 0:zwb_shr=',zwb_shr, &1675 & ' zshear=',pshear(ji,jj),' zshear_u=', pshear_u1676 FLUSH(narea+100)1677 END IF1678 #endif1679 1394 ENDIF 1680 1395 pwb_ent(ji,jj) = pwb_ent(ji,jj) + zwb_shr … … 1688 1403 pwb_min(ji,jj) = pwb_ent(ji,jj) + pdh(ji,jj) / phbl(ji,jj) * 2.0_wp * swbav(ji,jj) 1689 1404 END IF ! l_conv 1690 #ifdef key_osm_debug1691 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN1692 WRITE(narea+100,'(3(a,g11.3))')'end of zdf_osm_osbl_state:zwb_ent=',pwb_ent(ji,jj), &1693 & ' zwb_min=',pwb_min(ji,jj), ' zwb0tot=', zwb0tot(ji,jj), ' swbav= ', swbav(ji,jj)1694 FLUSH(narea+100)1695 END IF1696 #endif1697 1405 END_2D 1698 1406 ! … … 1806 1514 & ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) ) + & 1807 1515 & zpsi / ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) ) 1808 #ifdef key_osm_debug1809 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN1810 WRITE(narea+100,'(a,g11.3)')'Inside 1st major loop of zdf_osm_calculate_dhdt, OSBL is deepening, entrainment > restratification: zdhdt=',pdhdt(ji,jj)1811 WRITE(narea+100,'(3(a,g11.3))') ' zpsi=',zpsi, ' zgamma_b_nd=', zgamma_b_nd, ' zdh=', pdh(ji,jj)1812 FLUSH(narea+100)1813 END IF1814 #endif1815 1516 IF ( n_ddh(ji,jj) == 1 ) THEN 1816 1517 IF ( ( swstrc(ji,jj) / svstr(ji,jj) )**3 <= 0.5_wp ) THEN … … 1828 1529 zddhdt = -1.0_wp * pp_ddh_2 * ( 1.0_wp - pdh(ji,jj) / ( zari * phbl(ji,jj) ) ) * pwb_ent(ji,jj) / & 1829 1530 & ( zvel_max + MAX( av_db_bl(ji,jj), 1e-15_wp ) ) 1830 #ifdef key_osm_debug1831 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN1832 WRITE(narea+100,'(a,g11.3)')'Inside 1st major loop of zdf_osm_calculate_dhdt,j_ddh(ji,jj) == 1: zari=',zari1833 FLUSH(narea+100)1834 END IF1835 #endif1836 1531 ELSE IF ( n_ddh(ji,jj) == 0 ) THEN ! Growing shear layer 1837 1532 zddhdt = -1.0_wp * pp_ddh * ( 1.0_wp - 1.6_wp * pdh(ji,jj) / phbl(ji,jj) ) * pwb_ent(ji,jj) / & … … 1917 1612 ! 1918 1613 ENDIF ! l_shear 1919 #ifdef key_osm_debug1920 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN1921 WRITE(narea+100,'(4(a,g11.3))')'end of 1st major loop of zdf_osm_calculate_dhdt: zdhdt=',pdhdt(ji,jj), &1922 & ' zpert=', zpert, ' zddhdt=', zddhdt, ' zvel_max=', zvel_max1923 IF ( ln_osm_mle ) THEN1924 WRITE(narea+100,'(3(a,g11.3),/)') 'zvel_mle=',pvel_mle(ji,jj), ' zwb_fk_b=', pwb_fk_b(ji,jj), &1925 & ' zwb_ent + 2*zwb_fk_b =', pwb_ent(ji,jj) + 2.0 * pwb_fk_b(ji,jj)1926 FLUSH(narea+100)1927 END IF1928 END IF1929 #endif1930 1614 ! 1931 1615 END_2D … … 1963 1647 ! 1964 1648 DO_2D( 0, 0, 0, 0 ) 1965 #ifdef key_osm_debug1966 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN1967 WRITE(narea+100,'(2(a,i7))')'start of zdf_osm_timestep_hbl: old ibld=',nmld(ji,jj),' trial ibld=', nbld(ji,jj)1968 FLUSH(narea+100)1969 END IF1970 #endif1971 1649 IF ( nbld(ji,jj) - nmld(ji,jj) > 1 ) THEN 1972 1650 ! … … 1987 1665 & ( svstr(ji,jj)**3 + 0.5_wp * swstrc(ji,jj)**3 )**pthird 1988 1666 ENDIF 1989 #ifdef key_osm_debug1990 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN1991 WRITE(narea+100,'(a,g11.3)')'In zdf_osm_timestep_hbl, ibld - imld > 1, lconv=T: zvel_max=',zvel_max1992 FLUSH(narea+100)1993 END IF1994 #endif1995 1667 DO jk = nmld(ji,jj), nbld(ji,jj) 1996 1668 zdb = MAX( grav * ( zthermal * ( av_t_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) - & … … 2010 1682 ENDIF 2011 1683 IF ( zhbl_s >= gdepw(ji,jj,jm+1,Kmm) ) jm = jm + 1 2012 #ifdef key_osm_debug2013 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2014 WRITE(narea+100,'(2(a,i7))')' jk=',jk,' jm=', jm2015 WRITE(narea+100,'(2(a,g11.3),a,l7)')'zdb=',zdb,' zhbl_s=', zhbl_s,' lpyc=',l_pyc(ji,jj)2016 FLUSH(narea+100)2017 END IF2018 #endif2019 1684 END DO 2020 1685 hbl(ji,jj) = zhbl_s 2021 1686 nbld(ji,jj) = jm 2022 1687 ELSE ! Stable 2023 #ifdef key_osm_debug2024 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2025 WRITE(narea+100,'(a)')'In zdf_osm_timestep_hbl, ibld - imld > 1, lconv=F'2026 FLUSH(narea+100)2027 END IF2028 #endif2029 1688 DO jk = nmld(ji,jj), nbld(ji,jj) 2030 1689 zdb = MAX( grav * ( zthermal * ( av_t_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) - & … … 2048 1707 ENDIF 2049 1708 IF ( zhbl_s >= gdepw(ji,jj,jm,Kmm) ) jm = jm + 1 2050 #ifdef key_osm_debug2051 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2052 WRITE(narea+100,'(2(a,i7))')' jk=',jk,' jm=', jm2053 WRITE(narea+100,'(4(a,g11.3),a,l7)')'zdb=',zdb,' shol',shol(ji,jj),' zdhdt',pdhdt(ji,jj),' zhbl_s=', zhbl_s,' lpyc=',l_pyc(ji,jj)2054 FLUSH(narea+100)2055 END IF2056 #endif2057 1709 END DO 2058 1710 ENDIF ! IF ( l_conv ) … … 2064 1716 ENDIF 2065 1717 phbl(ji,jj) = gdepw(ji,jj,nbld(ji,jj),Kmm) 2066 #ifdef key_osm_debug2067 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2068 WRITE(narea+100,'(2(a,g11.3),a,i7,/)')'end of zdf_osm_timestep_hbl: hbl=', hbl(ji,jj),' zhbl=', phbl(ji,jj),' ibld=', nbld(ji,jj)2069 FLUSH(narea+100)2070 END IF2071 #endif2072 1718 END_2D 2073 1719 ! … … 2238 1884 phml(ji,jj) = gdepw(ji,jj,nmld(ji,jj),Kmm) 2239 1885 pdh(ji,jj) = phbl(ji,jj) - phml(ji,jj) 2240 #ifdef key_osm_debug2241 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2242 WRITE(narea+100,'(4(a,g11.3),2(a,i7),/,5(a,g11.3),/)') 'end of zdf_osm_pycnocline_thickness:hml=',hml(ji,jj), &2243 & ' zhml=',phml(ji,jj),' zdh=', pdh(ji,jj), ' dh=', dh(ji,jj), ' imld=', nmld(ji,jj), ' inhml=', inhml, &2244 & 'zvel_max=', zvel_max, ' ztau=', ztau,' zdh_ref=', zdh_ref, ' zar=', zari, ' zddhdt=', zddhdt2245 FLUSH(narea+100)2246 END IF2247 #endif2248 1886 ! 2249 1887 END_2D … … 2325 1963 END IF 2326 1964 END DO 2327 #ifdef key_osm_debug2328 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2329 WRITE(narea+100,'(a,/,3(a,g11.3),/,2(a,g11.3),/)')'end of zdf_osm_pycnocline_buoyancy_profiles:lconv=lpyc=T',&2330 & 'zzeta_m=', zzeta_m, ' zalpha=', palpha(ji,jj), ' ztmp=', ztmp,&2331 & ' zbgrad=', zbgrad, ' zgamma_b_nd=', zgamma_b_nd2332 FLUSH(narea+100)2333 END IF2334 #endif2335 1965 END IF ! If no pycnocline pycnocline gradients set to zero 2336 1966 ! … … 2354 1984 END DO 2355 1985 END IF ! IF (shol >=0.5) 2356 #ifdef key_osm_debug2357 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2358 WRITE(narea+100,'(1(a,g11.3))')'end of zdf_osm_pycnocline_buoyancy_profiles:lconv=F zbgrad=', zbgrad2359 ! WRITE(narea+100,'(1(a,g11.3))')'end of zdf_osm_pycnocline_scalar_profiles:lconv=F ztgrad=',&2360 ! & ztgrad, ' zsgrad=', zsgrad, ' zbgrad=', zbgrad2361 FLUSH(narea+100)2362 END IF2363 #endif2364 1986 END IF ! IF (av_db_bl> 0.) 2365 1987 END IF ! IF (pdhdt >= 0) pdhdt < 0 not considered since pycnocline profile is zero and profile arrays are intialized to zero … … 2436 2058 zdifml_sc(ji,jj) = pp_dif_ml * phml(ji,jj) * zvel_sc_ml 2437 2059 zvisml_sc(ji,jj) = pp_vis_ml * zdifml_sc(ji,jj) 2438 #ifdef key_osm_debug2439 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2440 WRITE(narea+100,'(2(a,g11.3))')'Start of 1st major loop of osm_diffusivity_viscositys, ldconv=T: zdifml_sc=',zdifml_sc(ji,jj),' zvisml_sc=',zvisml_sc(ji,jj)2441 WRITE(narea+100,'(3(a,g11.3))')'zvel_sc_pyc=',zvel_sc_pyc,' zvel_sc_ml=',zvel_sc_ml,' zstab_fac=',zstab_fac2442 FLUSH(narea+100)2443 END IF2444 #endif2445 2060 ! 2446 2061 IF ( l_pyc(ji,jj) ) THEN … … 2451 2066 & pdh(ji,jj) 2452 2067 zvispyc_n_sc(ji,jj) = pp_vis_pyc * zvel_sc_ml * pdh(ji,jj) + zvispyc_n_sc(ji,jj) * zstab_fac 2453 #ifdef key_osm_debug2454 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2455 WRITE(narea+100,'(2(a,g11.3))')' lpyc=ldconv=T, variables w/o shear contributions: zdifpyc_n_sc',zdifpyc_n_sc(ji,jj) ,' zvispyc_n_sc=',zvispyc_n_sc(ji,jj)2456 FLUSH(narea+100)2457 END IF2458 #endif2459 2068 ! 2460 2069 IF ( l_shear(ji,jj) .AND. n_ddh(ji,jj) /= 2 ) THEN … … 2463 2072 zvispyc_n_sc(ji,jj) = zvispyc_n_sc(ji,jj) + ztmp 2464 2073 ENDIF 2465 #ifdef key_osm_debug2466 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2467 WRITE(narea+100,'(2(a,g11.3))')' lpyc=ldconv=T, variables w shear contributions: zdifpyc_n_sc',zdifpyc_n_sc(ji,jj) ,' zvispyc_n_sc=',zvispyc_n_sc(ji,jj)2468 FLUSH(narea+100)2469 END IF2470 #endif2471 2074 ! 2472 2075 zdifpyc_s_sc(ji,jj) = pwb_ent(ji,jj) + 0.0025_wp * zvel_sc_pyc * ( phbl(ji,jj) / pdh(ji,jj) - 1.0_wp ) * & … … 2475 2078 & ( phbl(ji,jj) / pdh(ji,jj) - 1.0_wp ) * & 2476 2079 & ( av_b_ml(ji,jj) - av_b_bl(ji,jj) ) ) 2477 #ifdef key_osm_debug2478 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2479 WRITE(narea+100,'(2(a,g11.3))')' 1st shot at: zdifpyc_s_sc',zdifpyc_s_sc(ji,jj) ,' zvispyc_s_sc=',zvispyc_s_sc(ji,jj)2480 FLUSH(narea+100)2481 END IF2482 #endif2483 2080 zdifpyc_s_sc(ji,jj) = 0.09_wp * zdifpyc_s_sc(ji,jj) * zstab_fac 2484 2081 zvispyc_s_sc(ji,jj) = zvispyc_s_sc(ji,jj) * zstab_fac 2485 #ifdef key_osm_debug2486 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2487 WRITE(narea+100,'(2(a,g11.3))')' 2nd shot at: zdifpyc_s_sc',zdifpyc_s_sc(ji,jj) ,' zvispyc_s_sc=',zvispyc_s_sc(ji,jj)2488 FLUSH(narea+100)2489 END IF2490 #endif2491 2082 ! 2492 2083 zdifpyc_s_sc(ji,jj) = MAX( zdifpyc_s_sc(ji,jj), -0.5_wp * zdifpyc_n_sc(ji,jj) ) … … 2515 2106 zc_coup_vis(ji,jj) = -0.5_wp * ( 0.5_wp * zvisml_sc(ji,jj) / phml(ji,jj) - zb_coup(ji,jj) ) / & 2516 2107 & ( phml(ji,jj) + zz_b ) ! ag 19/03 2517 #ifdef key_osm_debug2518 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2519 WRITE(narea+100,'(4(a,g11.3))')' lcoup = T; 1st pz_b= ', zz_b, ' pb_coup ', zb_coup(ji,jj), &2520 & ' pc_coup_vis ', zc_coup_vis(ji,jj), ' rCdU_bot ',rCdU_bot(ji,jj)2521 WRITE(narea+100,'(2(a,g11.3))')' zmsku ', zmsku, ' zmskv ', zmskv2522 FLUSH(narea+100)2523 END IF2524 #endif2525 2108 zz_b = -1.0_wp * phml(ji,jj) + gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ! ag 19/03 2526 2109 zbeta_v_sc(ji,jj) = 1.0_wp - 2.0_wp * ( zb_coup(ji,jj) * zz_b + zc_coup_vis(ji,jj) * zz_b**2 ) / & … … 2531 2114 & 1.5_wp * ( zdifml_sc(ji,jj) / phml(ji,jj) ) * zbeta_d_sc(ji,jj) * & 2532 2115 & SQRT( 1.0_wp - zbeta_d_sc(ji,jj) ) - zb_coup(ji,jj) ) / zz_b ! ag 19/03 2533 #ifdef key_osm_debug2534 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2535 WRITE(narea+100,'(2(a,g11.3))')' 2nd pz_b= ', zz_b, ' pc_coup_dif', zc_coup_dif(ji,jj)2536 FLUSH(narea+100)2537 END IF2538 #endif2539 2116 ELSE ! ag 19/03 2540 2117 zbeta_d_sc(ji,jj) = 1.0_wp - ( ( zdifpyc_n_sc(ji,jj) + 1.4_wp * zdifpyc_s_sc(ji,jj) ) / & … … 2544 2121 ENDIF ! ag 19/03 2545 2122 ENDIF ! ag 19/03 2546 #ifdef key_osm_debug2547 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2548 WRITE(narea+100,'(2(a,g11.3))')'ldconv=T: zbeta_d_sc',zbeta_d_sc(ji,jj) ,' zbeta_v_sc=',zbeta_v_sc(ji,jj)2549 WRITE(narea+100,'(2(a,g11.3))')' Final zdifpyc_n_sc',zdifpyc_n_sc(ji,jj) ,' zvispyc_n_sc=',zvispyc_n_sc(ji,jj)2550 WRITE(narea+100,'(2(a,g11.3))')' Final zdifpyc_s_sc',zdifpyc_s_sc(ji,jj) ,' zvispyc_s_sc=',zvispyc_s_sc(ji,jj)2551 FLUSH(narea+100)2552 END IF2553 #endif2554 2123 ELSE 2555 2124 zdifml_sc(ji,jj) = svstr(ji,jj) * phbl(ji,jj) * MAX( EXP ( -1.0_wp * ( shol(ji,jj) / 0.6_wp )**2 ), 0.2_wp) 2556 2125 zvisml_sc(ji,jj) = zdifml_sc(ji,jj) 2557 #ifdef key_osm_debug2558 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2559 WRITE(narea+100,'(a,g11.3)')'End of 1st major loop of osm_diffusivity_viscositys, ldconv=F: zdifml_sc=',zdifml_sc(ji,jj),' zvisml_sc=',zvisml_sc(ji,jj)2560 FLUSH(narea+100)2561 END IF2562 #endif2563 2126 END IF 2564 2127 END_2D … … 2667 2230 ! 2668 2231 INTEGER :: ji, jj, jk, jkm_bld, jkf_mld, jkm_mld ! Loop indices 2669 #ifdef key_osm_debug2670 INTEGER :: jl, jm2671 #endif2672 2232 INTEGER :: istat ! Memory allocation status 2673 2233 REAL(wp) :: zznd_d, zznd_ml, zznd_pyc, znd ! Temporary non-dimensional depths … … 2702 2262 CALL zdf_osm_pycnocline_buoyancy_profiles( Kmm, kp_ext, zdbdz_pyc, zalpha_pyc, pdh, & 2703 2263 & phbl, pdbdz_bl_ext, phml, pdhdt ) 2704 #ifdef key_osm_debug2705 IF(narea==nn_narea_db) THEN2706 ji=iloc_db; jj=jloc_db2707 jl = nmld(ji,jj) - 1; jm = MIN( nbld(ji,jj) + 2, mbkt(ji,jj) )2708 WRITE(narea+100,'(a,l7,/,3(a,g11.3),/)') &2709 & 'After pycnocline profiles BL lpyc=', l_pyc(ji,jj),&2710 & 'sub-BL strat: zdtdz_bl_ext=', pdtdz_bl_ext(ji,jj),' zdsdz_bl_ext=', pdsdz_bl_ext(ji,jj),' zdbdz_bl_ext=', pdbdz_bl_ext(ji,jj), &2711 & 'Pycnocline: zalpha_pyc=', zalpha_pyc(ji,jj)2712 ! WRITE(narea+100,'(a,*(g11.3))') ' zdtdz_pyc[imld-1..ibld+2] =', ( zdtdz_pyc(ji,jj,jk), jk=jl,jm )2713 ! WRITE(narea+100,'(a,*(g11.3))') ' zdsdz_pyc[imld-1..ibld+2] =', ( zdsdz_pyc(ji,jj,jk), jk=jl,jm )2714 WRITE(narea+100,'(a,*(g11.3))') ' zdbdz_pyc[imld-1..ibld+2] =', ( zdbdz_pyc(ji,jj,jk), jk=jl,jm )2715 ! WRITE(narea+100,'(a,*(g11.3))') ' zdudz_pyc[imld-1..ibld+2] =', ( zdudz_pyc(ji,jj,jk), jk=jl,jm )2716 ! WRITE(narea+100,'(a,*(g11.3))') ' zdvdz_pyc[imld-1..ibld+2] =', ( zdvdz_pyc(ji,jj,jk), jk=jl,jm )2717 WRITE(narea+100,*)2718 FLUSH(narea+100)2719 END IF2720 #endif2721 2264 ! 2722 2265 ! Auxiliary indices … … 2798 2341 END IF 2799 2342 END_3D 2800 #ifdef key_osm_debug2801 IF(narea==nn_narea_db) THEN2802 ji=iloc_db; jj=jloc_db2803 jl = nmld(ji,jj) - 1; jm = MIN( nbld(ji,jj) + 2, mbkt(ji,jj) )2804 WRITE(narea+100,'(a,g11.3)')'Stokes contrib to ghamt/s: zsc_wth_1=',zsc_wth_1(ji,jj), ' zsc_ws_1=',zsc_ws_1(ji,jj)2805 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm )2806 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm )2807 IF( l_conv(ji,jj) ) THEN2808 WRITE(narea+100,'(3(a,g11.3))')'Stokes contrib to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj), &2809 &' zsc_uw_2=',zsc_uw_2(ji,jj)2810 ELSE2811 WRITE(narea+100,'(2(a,g11.3))')'Stokes contrib to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj)2812 END IF2813 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm )2814 WRITE(narea+100,'(a,*(g11.3))') ' ghamv[imld-1..ibld+2] =', ( ghamv(ji,jj,jk), jk=jl,jm )2815 WRITE(narea+100,*)2816 FLUSH(narea+100)2817 END IF2818 #endif2819 2343 ! 2820 2344 ! Buoyancy term in flux-gradient relationship [note : includes ROI ratio … … 2868 2392 & zdelta_pyc**2 / pdh(ji,jj) 2869 2393 zzeta_pyc(ji,jj) = 0.15_wp - 0.175_wp / ( 1.0_wp + EXP( -3.5_wp * LOG10( -1.0_wp * shol(ji,jj) ) ) ) 2870 #ifdef key_osm_debug2871 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2872 WRITE(narea+100,'(2(a,g11.3))')'lpyc= lconv=T,dh<0.2*hbl: zbuoy_pyc_sc=',zbuoy_pyc_sc,' zdelta_pyc=',zdelta_pyc2873 WRITE(narea+100,'(3(a,g11.3))')'zwt_pyc_sc_1=',zwt_pyc_sc_1(ji,jj),' zws_pyc_sc_1=',zws_pyc_sc_1(ji,jj), &2874 & ' zzeta_pyc=',zzeta_pyc(ji,jj)2875 FLUSH(narea+100)2876 END IF2877 #endif2878 2394 END IF 2879 2395 END IF … … 2888 2404 & 0.045_wp * ( ( zws_ent(ji,jj) * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) * & 2889 2405 & MAX( ( 1.75_wp * zznd_pyc -0.15_wp * zznd_pyc**2 - 0.2_wp * zznd_pyc**3 ), 0.0_wp ) 2890 #ifdef key_osm_debug2891 END IF2892 END_3D2893 jl = nmld(ji,jj) - 1; jm = MIN( nbld(ji,jj) + 2, mbkt(ji,jj) )2894 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN2895 WRITE(narea+100,'(3(a,g11.3))')'lpyc= lconv=T: ztau_sc_u=',ztau_sc_u(ji,jj),' zwth_ent=',zwth_ent(ji,jj), &2896 & ' zws_ent=',zws_ent(ji,jj)2897 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm )2898 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm )2899 WRITE(narea+100,*)2900 FLUSH(narea+100)2901 END IF2902 DO_3D( 0, 0, 0, 0, 2, jkm_bld )2903 IF ( l_conv(ji,jj) .AND. l_pyc(ji,jj) .AND. ( jk <= nbld(ji,jj) ) ) THEN2904 zznd_pyc = -1.0_wp * ( gdepw(ji,jj,jk,Kmm) - phbl(ji,jj) ) / pdh(ji,jj)2905 #endif2906 2406 IF ( dh(ji,jj) < 0.2_wp * hbl(ji,jj) .AND. nbld(ji,jj) - nmld(ji,jj) > 3 ) THEN 2907 2407 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.05_wp * zwt_pyc_sc_1(ji,jj) * & … … 2977 2477 END_3D 2978 2478 ! 2979 #ifdef key_osm_debug2980 IF(narea==nn_narea_db) THEN2981 ji=iloc_db; jj=jloc_db2982 jl = nmld(ji,jj) - 1; jm = MIN( nbld(ji,jj) + 2, mbkt(ji,jj) )2983 WRITE(narea+100,'(2(a,g11.3))')'Stokes + buoy + pyc contribs to ghamt/s: zsc_wth_1=',zsc_wth_1(ji,jj), ' zsc_ws_1=',zsc_ws_1(ji,jj)2984 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm )2985 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm )2986 IF( l_conv(ji,jj) ) THEN2987 WRITE(narea+100,'(3(a,g11.3))')'Stokes + buoy + pyc contribs to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj), &2988 &' zsc_uw_2=',zsc_uw_2(ji,jj)2989 ELSE2990 WRITE(narea+100,'(2(a,g11.3))')'Stokes + buoy + pyc contribs to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj)2991 END IF2992 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm )2993 WRITE(narea+100,'(a,*(g11.3))') ' ghamv[imld-1..ibld+2] =', ( ghamv(ji,jj,jk), jk=jl,jm )2994 WRITE(narea+100,*)2995 FLUSH(narea+100)2996 END IF2997 #endif2998 2999 2479 IF ( ln_dia_osm ) THEN 3000 2480 IF ( iom_use("ghamu_0") ) CALL iom_put( "ghamu_0", wmask*ghamu ) … … 3087 2567 END IF 3088 2568 END_3D 3089 #ifdef key_osm_debug3090 IF(narea==nn_narea_db) THEN3091 ji=iloc_db; jj=jloc_db3092 jl = nmld(ji,jj) - 1; jm = MIN( nbld(ji,jj) + 2, mbkt(ji,jj) )3093 WRITE(narea+100,'(2(a,g11.3))')'Stokes + buoy + pyc + transport contribs to ghamt/s: zsc_wth_1=',zsc_wth_1(ji,jj), ' zsc_ws_1=',zsc_ws_1(ji,jj)3094 IF (l_pyc(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)3095 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm )3096 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm )3097 IF( l_conv(ji,jj) ) THEN3098 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)3099 ELSE3100 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), &3101 &' zsc_uw_2=',zsc_uw_2(ji,jj)3102 END IF3103 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm )3104 WRITE(narea+100,*)3105 FLUSH(narea+100)3106 END IF3107 #endif3108 2569 ! 3109 2570 IF ( ln_dia_osm ) THEN … … 3251 2712 ghamv(ji,jj,nbld(ji,jj)) = 0.0_wp 3252 2713 END_2D 3253 #ifdef key_osm_debug3254 IF(narea==nn_narea_db) THEN3255 ji=iloc_db; jj=jloc_db3256 jl = nmld(ji,jj) - 1; jm = MIN(nbld(ji,jj) + 2, mbkt(ji,jj) )3257 WRITE(narea+100,'(a)')'Tweak gham[uv] to go to zero near surface, add pycnocline viscosity/diffusivity & set=0 at ibld'3258 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm )3259 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm )3260 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm )3261 WRITE(narea+100,'(a,*(g11.3))') ' ghamv[imld-1..ibld+2] =', ( ghamv(ji,jj,jk), jk=jl,jm )3262 WRITE(narea+100,*)3263 FLUSH(narea+100)3264 END IF3265 #endif3266 2714 ! 3267 2715 IF ( ln_dia_osm ) THEN … … 3448 2896 END IF 3449 2897 END IF 3450 #ifdef key_osm_debug3451 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN3452 WRITE(narea+100,'(4(a,g11.3))')'start of zdf_osm_osbl_state_fk: zwb_fk=',pwb_fk(ji,jj), &3453 & ' znd_param=',znd_param(ji,jj), ' zpe_mle_ref=', zpe_mle_ref, ' zpe_mle_layer=', zpe_mle_layer3454 FLUSH(narea+100)3455 END IF3456 #endif3457 2898 ! 3458 2899 END_2D … … 3499 2940 l_mle(ji,jj) = .FALSE. 3500 2941 END IF ! l_conv 3501 #ifdef key_osm_debug3502 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN3503 WRITE(narea+100,'(3(a,g11.3),/,4(a,l2))')'end of zdf_osm_osbl_state_fk:zwb_ent=',pwb_ent(ji,jj), &3504 & ' zhmle=',phmle(ji,jj), ' zhbl=', phbl(ji,jj), &3505 & ' lpyc= ', l_pyc(ji,jj), ' lflux= ', l_flux(ji,jj), ' lmle= ', l_mle(ji,jj), ' lconv= ', l_conv(ji,jj)3506 FLUSH(narea+100)3507 END IF3508 #endif3509 2942 ! 3510 2943 END_2D … … 3622 3055 & rn_difri, ln_convmix, rn_difconv, nn_osm_wave, nn_osm_SD_reduce, & 3623 3056 & ln_osm_mle, rn_osm_hblfrac, rn_osm_bl_thresh, ln_zdfosm_ice_shelter 3624 #ifdef key_osm_debug3625 NAMELIST/namzdf_osm/ nn_idb, nn_jdb, nn_kdb, nn_narea_db3626 #endif3627 3057 ! Namelist for Fox-Kemper parametrization 3628 3058 NAMELIST/namosm_mle/ nn_osm_mle, rn_osm_mle_ce, rn_osm_mle_lf, rn_osm_mle_time, rn_osm_mle_lat, & … … 3678 3108 WRITE(numout,*) ' Use large mixing below BL when unstable ln_convmix = ', ln_convmix 3679 3109 WRITE(numout,*) ' Diffusivity when unstable below BL (m2/s) rn_difconv = ', rn_difconv 3680 #ifdef key_osm_debug3681 WRITE(numout,*) 'nn_idb', nn_idb, 'nn_jdb', nn_jdb, 'nn_kdb', nn_kdb, 'nn_narea_db', nn_narea_db3682 iloc_db = mi0(nn_idb)3683 jloc_db = mj0(nn_jdb)3684 WRITE(numout,*) 'iloc_db ', iloc_db , 'jloc_db', jloc_db3685 #endif3686 3110 ENDIF 3687 3111 !
Note: See TracChangeset
for help on using the changeset viewer.
