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

Ignore:
Timestamp:
2015-07-10T13:28:53+02:00 (9 years ago)
Author:
timgraham
Message:

Merged head of trunk into branch

File:
1 edited

Legend:

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

    • Property svn:keywords set to Id
    r4965 r5581  
    2424   USE par_ice_2 
    2525   USE ice_2           ! LIM_2 ice variables 
     26   USE dom_ice_2       ! sea-ice domain 
    2627#elif defined key_lim3 
    27    USE par_ice 
    2828   USE ice             ! LIM_3 ice variables 
     29   USE dom_ice         ! sea-ice domain 
     30   USE limvar 
    2931#endif  
    3032   USE par_oce         ! ocean parameters 
    3133   USE dom_oce         ! ocean space and time domain variables  
    32    USE dom_ice          ! sea-ice domain 
    3334   USE sbc_oce         ! Surface boundary condition: ocean fields 
    3435   USE bdy_oce         ! ocean open boundary conditions 
     
    4142   PRIVATE 
    4243 
    43    PUBLIC   bdy_ice_lim    ! routine called in sbcmod 
     44   PUBLIC   bdy_ice_lim     ! routine called in sbcmod 
    4445   PUBLIC   bdy_ice_lim_dyn ! routine called in limrhg 
    4546 
    46    REAL(wp) ::   epsi20 = 1.e-20_wp  ! module constants 
    47    REAL(wp) ::   epsi10 = 1.e-10_wp  ! min area allowed by ice model 
    4847   !!---------------------------------------------------------------------- 
    4948   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    50    !! $Id: bdyice.F90 2715 2011-03-30 15:58:35Z rblod $ 
     49   !! $Id$ 
    5150   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5251   !!---------------------------------------------------------------------- 
     
    6160      !!---------------------------------------------------------------------- 
    6261      INTEGER, INTENT( in ) :: kt     ! Main time step counter 
    63       !! 
    6462      INTEGER               :: ib_bdy ! Loop index 
     63 
     64#if defined key_lim3 
     65      CALL lim_var_glo2eqv 
     66#endif 
     67 
    6568      DO ib_bdy=1, nb_bdy 
    6669 
     
    7376            CALL ctl_stop( 'bdy_ice_lim : unrecognised option for open boundaries for ice fields' ) 
    7477         END SELECT 
    75       ENDDO 
     78 
     79      END DO 
     80 
     81#if defined key_lim3 
     82      CALL lim_var_zapsmall 
     83      CALL lim_var_agg(1) 
     84#endif 
    7685 
    7786   END SUBROUTINE bdy_ice_lim 
     
    9099      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    91100      INTEGER,         INTENT(in) ::   kt   ! main time-step counter 
    92       INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index      !! 
     101      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    93102 
    94103      INTEGER  ::   jpbound            ! 0 = incoming ice 
     
    97106      INTEGER  ::   ji, jj, ii, ij     ! local scalar 
    98107      REAL(wp) ::   zwgt, zwgt1        ! local scalar 
    99       REAL(wp) ::   zinda, ztmelts, zdh 
     108      REAL(wp) ::   ztmelts, zdh 
    100109#if  defined key_lim2 && ! defined key_lim2_vp && defined key_agrif 
    101110     USE ice_2, vt_s => hsnm 
     
    118127         hicif(ji,jj) = ( hicif(ji,jj) * zwgt1 + dta%hicif(jb) * zwgt ) * tmask(ji,jj,1)     ! Ice depth  
    119128         hsnif(ji,jj) = ( hsnif(ji,jj) * zwgt1 + dta%hsnif(jb) * zwgt ) * tmask(ji,jj,1)     ! Snow depth 
    120  
    121 !         zinda = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - frld(ji,jj) ) ) ! 0 if no ice 
    122 !         !------------------------------ 
    123 !         ! Sea ice surface temperature 
    124 !         !------------------------------ 
    125 !         sist(ji,jj)   = zinda * 270.0 + ( 1.0 - zinda ) * tfu(ji,jj) 
    126 !         !----------------------------------------------- 
    127 !         ! Ice/snow temperatures and energy stored in brines  
    128 !         !----------------------------------------------- 
    129 !         !!! TO BE CONTIUNED (as LIM3 below) !!! 
    130 !            zindhe = MAX( 0.e0, SIGN( 1.e0, fcor(1,jj) ) )              ! = 0 for SH, =1 for NH 
    131 !  
    132 !               ! Recover in situ values. 
    133 !               zindb         = MAX( rzero, SIGN( rone, zs0a(ji,jj) - epsi06 ) ) 
    134 !               zacrith       = 1.0 - ( zindhe * acrit(1) + ( 1.0 - zindhe ) * acrit(2) ) 
    135 !               zs0a (ji,jj)  = zindb * MIN( zs0a(ji,jj), zacrith ) 
    136 !               hsnif(ji,jj)  = zindb * ( zs0sn(ji,jj) /MAX( zs0a(ji,jj), epsi16 ) ) 
    137 !               hicif(ji,jj)  = zindb * ( zs0ice(ji,jj)/MAX( zs0a(ji,jj), epsi16 ) ) 
    138 !               zindsn        = MAX( rzero, SIGN( rone, hsnif(ji,jj) - epsi06 ) ) 
    139 !               zindic        = MAX( rzero, SIGN( rone, hicif(ji,jj) - epsi03 ) ) 
    140 !               zindb         = MAX( zindsn, zindic ) 
    141 !               zs0a (ji,jj)  = zindb * zs0a(ji,jj) 
    142 !               frld (ji,jj)  = 1.0 - zs0a(ji,jj) 
    143 !               hsnif(ji,jj)  = zindsn * hsnif(ji,jj) 
    144 !               hicif(ji,jj)  = zindic * hicif(ji,jj) 
    145 !               zusvosn       = 1.0/MAX( hsnif(ji,jj) * zs0a(ji,jj), epsi16 ) 
    146 !               zusvoic       = 1.0/MAX( hicif(ji,jj) * zs0a(ji,jj), epsi16 ) 
    147 !               zignm         = MAX( rzero,  SIGN( rone, hsndif - hsnif(ji,jj) ) ) 
    148 !               zrtt          = 173.15 * rone  
    149 !               ztsn          =          zignm   * tbif(ji,jj,1)  & 
    150 !                              + ( 1.0 - zignm ) * MIN( MAX( zrtt, rt0_snow * zusvosn * zs0c0(ji,jj)) , tfu(ji,jj) )  
    151 !               ztic1          = MIN( MAX( zrtt, rt0_ice * zusvoic * zs0c1(ji,jj) ) , tfu(ji,jj) ) 
    152 !               ztic2          = MIN( MAX( zrtt, rt0_ice * zusvoic * zs0c2(ji,jj) ) , tfu(ji,jj) ) 
    153 !  
    154 !               tbif(ji,jj,1) = zindsn * ztsn  + ( 1.0 - zindsn ) * tfu(ji,jj)                
    155 !               tbif(ji,jj,2) = zindic * ztic1 + ( 1.0 - zindic ) * tfu(ji,jj) 
    156 !               tbif(ji,jj,3) = zindic * ztic2 + ( 1.0 - zindic ) * tfu(ji,jj) 
    157 !               qstoif(ji,jj) = zindb  * xlic * zs0st(ji,jj) /  MAX( zs0a(ji,jj), epsi16 ) 
    158  
    159129      END DO  
    160130 
     
    213183            jpbound = 0; ii = ji; ij = jj; 
    214184 
    215             IF ( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj 
    216             IF ( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj 
    217             IF ( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1 
    218             IF ( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1 
    219  
    220             zinda = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ii,ij) + 0.01 ) ) ! 0 if no ice 
     185            IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj 
     186            IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj 
     187            IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1 
     188            IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1 
     189 
     190            IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj   ! case ice boundaries = initial conditions 
     191                                                                              !      do not make state variables dependent on velocity 
     192                
     193 
     194            rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice 
    221195 
    222196            ! concentration and thickness 
    223             a_i (ji,jj,jl) = a_i (ii,ij,jl) * zinda 
    224             ht_i(ji,jj,jl) = ht_i(ii,ij,jl) * zinda 
    225             ht_s(ji,jj,jl) = ht_s(ii,ij,jl) * zinda 
     197            a_i (ji,jj,jl) = a_i (ii,ij,jl) * rswitch 
     198            ht_i(ji,jj,jl) = ht_i(ii,ij,jl) * rswitch 
     199            ht_s(ji,jj,jl) = ht_s(ii,ij,jl) * rswitch 
    226200 
    227201            ! Ice and snow volumes 
     
    234208 
    235209               ! Ice salinity, age, temperature 
    236                sm_i(ji,jj,jl)   = zinda * rn_ice_sal(ib_bdy)  + ( 1.0 - zinda ) * s_i_min 
    237                o_i(ji,jj,jl)    = zinda * rn_ice_age(ib_bdy)  + ( 1.0 - zinda ) 
    238                t_su(ji,jj,jl)   = zinda * rn_ice_tem(ib_bdy)  + ( 1.0 - zinda ) * rn_ice_tem(ib_bdy) 
     210               sm_i(ji,jj,jl)   = rswitch * rn_ice_sal(ib_bdy)  + ( 1.0 - rswitch ) * rn_simin 
     211               oa_i(ji,jj,jl)   = rswitch * rn_ice_age(ib_bdy) * a_i(ji,jj,jl) 
     212               t_su(ji,jj,jl)   = rswitch * rn_ice_tem(ib_bdy)  + ( 1.0 - rswitch ) * rn_ice_tem(ib_bdy) 
    239213               DO jk = 1, nlay_s 
    240                   t_s(ji,jj,jk,jl) = zinda * rn_ice_tem(ib_bdy) + ( 1.0 - zinda ) * rtt 
     214                  t_s(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0 
    241215               END DO 
    242216               DO jk = 1, nlay_i 
    243                   t_i(ji,jj,jk,jl) = zinda * rn_ice_tem(ib_bdy) + ( 1.0 - zinda ) * rtt  
    244                   s_i(ji,jj,jk,jl) = zinda * rn_ice_sal(ib_bdy) + ( 1.0 - zinda ) * s_i_min 
     217                  t_i(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0  
     218                  s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin 
    245219               END DO 
    246220                
     
    248222  
    249223               ! Ice salinity, age, temperature 
    250                sm_i(ji,jj,jl)   = zinda * sm_i(ii,ij,jl)  + ( 1.0 - zinda ) * s_i_min 
    251                o_i(ji,jj,jl)    = zinda * o_i(ii,ij,jl)   + ( 1.0 - zinda ) 
    252                t_su(ji,jj,jl)   = zinda * t_su(ii,ij,jl)  + ( 1.0 - zinda ) * rtt 
     224               sm_i(ji,jj,jl)   = rswitch * sm_i(ii,ij,jl)  + ( 1.0 - rswitch ) * rn_simin 
     225               oa_i(ji,jj,jl)   = rswitch * oa_i(ii,ij,jl) 
     226               t_su(ji,jj,jl)   = rswitch * t_su(ii,ij,jl)  + ( 1.0 - rswitch ) * rt0 
    253227               DO jk = 1, nlay_s 
    254                   t_s(ji,jj,jk,jl) = zinda * t_s(ii,ij,jk,jl) + ( 1.0 - zinda ) * rtt 
     228                  t_s(ji,jj,jk,jl) = rswitch * t_s(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0 
    255229               END DO 
    256230               DO jk = 1, nlay_i 
    257                   t_i(ji,jj,jk,jl) = zinda * t_i(ii,ij,jk,jl) + ( 1.0 - zinda ) * rtt 
    258                   s_i(ji,jj,jk,jl) = zinda * s_i(ii,ij,jk,jl) + ( 1.0 - zinda ) * s_i_min 
     231                  t_i(ji,jj,jk,jl) = rswitch * t_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0 
     232                  s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin 
    259233               END DO 
    260234 
     
    262236 
    263237            ! if salinity is constant, then overwrite rn_ice_sal 
    264             IF( num_sal == 1 ) THEN 
    265                sm_i(ji,jj,jl)   = bulk_sal 
    266                s_i (ji,jj,:,jl) = bulk_sal 
     238            IF( nn_icesal == 1 ) THEN 
     239               sm_i(ji,jj,jl)   = rn_icesal 
     240               s_i (ji,jj,:,jl) = rn_icesal 
    267241            ENDIF 
    268242 
    269243            ! contents 
    270244            smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 
    271             oa_i(ji,jj,jl)   = o_i(ji,jj,jl) * a_i(ji,jj,jl) 
    272245            DO jk = 1, nlay_s 
    273246               ! Snow energy of melting 
    274                e_s(ji,jj,jk,jl) = zinda * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
    275                ! Change dimensions 
    276                e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 
    277                ! Multiply by volume, so that heat content in 10^9 Joules 
    278                e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 
     247               e_s(ji,jj,jk,jl) = rswitch * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus ) 
     248               ! Multiply by volume, so that heat content in J/m2 
     249               e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 
    279250            END DO 
    280251            DO jk = 1, nlay_i 
    281                ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K                   
     252               ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K                   
    282253               ! heat content per unit volume 
    283                e_i(ji,jj,jk,jl) = zinda * rhoic * & 
     254               e_i(ji,jj,jk,jl) = rswitch * rhoic * & 
    284255                  (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    285                   +   lfus    * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 
    286                   - rcp      * ( ztmelts - rtt ) ) 
    287                ! Correct dimensions to avoid big values 
    288                e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    289                ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
    290                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 
     256                  +   lfus    * ( 1.0 - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) & 
     257                  - rcp      * ( ztmelts - rt0 ) ) 
     258               ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 
     259               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 
    291260            END DO 
    292261 
    293  
    294          END DO !jb 
     262         END DO 
    295263  
    296          CALL lbc_bdy_lnk(  a_i(:,:,jl), 'T', 1., ib_bdy )                                         ! lateral boundary conditions 
     264         CALL lbc_bdy_lnk(  a_i(:,:,jl), 'T', 1., ib_bdy ) 
    297265         CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy ) 
    298266         CALL lbc_bdy_lnk( ht_s(:,:,jl), 'T', 1., ib_bdy ) 
     
    303271         CALL lbc_bdy_lnk(  sm_i(:,:,jl), 'T', 1., ib_bdy ) 
    304272         CALL lbc_bdy_lnk(  oa_i(:,:,jl), 'T', 1., ib_bdy ) 
    305          CALL lbc_bdy_lnk(   o_i(:,:,jl), 'T', 1., ib_bdy ) 
    306273         CALL lbc_bdy_lnk(  t_su(:,:,jl), 'T', 1., ib_bdy ) 
    307274         DO jk = 1, nlay_s 
     
    335302      !! 
    336303      CHARACTER(len=1), INTENT(in)  ::   cd_type   ! nature of velocity grid-points 
    337       INTEGER  ::   jb, jgrd   ! dummy loop indices 
     304      INTEGER  ::   jb, jgrd           ! dummy loop indices 
    338305      INTEGER  ::   ji, jj             ! local scalar 
    339       INTEGER  ::   ib_bdy ! Loop index 
    340       REAL(wp) ::   zmsk1, zmsk2, zflag, zinda  
     306      INTEGER  ::   ib_bdy             ! Loop index 
     307      REAL(wp) ::   zmsk1, zmsk2, zflag 
    341308     !!------------------------------------------------------------------------------ 
    342309      ! 
     
    353320         CASE('frs') 
    354321             
    355  
     322            IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions  
     323                                                               !      do not change ice velocity (it is only computed by rheology) 
     324  
    356325            SELECT CASE ( cd_type ) 
    357  
     326                
    358327            CASE ( 'U' ) 
    359328                
     
    370339                      
    371340                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 
    372                      u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5 * ABS( zflag + 1._wp ) * zmsk1 + & 
    373                         &            u_ice(ji-1,jj) * 0.5 * ABS( zflag - 1._wp ) * zmsk2 + & 
     341                     u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 
     342                        &            u_ice(ji-1,jj) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + & 
    374343                        &            u_oce(ji  ,jj) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) ) 
    375344                  ELSE                             ! everywhere else 
     
    378347                  ENDIF 
    379348                  ! mask ice velocities 
    380                   zinda = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ji,jj) + 0.01 ) ) ! 0 if no ice 
    381                   u_ice(ji,jj) = zinda * u_ice(ji,jj) 
     349                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice 
     350                  u_ice(ji,jj) = rswitch * u_ice(ji,jj) 
    382351                   
    383352               ENDDO 
    384  
     353                
    385354               CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy ) 
    386355                
     
    399368                      
    400369                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 
    401                      v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5 * ABS( zflag + 1._wp ) * zmsk1 + & 
    402                         &            v_ice(ji,jj-1) * 0.5 * ABS( zflag - 1._wp ) * zmsk2 + & 
     370                     v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 
     371                        &            v_ice(ji,jj-1) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + & 
    403372                        &            v_oce(ji,jj  ) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) ) 
    404373                  ELSE                             ! everywhere else 
     
    407376                  ENDIF 
    408377                  ! mask ice velocities 
    409                   zinda = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ji,jj) + 0.01 ) ) ! 0 if no ice 
    410                   v_ice(ji,jj) = zinda * v_ice(ji,jj) 
     378                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice 
     379                  v_ice(ji,jj) = rswitch * v_ice(ji,jj) 
    411380                   
    412381               ENDDO 
    413382                
    414383               CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy ) 
    415                 
     384                   
    416385            END SELECT 
    417386             
Note: See TracChangeset for help on using the changeset viewer.