- 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_2/limsbc_2.F90
r5407 r6808 29 29 USE sbc_ice ! surface boundary condition: ice 30 30 USE sbc_oce ! surface boundary condition: ocean 31 USE sbccpl 31 USE sbccpl ! surface boundary condition: coupled interface 32 32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 33 33 USE albedo ! albedo parameters 34 ! 34 35 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 35 36 USE lib_mpp ! MPP library … … 43 44 PRIVATE 44 45 45 PUBLIC lim_sbc_init_2 46 PUBLIC lim_sbc_flx_2 47 PUBLIC lim_sbc_tau_2 46 PUBLIC lim_sbc_init_2 ! called by ice_init_2 47 PUBLIC lim_sbc_flx_2 ! called by sbc_ice_lim_2 48 PUBLIC lim_sbc_tau_2 ! called by sbc_ice_lim_2 48 49 49 50 REAL(wp) :: r1_rdtice ! = 1. / rdt_ice … … 52 53 REAL(wp) :: rone = 1._wp ! - - 53 54 ! 54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: soce_0, sice_0 ! constant SSS and ice salinity used in levitating sea-ice case55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: soce_0, sice_0 ! fix SSS and ice salinity used in levitating case 0 55 56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2] 56 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmod_io ! modulus of the ice-ocean relative velocity [m/s] … … 58 59 !! * Substitutions 59 60 # include "vectopt_loop_substitute.h90" 60 # include "domzgr_substitute.h90"61 61 !!---------------------------------------------------------------------- 62 62 !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) … … 102 102 !!--------------------------------------------------------------------- 103 103 INTEGER, INTENT(in) :: kt ! number of iteration 104 ! !104 ! 105 105 INTEGER :: ji, jj ! dummy loop indices 106 106 INTEGER :: ii0, ii1, ij0, ij1 ! local integers … … 114 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 115 115 !!--------------------------------------------------------------------- 116 116 ! 117 117 CALL wrk_alloc( jpi, jpj, zqnsoce ) 118 118 CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp ) 119 120 SELECT CASE( nn_ice_embd ) 121 CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only122 CASE( 1, 2 ) ; zswitch = 0! (1) levitating sea-ice: salt and volume exchange but no pressure effect123 124 END SELECT !119 ! 120 SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option 121 CASE( 0 ) ; zswitch = 1 ! (0) old levitating sea-ice : salt exchange only 122 CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect 123 ! ! (2) embedded sea-ice : salt and volume fluxes and pressure 124 END SELECT 125 125 126 126 !------------------------------------------! … … 303 303 INTEGER , INTENT(in) :: kt ! ocean time-step index 304 304 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents 305 ! !305 ! 306 306 INTEGER :: ji, jj ! dummy loop indices 307 307 REAL(wp) :: zfrldu, zat_u, zu_i, zutau_ice, zu_t, zmodt ! local scalar … … 319 319 ! 320 320 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) 321 !CDIR NOVERRCHK 321 ! 322 322 DO jj = 1, jpj !* modulus of ice-ocean relative velocity at I-point 323 !CDIR NOVERRCHK324 323 DO ji = 1, jpi 325 324 zu_i = u_ice(ji,jj) - u_oce(ji,jj) ! ice-ocean relative velocity at I-point … … 328 327 END DO 329 328 END DO 330 !CDIR NOVERRCHK331 329 DO jj = 1, jpjm1 !* update the modulus of stress at ocean surface (T-point) 332 !CDIR NOVERRCHK333 330 DO ji = 1, jpim1 ! NO vector opt. 334 331 ! ! modulus of U_ice-U_oce at T-point … … 383 380 ! 384 381 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) 385 !CDIR NOVERRCHK 382 ! 386 383 DO jj = 2, jpjm1 !* modulus of the ice-ocean velocity at T-point 387 !CDIR NOVERRCHK388 384 DO ji = fs_2, fs_jpim1 389 385 zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) ! 2*(U_ice-U_oce) at T-point … … 439 435 !! ** input : Namelist namicedia 440 436 !!------------------------------------------------------------------- 441 !442 INTEGER :: jk ! local integer437 INTEGER :: jk ! local integer 438 !!------------------------------------------------------------------- 443 439 ! 444 440 IF(lwp) WRITE(numout,*) … … 474 470 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 475 471 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 476 do jk = 1,jpkm1 ! adjust initial vertical scale factors 477 fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 478 fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 479 end do 480 fse3t_a(:,:,:) = fse3t_b(:,:,:) 481 ! Reconstruction of all vertical scale factors at now and before time steps 482 ! ============================================================================= 483 ! Horizontal scale factor interpolations 484 ! -------------------------------------- 485 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 486 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 487 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 488 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 489 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 490 ! Vertical scale factor interpolations 491 ! ------------------------------------ 492 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' ) 493 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 494 CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 495 CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 496 CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 497 ! t- and w- points depth 498 ! ---------------------- 499 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 500 fsdepw_n(:,:,1) = 0.0_wp 501 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 502 DO jk = 2, jpk 503 fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 504 fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 505 fsde3w_n(:,:,jk) = fsdept_n(:,:,jk ) - sshn (:,:) 506 END DO 472 !!gm I really don't like this staff here... Find a way to put that elsewhere or differently 473 !!gm 474 IF( .NOT.ln_linssh ) THEN 475 476 do jk = 1,jpkm1 ! adjust initial vertical scale factors 477 e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 478 e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 479 end do 480 e3t_a(:,:,:) = e3t_b(:,:,:) 481 ! Reconstruction of all vertical scale factors at now and before time steps 482 ! ! Horizontal scale factor interpolations 483 CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 484 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 485 CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 486 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 487 CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 488 ! ! Vertical scale factor interpolations 489 CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' ) 490 CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 491 CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 492 CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 493 CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 494 ! ! t- and w- points depth 495 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 496 gdepw_n(:,:,1) = 0.0_wp 497 gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 498 DO jk = 2, jpk 499 gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk) 500 gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 501 gde3w_n(:,:,jk) = gdept_n(:,:,jk ) - sshn (:,:) 502 END DO 503 ENDIF 504 !!gm end 507 505 ENDIF 508 506 !
Note: See TracChangeset
for help on using the changeset viewer.
