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 4205 for branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90 – NEMO

Ignore:
Timestamp:
2013-11-14T18:02:06+01:00 (10 years ago)
Author:
clem
Message:
 
File:
1 edited

Legend:

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

    r4161 r4205  
    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 : 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, sshu_b, sshv_b, sshu_n, sshv_n, sshf_n 
    4141   USE dom_ice,    ONLY : tms 
    4242   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     
    249249            ! mass flux at the ocean/ice interface (sea ice fraction) 
    250250            zemp_snw = rdm_snw(ji,jj) * r1_rdtice                         ! snow melting = pure water that enters the ocean 
    251             zfmm     = rdm_ice(ji,jj) * r1_rdtice                         ! Freezing minus mesting   
     251            zfmm     = rdm_ice(ji,jj) * r1_rdtice                         ! Freezing minus melting   
    252252 
    253253            fmmflx(ji,jj) = zfmm                                     ! F/M mass flux save at least for biogeochemical model 
     
    416416      ENDIF 
    417417      ! clem modif 
    418       iatte(:,:) = 1._wp 
    419       oatte(:,:) = 1._wp 
    420       ! 
    421       !                                      ! embedded sea ice 
    422       IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
    423          snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
    424          snwice_mass_b(:,:) = snwice_mass(:,:) 
    425       ELSE 
    426          snwice_mass  (:,:) = 0.0_wp         ! no mass exchanges 
    427          snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges 
    428       ENDIF 
    429       IF( nn_ice_embd == 2  .AND.         &  ! full embedment (case 2) & no restart 
    430          &  .NOT. ln_rstart ) THEN           ! deplete the initial ssh below sea-ice area 
    431          sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
    432          sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
    433          ! 
    434          ! Note: Changed the initial values of sshb and sshn=>  need to recompute ssh[u,v,f]_[b,n]  
    435          !       which were previously set in domvvl 
    436          IF ( lk_vvl ) THEN            ! Is this necessary? embd 2 should be restricted to vvl only??? 
    437             DO jj = 1, jpjm1 
    438                DO ji = 1, jpim1                    ! caution: use of Vector Opt. not possible 
    439                   zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) 
    440                   zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) 
    441                   zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 
    442                   sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     & 
    443                      &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) 
    444                   sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     & 
    445                      &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 
    446                   sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     & 
    447                      &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) ) 
    448                   sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     & 
    449                      &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) ) 
     418      IF( .NOT. ln_rstart ) THEN 
     419         iatte(:,:) = 1._wp 
     420         oatte(:,:) = 1._wp 
     421      ENDIF 
     422      ! 
     423      ! clem: snwice_mass in the restart file now 
     424      IF( .NOT. ln_rstart ) THEN 
     425         !                                      ! embedded sea ice 
     426         IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
     427            snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
     428            snwice_mass_b(:,:) = snwice_mass(:,:) 
     429         ELSE 
     430            snwice_mass  (:,:) = 0.0_wp         ! no mass exchanges 
     431            snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges 
     432         ENDIF 
     433         IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area 
     434            sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
     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 
    450454               END DO 
    451             END DO 
    452             CALL lbc_lnk( sshu_b, 'U', 1. )   ;   CALL lbc_lnk( sshu_n, 'U', 1. ) 
    453             CALL lbc_lnk( sshv_b, 'V', 1. )   ;   CALL lbc_lnk( sshv_n, 'V', 1. ) 
    454             DO jj = 1, jpjm1 
    455                DO ji = 1, jpim1      ! NO Vector Opt. 
    456                   sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   & 
    457                        &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
    458                        &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
    459                        &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
     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 
    460464               END DO 
    461             END DO 
    462             CALL lbc_lnk( sshf_n, 'F', 1. ) 
    463           ENDIF 
    464       ENDIF 
     465               CALL lbc_lnk( sshf_n, 'F', 1. ) 
     466            ENDIF 
     467         ENDIF 
     468      ENDIF ! .NOT. ln_rstart 
    465469      ! 
    466470!!?      IF( .NOT. ln_rstart ) THEN           ! delete the initial ssh below sea-ice area 
Note: See TracChangeset for help on using the changeset viewer.