- 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/OPA_SRC/SBC/sbcice_cice.F90
r5516 r6808 9 9 !!---------------------------------------------------------------------- 10 10 !! sbc_ice_cice : sea-ice model time-stepping and update ocean sbc over ice-covered area 11 !!12 !!13 11 !!---------------------------------------------------------------------- 14 12 USE oce ! ocean dynamics and tracers … … 67 65 PRIVATE 68 66 69 !! * Routine accessibility70 67 PUBLIC cice_sbc_init ! routine called by sbc_init 71 68 PUBLIC cice_sbc_final ! routine called by sbc_final … … 93 90 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PRIVATE :: png ! local array used in sbc_cice_ice 94 91 95 !! * Substitutions 96 # include "domzgr_substitute.h90" 97 92 !!---------------------------------------------------------------------- 93 !! NEMO/OPA 3.7 , NEMO-consortium (2015) 98 94 !! $Id$ 95 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 96 !!---------------------------------------------------------------------- 99 97 CONTAINS 100 98 … … 154 152 END SUBROUTINE sbc_ice_cice 155 153 156 SUBROUTINE cice_sbc_init (ksbc) 154 155 SUBROUTINE cice_sbc_init( ksbc ) 157 156 !!--------------------------------------------------------------------- 158 157 !! *** ROUTINE cice_sbc_init *** 159 158 !! ** Purpose: Initialise ice related fields for NEMO and coupling 160 159 !! 160 !!--------------------------------------------------------------------- 161 161 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 162 162 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 … … 240 240 snwice_mass_b(:,:) = 0.0_wp ! no mass exchanges 241 241 ENDIF 242 IF( .NOT. 242 IF( .NOT.ln_rstart ) THEN 243 243 IF( nn_ice_embd == 2 ) THEN ! full embedment (case 2) deplete the initial ssh below sea-ice area 244 244 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 245 245 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 246 #if defined key_vvl 247 ! key_vvl necessary? clem: yes for compilation purpose 248 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 249 fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 250 fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 251 ENDDO 252 fse3t_a(:,:,:) = fse3t_b(:,:,:) 253 ! Reconstruction of all vertical scale factors at now and before time 254 ! steps 255 ! ============================================================================= 256 ! Horizontal scale factor interpolations 257 ! -------------------------------------- 258 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 259 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 260 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 261 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 262 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 263 ! Vertical scale factor interpolations 264 ! ------------------------------------ 265 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' ) 266 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 267 CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 268 CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 269 CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 270 ! t- and w- points depth 271 ! ---------------------- 272 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 273 fsdepw_n(:,:,1) = 0.0_wp 274 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 275 DO jk = 2, jpk 276 fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 277 fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 278 fsde3w_n(:,:,jk) = fsdept_n(:,:,jk ) - sshn (:,:) 279 END DO 280 #endif 246 247 !!gm This should be put elsewhere.... (same remark for limsbc) 248 !!gm especially here it is assumed zstar coordinate, but it can be ztilde.... 249 IF( .NOT.ln_linssh ) THEN 250 ! 251 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 252 e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 253 e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 254 ENDDO 255 e3t_a(:,:,:) = e3t_b(:,:,:) 256 ! Reconstruction of all vertical scale factors at now and before time-steps 257 ! ============================================================================= 258 ! Horizontal scale factor interpolations 259 ! -------------------------------------- 260 CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 261 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 262 CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 263 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 264 CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 265 ! Vertical scale factor interpolations 266 ! ------------------------------------ 267 CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' ) 268 CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 269 CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 270 CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 271 CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 272 ! t- and w- points depth 273 ! ---------------------- 274 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 275 gdepw_n(:,:,1) = 0.0_wp 276 gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 277 DO jk = 2, jpk 278 gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk) 279 gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 280 gde3w_n(:,:,jk) = gdept_n(:,:,jk ) - sshn (:,:) 281 END DO 282 ENDIF 281 283 ENDIF 282 284 ENDIF 283 285 ! 284 286 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 285 287 ! … … 289 291 290 292 291 SUBROUTINE cice_sbc_in (kt, ksbc)293 SUBROUTINE cice_sbc_in( kt, ksbc ) 292 294 !!--------------------------------------------------------------------- 293 295 !! *** ROUTINE cice_sbc_in *** … … 296 298 INTEGER, INTENT(in ) :: kt ! ocean time step 297 299 INTEGER, INTENT(in ) :: ksbc ! surface forcing type 298 300 ! 299 301 INTEGER :: ji, jj, jl ! dummy loop indices 300 302 REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice … … 444 446 ! Freezing/melting potential 445 447 ! Calculated over NEMO leapfrog timestep (hence 2*dt) 446 nfrzmlt(:,:) =rau0*rcp*fse3t_m(:,:)*(Tocnfrz-sst_m(:,:))/(2.0*dt)448 nfrzmlt(:,:) = rau0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt ) 447 449 448 450 ztmp(:,:) = nfrzmlt(:,:) … … 490 492 ! x comp and y comp of sea surface slope (on F points) 491 493 ! T point to F point 492 DO jj=1,jpjm1 493 DO ji=1,jpim1 494 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj ))/e1u(ji,jj ) & 495 + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) & 496 * fmask(ji,jj,1) 497 ENDDO 498 ENDDO 499 CALL nemo2cice(ztmp,ss_tltx,'F', -1. ) 494 DO jj = 1, jpjm1 495 DO ji = 1, jpim1 496 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj )) * r1_e1u(ji,jj ) & 497 & + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1) ) * fmask(ji,jj,1) 498 END DO 499 END DO 500 CALL nemo2cice( ztmp,ss_tltx,'F', -1. ) 500 501 501 502 ! T point to F point 502 DO jj=1,jpjm1 503 DO ji=1,jpim1 504 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj))/e2v(ji ,jj) & 505 + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) & 506 * fmask(ji,jj,1) 507 ENDDO 508 ENDDO 503 DO jj = 1, jpjm1 504 DO ji = 1, jpim1 505 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj)) * r1_e2v(ji ,jj) & 506 & + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj) ) * fmask(ji,jj,1) 507 END DO 508 END DO 509 509 CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 510 510 … … 517 517 518 518 519 SUBROUTINE cice_sbc_out (kt,ksbc)519 SUBROUTINE cice_sbc_out( kt, ksbc ) 520 520 !!--------------------------------------------------------------------- 521 521 !! *** ROUTINE cice_sbc_out *** … … 575 575 ! Update taum with modulus of ice-ocean stress 576 576 ! strocnxT and strocnyT are not weighted by ice fraction in CICE so must be done here 577 taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1* *2. + ztmp2**2.)577 taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1*ztmp1 + ztmp2*ztmp2) 578 578 579 579 ! Freshwater fluxes … … 888 888 #endif 889 889 !!--------------------------------------------------------------------- 890 891 890 CHARACTER(len=1), INTENT( in ) :: & 892 891 cd_type ! nature of pn grid-point … … 908 907 909 908 INTEGER :: ji, jj, jn ! dummy loop indices 909 !!--------------------------------------------------------------------- 910 910 911 911 ! A. Ensure all haloes are filled in NEMO field (pn) … … 1096 1096 !! Default option Dummy module NO CICE sea-ice model 1097 1097 !!---------------------------------------------------------------------- 1098 !! $Id$1099 1098 CONTAINS 1100 1099
Note: See TracChangeset
for help on using the changeset viewer.
