New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 4297 – NEMO

Changeset 4297


Ignore:
Timestamp:
2013-11-20T18:29:11+01:00 (10 years ago)
Author:
clem
Message:

change limsbc as in lim2

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4205 r4297  
    3838   USE cpl_oasis3, ONLY : lk_cpl 
    3939   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_n 
     40   USE oce,        ONLY : iatte, oatte, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
    4141   USE dom_ice,    ONLY : tms 
    4242   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     
    434434            sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
    435435            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 
    467468         ENDIF 
    468469      ENDIF ! .NOT. ln_rstart 
    469       ! 
    470 !!?      IF( .NOT. ln_rstart ) THEN           ! delete the initial ssh below sea-ice area 
    471 !!?         ! 
    472 !!?         zarea     = glob_sum( e1e2t(:,:) )           ! interior global domain surface 
    473 !!?         zsum      = glob_sum( e1e2t(:,:) * ( snwice_mass(:,:) ) ) / zarea * r1_rau0 
    474 !!?         sshn(:,:) = sshn(:,:) - zsum  
    475 !!?         sshb(:,:) = sshb(:,:) - zsum 
    476 !!?      ENDIF 
    477470      ! 
    478471 
Note: See TracChangeset for help on using the changeset viewer.