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 7646 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90 – NEMO

Ignore:
Timestamp:
2017-02-06T10:25:03+01:00 (7 years ago)
Author:
timgraham
Message:

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r6416 r7646  
    3434   USE traqsr         ! add penetration of solar flux in the calculation of heat budget 
    3535   USE domvvl         ! Variable volume 
    36    USE limctl         !  
    37    USE limcons        !  
     36   USE limctl         ! 
     37   USE limcons        ! 
     38   USE bdy_oce  , ONLY: ln_bdy 
    3839   ! 
    3940   USE in_out_manager ! I/O manager 
     
    4243   USE lib_mpp        ! MPP library 
    4344   USE wrk_nemo       ! work arrays 
    44    USE prtctl         ! Print control 
    4545   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4646 
     
    4848   PRIVATE 
    4949 
    50    PUBLIC   lim_sbc_init   ! called by sbcice_lim 
     50   PUBLIC   lim_sbc_init   ! called by sbc_lim_init 
    5151   PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim 
    5252   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim 
     
    9494      !!              - fr_i    : ice fraction 
    9595      !!              - tn_ice  : sea-ice surface temperature 
    96       !!              - alb_ice : sea-ice albedo (only useful in coupled mode) 
     96      !!              - alb_ice : sea-ice albedo (recomputed only for coupled mode) 
    9797      !! 
    9898      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 
     
    109109      REAL(wp), POINTER, DIMENSION(:,:)   ::   zalb                 ! 2D workspace 
    110110      !!--------------------------------------------------------------------- 
    111       ! 
    112       ! make calls for heat fluxes before it is modified 
    113       ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
    114       IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) )                                   !     solar flux at ocean surface 
    115       IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) )                   ! non-solar flux at ocean surface 
    116       IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux at ice surface 
    117       IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 
    118       IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux transmitted thru ice 
    119       IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) )   
    120       IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   & 
    121          &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 
    122       IF( iom_use('qemp_oce') )  CALL iom_put( "qemp_oce" , qemp_oce(:,:) )   
    123       IF( iom_use('qemp_ice') )  CALL iom_put( "qemp_ice" , qemp_ice(:,:) )   
    124       IF( iom_use('emp_oce' ) )  CALL iom_put( "emp_oce"  , emp_oce(:,:) )   ! emp over ocean (taking into account the snow blown away from the ice) 
    125       IF( iom_use('emp_ice' ) )  CALL iom_put( "emp_ice"  , emp_ice(:,:) )   ! emp over ice   (taking into account the snow blown away from the ice) 
    126  
     111 
     112      ! --- case we bypass ice thermodynamics --- ! 
     113      IF( .NOT. ln_limthd ) THEN   ! we suppose ice is impermeable => ocean is isolated from atmosphere 
     114         hfx_in   (:,:)   = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 
     115         hfx_out  (:,:)   = pfrld(:,:) *   qns_oce(:,:)                  + qemp_oce(:,:) 
     116         ftr_ice  (:,:,:) = 0._wp 
     117         emp_ice  (:,:)   = 0._wp 
     118         qemp_ice (:,:)   = 0._wp 
     119         qevap_ice(:,:,:) = 0._wp 
     120      ENDIF 
     121       
    127122      ! albedo output 
    128123      CALL wrk_alloc( jpi,jpj, zalb )     
    129124 
    130125      zalb(:,:) = 0._wp 
    131       WHERE     ( SUM( a_i_b, dim=3 ) <= epsi06 )  ;  zalb(:,:) = 0.066_wp 
    132       ELSEWHERE                                    ;  zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 ) 
     126      WHERE     ( at_i_b <= epsi06 )  ;  zalb(:,:) = 0.066_wp 
     127      ELSEWHERE                       ;  zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 
    133128      END WHERE 
    134129      IF( iom_use('alb_ice' ) )  CALL iom_put( "alb_ice"  , zalb(:,:) )           ! ice albedo output 
    135130 
    136       zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - SUM( a_i_b, dim=3 ) )       
     131      zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - at_i_b )       
    137132      IF( iom_use('albedo'  ) )  CALL iom_put( "albedo"  , zalb(:,:) )           ! ice albedo output 
    138133 
     
    180175            ! mass flux from ice/ocean 
    181176            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
    182                            + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 
     177                           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj)  
    183178 
    184179            ! mass flux at the ocean/ice interface 
    185180            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model 
    186             emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)             
     181            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    187182         END DO 
    188183      END DO 
     
    192187      !------------------------------------------! 
    193188      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   & 
    194          &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) 
     189         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) + sfx_lam(:,:) 
    195190 
    196191      !-------------------------------------------------------------! 
     
    221216 
    222217      ! conservation test 
    223       IF( ln_limdiahsb )   CALL lim_cons_final( 'limsbc' ) 
     218      IF( ln_limdiachk .AND. .NOT. ln_bdy)  CALL lim_cons_final( 'limsbc' ) 
    224219 
    225220      ! control prints 
    226       IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 
    227       ! 
    228       IF(ln_ctl) THEN 
    229          CALL prt_ctl( tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns , clinfo2=' qns     : ' ) 
    230          CALL prt_ctl( tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=sfx , clinfo2=' sfx     : ' ) 
    231          CALL prt_ctl( tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ' ) 
    232          CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 
    233       ENDIF 
    234       ! 
     221      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 
     222      IF( ln_ctl )      CALL lim_prt3D( 'limsbc' ) 
     223 
    235224   END SUBROUTINE lim_sbc_flx 
    236225 
     
    266255      INTEGER  ::   ji, jj   ! dummy loop indices 
    267256      REAL(wp) ::   zat_u, zutau_ice, zu_t, zmodt   ! local scalar 
    268       REAL(wp) ::   zat_v, zvtau_ice, zv_t          !   -      - 
     257      REAL(wp) ::   zat_v, zvtau_ice, zv_t, zrhoco  !   -      - 
    269258      !!--------------------------------------------------------------------- 
     259      zrhoco = rau0 * rn_cio 
    270260      ! 
    271261      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step) 
     
    278268               zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  ) 
    279269               !                                               ! update the ocean stress modulus 
    280                taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * rhoco * zmodt 
    281                tmod_io(ji,jj) = rhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point 
     270               taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt 
     271               tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point 
    282272            END DO 
    283273         END DO 
    284          CALL lbc_lnk( taum, 'T', 1. )   ;   CALL lbc_lnk( tmod_io, 'T', 1. ) 
     274         CALL lbc_lnk_multi( taum, 'T', 1., tmod_io, 'T', 1. ) 
    285275         ! 
    286276         utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step 
     
    303293         END DO 
    304294      END DO 
    305       CALL lbc_lnk( utau, 'U', -1. )   ;   CALL lbc_lnk( vtau, 'V', -1. )   ! lateral boundary condition 
    306       ! 
    307       IF(ln_ctl)   CALL prt_ctl( tab2d_1=utau, clinfo1=' lim_sbc: utau   : ', mask1=umask,   & 
    308          &                       tab2d_2=vtau, clinfo2=' vtau    : '        , mask2=vmask ) 
     295      CALL lbc_lnk_multi( utau, 'U', -1., vtau, 'V', -1. )   ! lateral boundary condition 
     296      ! 
    309297      !   
    310298   END SUBROUTINE lim_sbc_tau 
     
    333321      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
    334322      sice_0(:,:) = sice 
    335       ! 
    336       IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea  
    337          WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
    338             &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
    339             soce_0(:,:) = 4._wp 
    340             sice_0(:,:) = 2._wp 
    341          END WHERE 
    342       ENDIF 
     323      !                                      ! decrease ocean & ice reference salinities in the Baltic Sea area 
     324      WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
     325         &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
     326         soce_0(:,:) = 4._wp 
     327         sice_0(:,:) = 2._wp 
     328      END WHERE 
    343329      ! 
    344330      IF( .NOT. ln_rstart ) THEN 
     
    348334            snwice_mass_b(:,:) = snwice_mass(:,:) 
    349335         ELSE 
    350             snwice_mass  (:,:) = 0.0_wp         ! no mass exchanges 
    351             snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges 
     336            snwice_mass  (:,:) = 0._wp          ! no mass exchanges 
     337            snwice_mass_b(:,:) = 0._wp          ! no mass exchanges 
    352338         ENDIF 
    353339         IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area 
     
    355341            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
    356342 
    357 !!gm I really don't like this staff here...  Find a way to put that elsewhere or differently 
     343!!gm I really don't like this stuff here...  Find a way to put that elsewhere or differently 
    358344!!gm 
    359345            IF( .NOT.ln_linssh ) THEN 
Note: See TracChangeset for help on using the changeset viewer.