Changeset 5836 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
- Timestamp:
- 2015-10-26T15:49:40+01:00 (9 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r5721 r5836 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 … … 72 71 # include "domzgr_substitute.h90" 73 72 !!---------------------------------------------------------------------- 74 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)73 !! NEMO/OPA 3.7 , LOCEAN-IPSL (2015) 75 74 !! $Id$ 76 75 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 77 76 !!---------------------------------------------------------------------- 78 79 77 CONTAINS 80 78 81 SUBROUTINE sbc_isf(kt) 82 INTEGER, INTENT(in) :: kt ! ocean time step 83 INTEGER :: ji, jj, jk, ijkmin, inum, ierror 84 INTEGER :: ikt, ikb ! top and bottom level of the isf boundary layer 85 REAL(wp) :: rmin 86 REAL(wp) :: zhk 87 REAL(wp) :: zt_frz, zpress 88 CHARACTER(len=256) :: cfisf , cvarzisf, cvarhisf ! name for isf file 89 CHARACTER(LEN=256) :: cnameis ! name of iceshelf file 90 CHARACTER (LEN=32) :: cvarLeff ! variable name for efficient Length scale 91 INTEGER :: ios ! Local integer output status for namelist read 92 ! 79 SUBROUTINE sbc_isf(kt) 93 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 !! 94 95 NAMELIST/namsbc_isf/ nn_isfblk, rn_hisf_tbl, ln_divisf, ln_conserve, rn_gammat0, rn_gammas0, nn_gammablk, & 95 &sn_fwfisf, sn_qisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf96 ! 96 & sn_fwfisf, sn_qisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf 97 !!--------------------------------------------------------------------- 97 98 ! 98 99 ! ! ====================== ! … … 107 108 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_isf in configuration namelist', lwp ) 108 109 IF(lwm) WRITE ( numond, namsbc_isf ) 109 110 110 111 111 IF ( lwp ) WRITE(numout,*) … … 210 210 END DO 211 211 END DO 212 212 ! 213 213 END IF 214 214 … … 298 298 ! 299 299 END IF 300 300 ! 301 301 END SUBROUTINE sbc_isf 302 302 303 303 304 INTEGER FUNCTION sbc_isf_alloc() … … 320 321 END FUNCTION 321 322 322 SUBROUTINE sbc_isf_bg03(kt) 323 !!==========================================================================324 !! *** SUBROUTINE sbcisf_bg03 ***325 !! add net heat and fresh water flux from ice shelf melting326 !! into the adjacent ocean using the parameterisation by327 !! Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean328 !! interaction for climate models", Ocean Modelling 5(2003) 157-170.329 !! (hereafter BG)330 !!==========================================================================331 !!----------------------------------------------------------------------332 !! sbc_isf_bg03 : routine called from sbcmod333 !!----------------------------------------------------------------------334 !!335 !! ** Purpose : Add heat and fresh water fluxes due to ice shelf melting336 !! ** Reference : Beckmann et Goosse, 2003, Ocean Modelling337 !!338 !! History :339 !! ! 06-02 (C. Wang) Original code340 !!----------------------------------------------------------------------341 342 INTEGER, INTENT ( in ) :: kt343 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 ! 344 345 INTEGER :: ji, jj, jk, jish !temporary integer 345 346 INTEGER :: ijkmin … … 385 386 qisf(ji,jj) = 0._wp ; fwfisf(ji,jj) = 0._wp 386 387 END IF 387 END DO388 END DO388 END DO 389 END DO 389 390 ! 390 391 IF( nn_timing == 1 ) CALL timing_stop('sbc_isf_bg03') 392 ! 391 393 END SUBROUTINE sbc_isf_bg03 394 392 395 393 396 SUBROUTINE sbc_isf_cav( kt ) … … 438 441 ! 439 442 ! 440 !CDIR COLLAPSE441 443 DO jj = 1, jpj 442 444 DO ji = 1, jpi … … 492 494 493 495 ! More complicated 3 equation thermodynamics as in MITgcm 494 !CDIR COLLAPSE495 496 DO jj = 2, jpj 496 497 DO ji = 2, jpi … … 561 562 ! 562 563 IF( nn_timing == 1 ) CALL timing_stop('sbc_isf_cav') 563 564 ! 564 565 END SUBROUTINE sbc_isf_cav 566 565 567 566 568 SUBROUTINE sbc_isf_gammats(gt, gs, zqhisf, zqwisf, ji, jj, lit ) … … 689 691 END IF 690 692 END IF 691 693 ! 692 694 END SUBROUTINE 695 693 696 694 697 SUBROUTINE sbc_isf_tbl( varin, varout, cptin ) … … 752 755 IF (cptin == 'T') CALL lbc_lnk(varout,'T',1.) 753 756 IF (cptin == 'U' .OR. cptin == 'V') CALL lbc_lnk(varout,'T',-1.) 754 757 ! 755 758 END SUBROUTINE sbc_isf_tbl 756 759 … … 819 822 ! 820 823 END SUBROUTINE sbc_isf_div 821 824 825 822 826 FUNCTION tinsitu( ptem, psal, ppress ) RESULT( pti ) 823 827 !!---------------------------------------------------------------------- … … 870 874 ! 871 875 END FUNCTION tinsitu 872 ! 876 877 873 878 FUNCTION fsatg( pfps, pfpt, pfphp ) 874 879 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
