Changeset 5948 for branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
- Timestamp:
- 2015-11-30T11:47:24+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r5947 r5948 18 18 USE eosbn2 ! equation of state 19 19 USE sbc_oce ! surface boundary condition: ocean fields 20 USE zdfbfr ! 21 ! 22 USE in_out_manager ! I/O manager 23 USE iom ! I/O manager library 24 USE fldread ! read input field at current time step 20 25 USE lbclnk ! 21 USE iom ! I/O manager library22 USE in_out_manager ! I/O manager23 26 USE wrk_nemo ! Memory allocation 24 27 USE timing ! Timing 25 28 USE lib_fortran ! glob_sum 26 USE zdfbfr27 USE fldread ! read input field at current time step28 29 30 29 31 30 IMPLICIT NONE 32 31 PRIVATE 33 32 34 PUBLIC sbc_isf, sbc_isf_div, sbc_isf_alloc ! routine called in sbcmod and div cur33 PUBLIC sbc_isf, sbc_isf_div, sbc_isf_alloc ! routine called in sbcmod and divhor 35 34 36 35 ! public in order to be able to output then … … 53 52 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: risfLeff !:effective length (Leff) BG03 nn_isf==2 54 53 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: ttbl, stbl, utbl, vtbl !:top boundary layer variable at T point 55 #if defined key_agrif56 ! AGRIF can not handle these arrays as integers. The reason is a mystery but problems avoided by declaring them as reals57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: misfkt, misfkb !:Level of ice shelf base58 !: (first wet level and last level include in the tbl)59 #else60 54 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: misfkt, misfkb !:Level of ice shelf base 61 #endif62 63 55 64 56 REAL(wp), PUBLIC, SAVE :: rcpi = 2000.0_wp ! phycst ? … … 79 71 # include "domzgr_substitute.h90" 80 72 !!---------------------------------------------------------------------- 81 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)73 !! NEMO/OPA 3.7 , LOCEAN-IPSL (2015) 82 74 !! $Id$ 83 75 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 84 76 !!---------------------------------------------------------------------- 85 86 77 CONTAINS 87 78 88 SUBROUTINE sbc_isf(kt) 89 INTEGER, INTENT(in) :: kt ! ocean time step 90 INTEGER :: ji, jj, jk, ijkmin, inum, ierror 91 INTEGER :: ikt, ikb ! top and bottom level of the isf boundary layer 92 REAL(wp) :: rmin 93 REAL(wp) :: zhk 94 CHARACTER(len=256) :: cfisf, cvarzisf, cvarhisf ! name for isf file 95 CHARACTER(LEN=256) :: cnameis ! name of iceshelf file 96 CHARACTER (LEN=32) :: cvarLeff ! variable name for efficient Length scale 97 INTEGER :: ios ! Local integer output status for namelist read 98 ! 79 SUBROUTINE sbc_isf(kt) 99 80 !!--------------------------------------------------------------------- 81 !! *** ROUTINE sbc_isf *** 82 !!--------------------------------------------------------------------- 83 INTEGER, INTENT(in) :: kt ! ocean time step 84 ! 85 INTEGER :: ji, jj, jk, ijkmin, inum, ierror 86 INTEGER :: ikt, ikb ! top and bottom level of the isf boundary layer 87 REAL(wp) :: rmin 88 REAL(wp) :: zhk 89 REAL(wp) :: zt_frz, zpress 90 CHARACTER(len=256) :: cfisf , cvarzisf, cvarhisf ! name for isf file 91 CHARACTER(LEN=256) :: cnameis ! name of iceshelf file 92 CHARACTER (LEN=32) :: cvarLeff ! variable name for efficient Length scale 93 INTEGER :: ios ! Local integer output status for namelist read 94 !! 100 95 NAMELIST/namsbc_isf/ nn_isfblk, rn_hisf_tbl, ln_divisf, ln_conserve, rn_gammat0, rn_gammas0, nn_gammablk, & 101 &sn_fwfisf, sn_qisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf102 ! 96 & sn_fwfisf, sn_qisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf 97 !!--------------------------------------------------------------------- 103 98 ! 104 99 ! ! ====================== ! … … 113 108 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in configuration namelist', lwp ) 114 109 IF(lwm) WRITE ( numond, namsbc_isf ) 115 116 110 117 111 IF ( lwp ) WRITE(numout,*) … … 194 188 END IF 195 189 190 ! compute bottom level of isf tbl and thickness of tbl below the ice shelf 196 191 rhisf_tbl_0(:,:) = rhisf_tbl(:,:) 197 198 ! compute bottom level of isf tbl and thickness of tbl below the ice shelf199 192 DO jj = 1,jpj 200 193 DO ji = 1,jpi … … 217 210 END DO 218 211 END DO 219 212 ! 220 213 END IF 221 214 … … 270 263 END IF 271 264 ! compute tsc due to isf 272 ! WARNING water add at temp = 0C, correction term is added in trasbc, maybe better here but need a 3D variable). 273 risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp ! 265 ! WARNING water add at temp = 0C, correction term is added, maybe better here but need a 3D variable). 266 ! zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04 267 zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress ) 268 risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - rdivisf * fwfisf(:,:) * zt_frz * r1_rau0 ! 274 269 275 270 ! salt effect already take into account in vertical advection 276 271 risf_tsc(:,:,jp_sal) = (1.0_wp-rdivisf) * fwfisf(:,:) * stbl(:,:) * r1_rau0 277 272 273 ! output 274 IF( iom_use('qisf' ) ) CALL iom_put('qisf' , qisf) 275 IF( iom_use('fwfisf') ) CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce ) 276 277 ! if apply only on the trend and not as a volume flux (rdivisf = 0), fwfisf have to be set to 0 now 278 fwfisf(:,:) = rdivisf * fwfisf(:,:) 279 278 280 ! lbclnk 279 281 CALL lbc_lnk(risf_tsc(:,:,jp_tem),'T',1.) … … 295 297 ENDIF 296 298 ! 297 ! output298 CALL iom_put('qisf' , qisf)299 IF( iom_use('fwfisf') ) CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce )300 299 END IF 301 300 ! 302 301 END SUBROUTINE sbc_isf 302 303 303 304 304 INTEGER FUNCTION sbc_isf_alloc() … … 321 321 END FUNCTION 322 322 323 SUBROUTINE sbc_isf_bg03(kt) 324 !!==========================================================================325 !! *** SUBROUTINE sbcisf_bg03 ***326 !! add net heat and fresh water flux from ice shelf melting327 !! into the adjacent ocean using the parameterisation by328 !! Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean329 !! interaction for climate models", Ocean Modelling 5(2003) 157-170.330 !! (hereafter BG)331 !!==========================================================================332 !!----------------------------------------------------------------------333 !! sbc_isf_bg03 : routine called from sbcmod334 !!----------------------------------------------------------------------335 !!336 !! ** Purpose : Add heat and fresh water fluxes due to ice shelf melting337 !! ** Reference : Beckmann et Goosse, 2003, Ocean Modelling338 !!339 !! History :340 !! ! 06-02 (C. Wang) Original code341 !!----------------------------------------------------------------------342 343 INTEGER, INTENT ( in ) :: kt344 323 324 SUBROUTINE sbc_isf_bg03(kt) 325 !!========================================================================== 326 !! *** SUBROUTINE sbcisf_bg03 *** 327 !! add net heat and fresh water flux from ice shelf melting 328 !! into the adjacent ocean using the parameterisation by 329 !! Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean 330 !! interaction for climate models", Ocean Modelling 5(2003) 157-170. 331 !! (hereafter BG) 332 !!========================================================================== 333 !!---------------------------------------------------------------------- 334 !! sbc_isf_bg03 : routine called from sbcmod 335 !!---------------------------------------------------------------------- 336 !! 337 !! ** Purpose : Add heat and fresh water fluxes due to ice shelf melting 338 !! ** Reference : Beckmann et Goosse, 2003, Ocean Modelling 339 !! 340 !! History : 341 !! ! 06-02 (C. Wang) Original code 342 !!---------------------------------------------------------------------- 343 INTEGER, INTENT ( in ) :: kt 344 ! 345 345 INTEGER :: ji, jj, jk, jish !temporary integer 346 346 INTEGER :: ijkmin … … 370 370 ! Calculate freezing temperature 371 371 zpress = grav*rau0*fsdept(ji,jj,ik)*1.e-04 372 zt_frz = eos_fzp(tsb(ji,jj,ik,jp_sal), zpress)372 CALL eos_fzp(tsb(ji,jj,ik,jp_sal), zt_frz, zpress) 373 373 zt_sum = zt_sum + (tsn(ji,jj,ik,jp_tem)-zt_frz) * fse3t(ji,jj,ik) * tmask(ji,jj,ik) ! sum temp 374 374 ENDDO … … 386 386 qisf(ji,jj) = 0._wp ; fwfisf(ji,jj) = 0._wp 387 387 END IF 388 END DO389 END DO388 END DO 389 END DO 390 390 ! 391 391 IF( nn_timing == 1 ) CALL timing_stop('sbc_isf_bg03') 392 ! 392 393 END SUBROUTINE sbc_isf_bg03 394 393 395 394 396 SUBROUTINE sbc_isf_cav( kt ) … … 439 441 ! 440 442 ! 441 !CDIR COLLAPSE442 443 DO jj = 1, jpj 443 444 DO ji = 1, jpi … … 452 453 zti(:,:)=tinsitu( ttbl, stbl, zpress ) 453 454 ! Calculate freezing temperature 454 zfrz(:,:)=eos_fzp( sss_m(:,:), zpress )455 CALL eos_fzp( sss_m(:,:), zfrz(:,:), zpress ) 455 456 456 457 … … 472 473 473 474 nit = nit + 1 474 IF (nit .GE. 100) THEN 475 !WRITE(numout,*) "sbcisf : too many iteration ... ", zhtflx, zhtflx_b,zgammat, rn_gammat0, rn_tfri2, nn_gammablk, ji,jj 476 !WRITE(numout,*) "sbcisf : too many iteration ... ", (zhtflx - zhtflx_b)/zhtflx 477 CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' ) 478 END IF 475 IF (nit .GE. 100) CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' ) 476 479 477 ! save gammat and compute zhtflx_b 480 478 zgammat2d(ji,jj)=zgammat … … 496 494 497 495 ! More complicated 3 equation thermodynamics as in MITgcm 498 !CDIR COLLAPSE499 496 DO jj = 2, jpj 500 497 DO ji = 2, jpi … … 565 562 ! 566 563 IF( nn_timing == 1 ) CALL timing_stop('sbc_isf_cav') 567 564 ! 568 565 END SUBROUTINE sbc_isf_cav 566 569 567 570 568 SUBROUTINE sbc_isf_gammats(gt, gs, zqhisf, zqwisf, ji, jj, lit ) … … 693 691 END IF 694 692 END IF 695 693 ! 696 694 END SUBROUTINE 695 697 696 698 697 SUBROUTINE sbc_isf_tbl( varin, varout, cptin ) … … 756 755 IF (cptin == 'T') CALL lbc_lnk(varout,'T',1.) 757 756 IF (cptin == 'U' .OR. cptin == 'V') CALL lbc_lnk(varout,'T',-1.) 758 757 ! 759 758 END SUBROUTINE sbc_isf_tbl 760 759 … … 794 793 ! test on tmask useless ????? 795 794 DO jk = ikt, mbkt(ji,jj) 796 !IF ( (SUM(fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk795 IF ( (SUM(fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 797 796 END DO 798 797 rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t(ji,jj,ikt:ikb))) ! limit the tbl to water thickness. … … 823 822 ! 824 823 END SUBROUTINE sbc_isf_div 825 824 825 826 826 FUNCTION tinsitu( ptem, psal, ppress ) RESULT( pti ) 827 827 !!---------------------------------------------------------------------- … … 874 874 ! 875 875 END FUNCTION tinsitu 876 ! 876 877 877 878 FUNCTION fsatg( pfps, pfpt, pfphp ) 878 879 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
