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 5620 for branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90 – NEMO

Ignore:
Timestamp:
2015-07-21T10:55:28+02:00 (9 years ago)
Author:
jamesharle
Message:

Merge with r5619 of trunk, update to unstructured BDY interpolation in
fldread.F90. Structured BDY interpolation incomplete.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90

    • Property svn:keywords set to Id
    r5038 r5620  
    2626   USE dom_ice_2       ! sea-ice domain 
    2727#elif defined key_lim3 
    28    USE par_ice 
    2928   USE ice             ! LIM_3 ice variables 
    3029   USE dom_ice         ! sea-ice domain 
     30   USE limvar 
    3131#endif  
    3232   USE par_oce         ! ocean parameters 
     
    4242   PRIVATE 
    4343 
    44    PUBLIC   bdy_ice_lim    ! routine called in sbcmod 
     44   PUBLIC   bdy_ice_lim     ! routine called in sbcmod 
    4545   PUBLIC   bdy_ice_lim_dyn ! routine called in limrhg 
    4646 
    4747   !!---------------------------------------------------------------------- 
    4848   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    49    !! $Id: bdyice.F90 2715 2011-03-30 15:58:35Z rblod $ 
     49   !! $Id$ 
    5050   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5151   !!---------------------------------------------------------------------- 
     
    6060      !!---------------------------------------------------------------------- 
    6161      INTEGER, INTENT( in ) :: kt     ! Main time step counter 
    62       !! 
    6362      INTEGER               :: ib_bdy ! Loop index 
     63 
     64#if defined key_lim3 
     65      CALL lim_var_glo2eqv 
     66#endif 
     67 
    6468      DO ib_bdy=1, nb_bdy 
    6569 
     
    7276            CALL ctl_stop( 'bdy_ice_lim : unrecognised option for open boundaries for ice fields' ) 
    7377         END SELECT 
    74       ENDDO 
     78 
     79      END DO 
     80 
     81#if defined key_lim3 
     82      CALL lim_var_zapsmall 
     83      CALL lim_var_agg(1) 
     84#endif 
    7585 
    7686   END SUBROUTINE bdy_ice_lim 
     
    8999      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    90100      INTEGER,         INTENT(in) ::   kt   ! main time-step counter 
    91       INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index      !! 
     101      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    92102 
    93103      INTEGER  ::   jpbound            ! 0 = incoming ice 
     
    169179            jpbound = 0; ii = ji; ij = jj; 
    170180 
    171             IF ( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj 
    172             IF ( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj 
    173             IF ( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1 
    174             IF ( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1 
    175  
    176             rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ii,ij) + 0.01 ) ) ! 0 if no ice 
     181            IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj 
     182            IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj 
     183            IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1 
     184            IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1 
     185 
     186            IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj   ! case ice boundaries = initial conditions 
     187                                                                              !      do not make state variables dependent on velocity 
     188                
     189 
     190            rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice 
    177191 
    178192            ! concentration and thickness 
     
    190204 
    191205               ! Ice salinity, age, temperature 
    192 <<<<<<< .working 
    193                sm_i(ji,jj,jl)   = zinda * rn_ice_sal(ib_bdy)  + ( 1.0 - zinda ) * s_i_min 
    194                o_i(ji,jj,jl)    = zinda * rn_ice_age(ib_bdy)  + ( 1.0 - zinda ) 
    195                t_su(ji,jj,jl)   = zinda * rn_ice_tem(ib_bdy)  + ( 1.0 - zinda ) * rn_ice_tem(ib_bdy) 
    196 ======= 
    197                sm_i(ji,jj,jl)   = rswitch * rn_ice_sal(ib_bdy)  + ( 1.0 - rswitch ) * s_i_min 
    198                o_i(ji,jj,jl)    = rswitch * rn_ice_age(ib_bdy)  + ( 1.0 - rswitch ) 
     206               sm_i(ji,jj,jl)   = rswitch * rn_ice_sal(ib_bdy)  + ( 1.0 - rswitch ) * rn_simin 
     207               oa_i(ji,jj,jl)   = rswitch * rn_ice_age(ib_bdy) * a_i(ji,jj,jl) 
    199208               t_su(ji,jj,jl)   = rswitch * rn_ice_tem(ib_bdy)  + ( 1.0 - rswitch ) * rn_ice_tem(ib_bdy) 
    200 >>>>>>> .merge-right.r5035 
    201209               DO jk = 1, nlay_s 
    202 <<<<<<< .working 
    203                   t_s(ji,jj,jk,jl) = zinda * rn_ice_tem(ib_bdy) + ( 1.0 - zinda ) * rtt 
    204 ======= 
    205                   t_s(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rtt 
    206 >>>>>>> .merge-right.r5035 
     210                  t_s(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0 
    207211               END DO 
    208212               DO jk = 1, nlay_i 
    209 <<<<<<< .working 
    210                   t_i(ji,jj,jk,jl) = zinda * rn_ice_tem(ib_bdy) + ( 1.0 - zinda ) * rtt  
    211                   s_i(ji,jj,jk,jl) = zinda * rn_ice_sal(ib_bdy) + ( 1.0 - zinda ) * s_i_min 
    212 ======= 
    213                   t_i(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rtt  
    214                   s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * s_i_min 
    215 >>>>>>> .merge-right.r5035 
     213                  t_i(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0  
     214                  s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin 
    216215               END DO 
    217216                
     
    219218  
    220219               ! Ice salinity, age, temperature 
    221                sm_i(ji,jj,jl)   = rswitch * sm_i(ii,ij,jl)  + ( 1.0 - rswitch ) * s_i_min 
    222                o_i(ji,jj,jl)    = rswitch * o_i(ii,ij,jl)   + ( 1.0 - rswitch ) 
    223                t_su(ji,jj,jl)   = rswitch * t_su(ii,ij,jl)  + ( 1.0 - rswitch ) * rtt 
     220               sm_i(ji,jj,jl)   = rswitch * sm_i(ii,ij,jl)  + ( 1.0 - rswitch ) * rn_simin 
     221               oa_i(ji,jj,jl)   = rswitch * oa_i(ii,ij,jl) 
     222               t_su(ji,jj,jl)   = rswitch * t_su(ii,ij,jl)  + ( 1.0 - rswitch ) * rt0 
    224223               DO jk = 1, nlay_s 
    225                   t_s(ji,jj,jk,jl) = rswitch * t_s(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rtt 
     224                  t_s(ji,jj,jk,jl) = rswitch * t_s(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0 
    226225               END DO 
    227226               DO jk = 1, nlay_i 
    228                   t_i(ji,jj,jk,jl) = rswitch * t_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rtt 
    229                   s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * s_i_min 
     227                  t_i(ji,jj,jk,jl) = rswitch * t_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0 
     228                  s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin 
    230229               END DO 
    231230 
     
    233232 
    234233            ! if salinity is constant, then overwrite rn_ice_sal 
    235             IF( num_sal == 1 ) THEN 
    236                sm_i(ji,jj,jl)   = bulk_sal 
    237                s_i (ji,jj,:,jl) = bulk_sal 
     234            IF( nn_icesal == 1 ) THEN 
     235               sm_i(ji,jj,jl)   = rn_icesal 
     236               s_i (ji,jj,:,jl) = rn_icesal 
    238237            ENDIF 
    239238 
    240239            ! contents 
    241240            smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 
    242             oa_i(ji,jj,jl)   = o_i(ji,jj,jl) * a_i(ji,jj,jl) 
    243241            DO jk = 1, nlay_s 
    244242               ! Snow energy of melting 
    245                e_s(ji,jj,jk,jl) = rswitch * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
    246                ! Change dimensions 
    247                e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 
    248                ! Multiply by volume, so that heat content in 10^9 Joules 
    249                e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 
     243               e_s(ji,jj,jk,jl) = rswitch * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus ) 
     244               ! Multiply by volume, so that heat content in J/m2 
     245               e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 
    250246            END DO 
    251247            DO jk = 1, nlay_i 
    252                ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K                   
     248               ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K                   
    253249               ! heat content per unit volume 
    254250               e_i(ji,jj,jk,jl) = rswitch * rhoic * & 
    255251                  (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    256                   +   lfus    * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 
    257                   - rcp      * ( ztmelts - rtt ) ) 
    258                ! Correct dimensions to avoid big values 
    259                e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    260                ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
    261                e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / nlay_i 
     252                  +   lfus    * ( 1.0 - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) & 
     253                  - rcp      * ( ztmelts - rt0 ) ) 
     254               ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 
     255               e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i 
    262256            END DO 
    263257 
    264  
    265          END DO !jb 
     258         END DO 
    266259  
    267          CALL lbc_bdy_lnk(  a_i(:,:,jl), 'T', 1., ib_bdy )                                         ! lateral boundary conditions 
     260         CALL lbc_bdy_lnk(  a_i(:,:,jl), 'T', 1., ib_bdy ) 
    268261         CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy ) 
    269262         CALL lbc_bdy_lnk( ht_s(:,:,jl), 'T', 1., ib_bdy ) 
     
    274267         CALL lbc_bdy_lnk(  sm_i(:,:,jl), 'T', 1., ib_bdy ) 
    275268         CALL lbc_bdy_lnk(  oa_i(:,:,jl), 'T', 1., ib_bdy ) 
    276          CALL lbc_bdy_lnk(   o_i(:,:,jl), 'T', 1., ib_bdy ) 
    277269         CALL lbc_bdy_lnk(  t_su(:,:,jl), 'T', 1., ib_bdy ) 
    278270         DO jk = 1, nlay_s 
     
    306298      !! 
    307299      CHARACTER(len=1), INTENT(in)  ::   cd_type   ! nature of velocity grid-points 
    308       INTEGER  ::   jb, jgrd   ! dummy loop indices 
     300      INTEGER  ::   jb, jgrd           ! dummy loop indices 
    309301      INTEGER  ::   ji, jj             ! local scalar 
    310       INTEGER  ::   ib_bdy ! Loop index 
     302      INTEGER  ::   ib_bdy             ! Loop index 
    311303      REAL(wp) ::   zmsk1, zmsk2, zflag 
    312304     !!------------------------------------------------------------------------------ 
     
    324316         CASE('frs') 
    325317             
    326  
     318            IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions  
     319                                                               !      do not change ice velocity (it is only computed by rheology) 
     320  
    327321            SELECT CASE ( cd_type ) 
    328  
     322                
    329323            CASE ( 'U' ) 
    330324                
     
    341335                      
    342336                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 
    343                      u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5 * ABS( zflag + 1._wp ) * zmsk1 + & 
    344                         &            u_ice(ji-1,jj) * 0.5 * ABS( zflag - 1._wp ) * zmsk2 + & 
     337                     u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 
     338                        &            u_ice(ji-1,jj) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + & 
    345339                        &            u_oce(ji  ,jj) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) ) 
    346340                  ELSE                             ! everywhere else 
     
    349343                  ENDIF 
    350344                  ! mask ice velocities 
    351                   rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ji,jj) + 0.01 ) ) ! 0 if no ice 
     345                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice 
    352346                  u_ice(ji,jj) = rswitch * u_ice(ji,jj) 
    353347                   
    354348               ENDDO 
    355  
     349                
    356350               CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy ) 
    357351                
     
    370364                      
    371365                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 
    372                      v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5 * ABS( zflag + 1._wp ) * zmsk1 + & 
    373                         &            v_ice(ji,jj-1) * 0.5 * ABS( zflag - 1._wp ) * zmsk2 + & 
     366                     v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 
     367                        &            v_ice(ji,jj-1) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + & 
    374368                        &            v_oce(ji,jj  ) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) ) 
    375369                  ELSE                             ! everywhere else 
     
    378372                  ENDIF 
    379373                  ! mask ice velocities 
    380                   rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ji,jj) + 0.01 ) ) ! 0 if no ice 
     374                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice 
    381375                  v_ice(ji,jj) = rswitch * v_ice(ji,jj) 
    382376                   
     
    384378                
    385379               CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy ) 
    386                 
     380                   
    387381            END SELECT 
    388382             
Note: See TracChangeset for help on using the changeset viewer.