- Timestamp:
- 2016-07-19T10:38:35+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r5407 r6808 23 23 !! lim_sbc_tau : update i- and j-stresses, and its modulus at the ocean surface 24 24 !!---------------------------------------------------------------------- 25 USE par_oce ! ocean parameters 26 USE phycst ! physical constants 27 USE dom_oce ! ocean domain 28 USE ice ! LIM sea-ice variables 29 USE sbc_ice ! Surface boundary condition: sea-ice fields 30 USE sbc_oce ! Surface boundary condition: ocean fields 31 USE sbccpl 32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 33 USE albedo ! albedo parameters 34 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 35 USE lib_mpp ! MPP library 36 USE wrk_nemo ! work arrays 37 USE in_out_manager ! I/O manager 38 USE prtctl ! Print control 39 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 40 USE traqsr ! add penetration of solar flux in the calculation of heat budget 41 USE iom 42 USE domvvl ! Variable volume 43 USE limctl 44 USE limcons 25 USE par_oce ! ocean parameters 26 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 27 USE phycst ! physical constants 28 USE dom_oce ! ocean domain 29 USE ice ! LIM sea-ice variables 30 USE sbc_ice ! Surface boundary condition: sea-ice fields 31 USE sbc_oce ! Surface boundary condition: ocean fields 32 USE sbccpl ! Surface boundary condition: coupled interface 33 USE albedo ! albedo parameters 34 USE traqsr ! add penetration of solar flux in the calculation of heat budget 35 USE domvvl ! Variable volume 36 USE limctl ! 37 USE limcons ! 38 ! 39 USE in_out_manager ! I/O manager 40 USE iom ! xIO server 41 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 42 USE lib_mpp ! MPP library 43 USE wrk_nemo ! work arrays 44 USE prtctl ! Print control 45 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 45 46 46 47 IMPLICIT NONE 47 48 PRIVATE 48 49 49 PUBLIC lim_sbc_init ! called by sbc _lim_init50 PUBLIC lim_sbc_init ! called by sbcice_lim 50 51 PUBLIC lim_sbc_flx ! called by sbc_ice_lim 51 52 PUBLIC lim_sbc_tau ! called by sbc_ice_lim … … 57 58 !! * Substitutions 58 59 # include "vectopt_loop_substitute.h90" 59 # include "domzgr_substitute.h90"60 60 !!---------------------------------------------------------------------- 61 61 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) … … 101 101 !! The ref should be Rousset et al., 2015 102 102 !!--------------------------------------------------------------------- 103 INTEGER, INTENT(in) :: kt 104 INTEGER :: ji, jj, jl, jk ! dummy loop indices105 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2)106 REAL(wp) :: zq sr ! New solar flux received by the ocean107 !108 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 2D/3D workspace103 INTEGER, INTENT(in) :: kt ! number of iteration 104 ! 105 INTEGER :: ji, jj, jl, jk ! dummy loop indices 106 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 107 REAL(wp) :: zqsr ! New solar flux received by the ocean 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 3D workspace 109 109 !!--------------------------------------------------------------------- 110 110 ! 111 111 ! make calls for heat fluxes before it is modified 112 112 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface … … 198 198 ! Snow/ice albedo (only if sent to coupler, useless in forced mode) ! 199 199 !------------------------------------------------------------------------! 200 CALL wrk_alloc( jpi, jpj, jpl,zalb_cs, zalb_os )200 CALL wrk_alloc( jpi,jpj,jpl, zalb_cs, zalb_os ) 201 201 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 202 202 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 203 CALL wrk_dealloc( jpi, jpj, jpl,zalb_cs, zalb_os )203 CALL wrk_dealloc( jpi,jpj,jpl, zalb_cs, zalb_os ) 204 204 205 205 ! conservation test 206 IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' )206 IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' ) 207 207 208 208 ! control prints 209 209 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 210 210 ! 211 211 IF(ln_ctl) THEN 212 212 CALL prt_ctl( tab2d_1=qsr , clinfo1=' lim_sbc: qsr : ', tab2d_2=qns , clinfo2=' qns : ' ) … … 215 215 CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 216 216 ENDIF 217 217 ! 218 218 END SUBROUTINE lim_sbc_flx 219 219 … … 246 246 INTEGER , INTENT(in) :: kt ! ocean time-step index 247 247 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents 248 ! !248 ! 249 249 INTEGER :: ji, jj ! dummy loop indices 250 250 REAL(wp) :: zat_u, zutau_ice, zu_t, zmodt ! local scalar … … 303 303 !! ** input : Namelist namicedia 304 304 !!------------------------------------------------------------------- 305 INTEGER :: ji, jj, jk ! dummy loop indices 306 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 305 INTEGER :: ji, jj, jk ! dummy loop indices 306 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 307 !!------------------------------------------------------------------- 308 ! 307 309 IF(lwp) WRITE(numout,*) 308 310 IF(lwp) WRITE(numout,*) 'lim_sbc_init : LIM-3 sea-ice - surface boundary condition' … … 335 337 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 336 338 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 337 #if defined key_vvl 338 ! key_vvl necessary? clem: yes for compilation purpose 339 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 340 fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 341 fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 342 ENDDO 343 fse3t_a(:,:,:) = fse3t_b(:,:,:) 344 ! Reconstruction of all vertical scale factors at now and before time 345 ! steps 346 ! ============================================================================= 347 ! Horizontal scale factor interpolations 348 ! -------------------------------------- 349 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 350 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 351 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 352 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 353 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 354 ! Vertical scale factor interpolations 355 ! ------------------------------------ 356 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' ) 357 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 358 CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 359 CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 360 CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 361 ! t- and w- points depth 362 ! ---------------------- 363 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 364 fsdepw_n(:,:,1) = 0.0_wp 365 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 366 DO jk = 2, jpk 367 fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 368 fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 369 fsde3w_n(:,:,jk) = fsdept_n(:,:,jk ) - sshn (:,:) 370 END DO 371 #endif 339 340 !!gm I really don't like this staff here... Find a way to put that elsewhere or differently 341 !!gm 342 IF( .NOT.ln_linssh ) THEN 343 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 344 e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 345 e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 346 END DO 347 e3t_a(:,:,:) = e3t_b(:,:,:) 348 ! Reconstruction of all vertical scale factors at now and before time-steps 349 ! ========================================================================= 350 ! Horizontal scale factor interpolations 351 ! -------------------------------------- 352 CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 353 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 354 CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 355 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 356 CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 357 ! Vertical scale factor interpolations 358 ! ------------------------------------ 359 CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' ) 360 CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 361 CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 362 CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 363 CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 364 ! t- and w- points depth 365 ! ---------------------- 366 !!gm not sure of that.... 367 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 368 gdepw_n(:,:,1) = 0.0_wp 369 gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 370 DO jk = 2, jpk 371 gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk) 372 gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 373 gde3w_n(:,:,jk) = gdept_n(:,:,jk ) - sshn (:,:) 374 END DO 375 ENDIF 372 376 ENDIF 373 377 ENDIF ! .NOT. ln_rstart 374 378 ! 375 376 379 END SUBROUTINE lim_sbc_init 377 380
Note: See TracChangeset
for help on using the changeset viewer.
