Changeset 4297
- Timestamp:
- 2013-11-20T18:29:11+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r4205 r4297 38 38 USE cpl_oasis3, ONLY : lk_cpl 39 39 USE traqsr ! clem: add penetration of solar flux into the calculation of heat budget 40 USE oce, ONLY : iatte, oatte, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass , sshu_b, sshv_b, sshu_n, sshv_n, sshf_n40 USE oce, ONLY : iatte, oatte, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 41 41 USE dom_ice, ONLY : tms 42 42 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 434 434 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 435 435 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 436 ! 437 ! Note: Changed the initial values of sshb and sshn=> need to recompute ssh[u,v,f]_[b,n] 438 ! which were previously set in domvvl 439 IF ( lk_vvl ) THEN ! Is this necessary? embd 2 should be restricted to vvl only??? 440 DO jj = 1, jpjm1 441 DO ji = 1, jpim1 ! caution: use of Vector Opt. not possible 442 zcoefu = 0.5 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) 443 zcoefv = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) 444 zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 445 sshu_b(ji,jj) = zcoefu * ( e1t(ji ,jj) * e2t(ji ,jj) * sshb(ji ,jj) & 446 & + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) 447 sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj ) * e2t(ji,jj ) * sshb(ji,jj ) & 448 & + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 449 sshu_n(ji,jj) = zcoefu * ( e1t(ji ,jj) * e2t(ji ,jj) * sshn(ji ,jj) & 450 & + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) ) 451 sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj ) * e2t(ji,jj ) * sshn(ji,jj ) & 452 & + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) ) 453 END DO 454 END DO 455 CALL lbc_lnk( sshu_b, 'U', 1. ) ; CALL lbc_lnk( sshu_n, 'U', 1. ) 456 CALL lbc_lnk( sshv_b, 'V', 1. ) ; CALL lbc_lnk( sshv_n, 'V', 1. ) 457 DO jj = 1, jpjm1 458 DO ji = 1, jpim1 ! NO Vector Opt. 459 sshf_n(ji,jj) = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) & 460 & / ( e1f(ji,jj ) * e2f(ji,jj ) ) & 461 & * ( e1u(ji,jj ) * e2u(ji,jj ) * sshu_n(ji,jj ) & 462 & + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 463 END DO 464 END DO 465 CALL lbc_lnk( sshf_n, 'F', 1. ) 466 ENDIF 436 do jk = 1,jpkm1 ! adjust initial vertical scale factors 437 fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 438 fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 439 end do 440 fse3t_a(:,:,:) = fse3t_b(:,:,:) 441 ! Reconstruction of all vertical scale factors at now and before time 442 ! steps 443 ! ============================================================================= 444 ! Horizontal scale factor interpolations 445 ! -------------------------------------- 446 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 447 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 448 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 449 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 450 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 451 ! Vertical scale factor interpolations 452 ! ------------------------------------ 453 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' ) 454 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 455 CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 456 CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 457 CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 458 ! t- and w- points depth 459 ! ---------------------- 460 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 461 fsdepw_n(:,:,1) = 0.0_wp 462 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 463 DO jk = 2, jpk 464 fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 465 fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 466 fsde3w_n(:,:,jk) = fsdept_n(:,:,jk ) - sshn (:,:) 467 END DO 467 468 ENDIF 468 469 ENDIF ! .NOT. ln_rstart 469 !470 !!? IF( .NOT. ln_rstart ) THEN ! delete the initial ssh below sea-ice area471 !!? !472 !!? zarea = glob_sum( e1e2t(:,:) ) ! interior global domain surface473 !!? zsum = glob_sum( e1e2t(:,:) * ( snwice_mass(:,:) ) ) / zarea * r1_rau0474 !!? sshn(:,:) = sshn(:,:) - zsum475 !!? sshb(:,:) = sshb(:,:) - zsum476 !!? ENDIF477 470 ! 478 471
Note: See TracChangeset
for help on using the changeset viewer.