- Timestamp:
- 2015-04-15T20:54:28+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r5204 r5216 585 585 586 586 !! compute ustar 587 zustar(:,:) = SQRT( rn_tfri2 * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) ) )587 zustar(:,:) = SQRT( rn_tfri2 * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + rn_tfeb2) ) 588 588 589 589 !! Compute gammats … … 596 596 !! as MOL depends of flux and flux depends of MOL, best will be iteration (TO DO) 597 597 !! compute ustar 598 zustar(:,:) = SQRT( rn_tfri2 * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) ) )598 zustar(:,:) = SQRT( rn_tfri2 * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + rn_tfeb2) ) 599 599 600 600 !! compute Pr and Sc number (can be improved) … … 678 678 679 679 REAL(wp) :: ze3, zhk 680 REAL(wp), DIMENSION(:,:), POINTER :: z ikt680 REAL(wp), DIMENSION(:,:), POINTER :: zhisf_tbl 681 681 682 682 INTEGER :: ji,jj,jk 683 683 INTEGER :: ikt,ikb 684 INTEGER, DIMENSION(:,:), POINTER :: mkt, mkb 685 686 CALL wrk_alloc( jpi,jpj, mkt, mkb ) 687 CALL wrk_alloc( jpi,jpj, zikt ) 684 685 CALL wrk_alloc( jpi,jpj, zhisf_tbl) 688 686 689 687 ! get first and last level of tbl 690 mkt(:,:) = misfkt(:,:)691 mkb(:,:) = misfkb(:,:)692 688 693 689 varout(:,:)=0._wp 694 DO jj = 2,jpj 695 DO ji = 2,jpi 696 ikt = mkt(ji,jj) 697 ikb = mkb(ji,jj) 690 IF (cptin == 'U') THEN 691 DO jj = 1,jpj 692 DO ji = 1,jpi 693 ikt = miku(ji,jj) ; ikb = miku(ji,jj) 694 ! thickness of boundary layer at least the top level thickness 695 zhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), fse3u_n(ji,jj,ikt)) 696 697 ! determine the deepest level influenced by the boundary layer 698 ! test on tmask useless ????? 699 DO jk = ikt, mbku(ji,jj) 700 IF ( (SUM(fse3u_n(ji,jj,ikt:jk-1)) .LT. zhisf_tbl(ji,jj)) .AND. (umask(ji,jj,jk) == 1) ) ikb = jk 701 END DO 702 zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(fse3u_n(ji,jj,ikt:ikb))) ! limit the tbl to water thickness. 698 703 699 704 ! level fully include in the ice shelf boundary layer 700 DO jk = ikt, ikb - 1 701 ze3 = fse3t_n(ji,jj,jk) 702 IF (cptin == 'T' ) varout(ji,jj) = varout(ji,jj) + varin(ji,jj,jk) * r1_hisf_tbl(ji,jj) * ze3 703 IF (cptin == 'U' ) varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,jk) + varin(ji-1,jj,jk)) & 704 & * r1_hisf_tbl(ji,jj) * ze3 705 IF (cptin == 'V' ) varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,jk) + varin(ji,jj-1,jk)) & 706 & * r1_hisf_tbl(ji,jj) * ze3 707 END DO 705 DO jk = ikt, ikb - 1 706 ze3 = fse3u_n(ji,jj,jk) 707 varout(ji,jj) = varout(ji,jj) + varin(ji,jj,jk) / zhisf_tbl(ji,jj) * ze3 708 END DO 708 709 709 710 ! level partially include in ice shelf boundary layer 710 zhk = SUM( fse3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj) 711 IF (cptin == 'T') & 712 & varout(ji,jj) = varout(ji,jj) + varin(ji,jj,ikb) * (1._wp - zhk) 713 IF (cptin == 'U') & 714 & varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,ikb) + varin(ji-1,jj,ikb)) * (1._wp - zhk) 715 IF (cptin == 'V') & 716 & varout(ji,jj) = varout(ji,jj) + 0.5_wp * (varin(ji,jj,ikb) + varin(ji,jj-1,ikb)) * (1._wp - zhk) 717 END DO 718 END DO 711 zhk = SUM( fse3u_n(ji, jj, ikt:ikb - 1)) / zhisf_tbl(ji,jj) 712 varout(ji,jj) = varout(ji,jj) + varin(ji,jj,ikb) * (1._wp - zhk) 713 END DO 714 END DO 715 DO jj = 2,jpj 716 DO ji = 2,jpi 717 varout(ji,jj) = 0.5_wp * (varout(ji,jj) + varout(ji-1,jj)) 718 END DO 719 END DO 720 CALL lbc_lnk(varout,'T',-1.) 721 END IF 722 723 IF (cptin == 'V') THEN 724 DO jj = 1,jpj 725 DO ji = 1,jpi 726 ikt = mikv(ji,jj) ; ikb = mikv(ji,jj) 727 ! thickness of boundary layer at least the top level thickness 728 zhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), fse3v_n(ji,jj,ikt)) 729 730 ! determine the deepest level influenced by the boundary layer 731 ! test on tmask useless ????? 732 DO jk = ikt, mbkv(ji,jj) 733 IF ( (SUM(fse3v_n(ji,jj,ikt:jk-1)) .LT. zhisf_tbl(ji,jj)) .AND. (vmask(ji,jj,jk) == 1) ) ikb = jk 734 END DO 735 zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(fse3v_n(ji,jj,ikt:ikb))) ! limit the tbl to water thickness. 736 737 ! level fully include in the ice shelf boundary layer 738 DO jk = ikt, ikb - 1 739 ze3 = fse3v_n(ji,jj,jk) 740 varout(ji,jj) = varout(ji,jj) + varin(ji,jj,jk) / zhisf_tbl(ji,jj) * ze3 741 END DO 742 743 ! level partially include in ice shelf boundary layer 744 zhk = SUM( fse3v_n(ji, jj, ikt:ikb - 1)) / zhisf_tbl(ji,jj) 745 varout(ji,jj) = varout(ji,jj) + varin(ji,jj,ikb) * (1._wp - zhk) 746 END DO 747 END DO 748 DO jj = 2,jpj 749 DO ji = 2,jpi 750 varout(ji,jj) = 0.5_wp * (varout(ji,jj) + varout(ji,jj-1)) 751 END DO 752 END DO 753 CALL lbc_lnk(varout,'T',-1.) 754 END IF 755 756 IF (cptin == 'T') THEN 757 DO jj = 1,jpj 758 DO ji = 1,jpi 759 ikt = misfkt(ji,jj) 760 ikb = misfkb(ji,jj) 761 762 ! level fully include in the ice shelf boundary layer 763 DO jk = ikt, ikb - 1 764 ze3 = fse3t_n(ji,jj,jk) 765 varout(ji,jj) = varout(ji,jj) + varin(ji,jj,jk) * r1_hisf_tbl(ji,jj) * ze3 766 END DO 767 768 ! level partially include in ice shelf boundary layer 769 zhk = SUM( fse3t_n(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj) 770 varout(ji,jj) = varout(ji,jj) + varin(ji,jj,ikb) * (1._wp - zhk) 771 END DO 772 END DO 773 END IF 719 774 varout(:,:) = varout(:,:) * ssmask(:,:) 720 775 721 CALL wrk_dealloc( jpi,jpj, mkt, mkb ) 722 CALL wrk_dealloc( jpi,jpj, zikt ) 723 724 IF (cptin == 'T') CALL lbc_lnk(varout,'T',1.) 725 IF (cptin == 'U' .OR. cptin == 'V') CALL lbc_lnk(varout,'T',-1.) 776 CALL wrk_dealloc( jpi,jpj, zhisf_tbl ) 726 777 727 778 END SUBROUTINE sbc_isf_tbl
Note: See TracChangeset
for help on using the changeset viewer.
