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 5208 for branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90 – NEMO

Ignore:
Timestamp:
2015-04-13T15:08:59+02:00 (9 years ago)
Author:
davestorkey
Message:

Merge in changes from trunk up to 5021.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r4688 r5208  
    6666   PUBLIC   lim_var_salprof1d    ! 
    6767 
    68    REAL(wp) ::   epsi10 = 1.e-10_wp   !    -       - 
    69  
    7068   !!---------------------------------------------------------------------- 
    7169   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     
    9290      ! 
    9391      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    94       REAL(wp) ::   zinda, zindb 
    9592      !!------------------------------------------------------------------ 
    9693 
     
    111108               at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
    112109               ! 
    113                zinda = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
    114                icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda  ! ice thickness 
     110               rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
     111               icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch  ! ice thickness 
    115112            END DO 
    116113         END DO 
     
    132129            DO jj = 1, jpj 
    133130               DO ji = 1, jpi 
    134                   zinda = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )  
    135                   zindb = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
    136131                  et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                       ! snow heat content 
    137                   smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * zinda   ! ice salinity 
    138                   ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi10 ) * zindb   ! ice age 
     132                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )  
     133                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * rswitch   ! ice salinity 
     134                  rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
     135                  ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi10 ) * rswitch   ! ice age 
    139136               END DO 
    140137            END DO 
     
    161158      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    162159      REAL(wp) ::   zq_i, zaaa, zbbb, zccc, zdiscrim     ! local scalars 
    163       REAL(wp) ::   ztmelts, zindb, zq_s, zfac1, zfac2   !   -      - 
     160      REAL(wp) ::   ztmelts, zq_s, zfac1, zfac2   !   -      - 
    164161      !!------------------------------------------------------------------ 
    165162 
     
    170167         DO jj = 1, jpj 
    171168            DO ji = 1, jpi 
    172                zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
    173                ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
    174                ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
    175                o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
     169               rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
     170               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch 
     171               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch 
     172               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch 
    176173            END DO 
    177174         END DO 
     
    182179            DO jj = 1, jpj 
    183180               DO ji = 1, jpi 
    184                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
    185                   sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * zindb 
     181                  rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
     182                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * rswitch 
    186183               END DO 
    187184            END DO 
     
    203200               DO ji = 1, jpi 
    204201                  !                                                              ! Energy of melting q(S,T) [J.m-3] 
    205                   zindb   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) )     ! zindb = 0 if no ice and 1 if yes 
    206                   zq_i    = zindb * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)  
     202                  rswitch   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) )     ! rswitch = 0 if no ice and 1 if yes 
     203                  zq_i    = rswitch * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)  
    207204                  zq_i    = zq_i * unit_fac                             !convert units 
    208205                  ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt                       ! Ice layer melt temperature 
     
    212209                  zccc       =  lfus * (ztmelts-rtt) 
    213210                  zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) ) 
    214                   t_i(ji,jj,jk,jl) = rtt + zindb *( - zbbb - zdiscrim ) / ( 2.0 *zaaa ) 
     211                  t_i(ji,jj,jk,jl) = rtt + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa ) 
    215212                  t_i(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) )       ! 100-rtt < t_i < rtt 
    216213               END DO 
     
    229226               DO ji = 1, jpi 
    230227                  !Energy of melting q(S,T) [J.m-3] 
    231                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) )     ! zindb = 0 if no ice and 1 if yes 
    232                   zq_s  = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp) 
     228                  rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) )     ! rswitch = 0 if no ice and 1 if yes 
     229                  zq_s  = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp) 
    233230                  zq_s  = zq_s * unit_fac                                    ! convert units 
    234231                  ! 
    235                   t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 ) 
     232                  t_s(ji,jj,jk,jl) = rtt + rswitch * ( - zfac1 * zq_s + zfac2 ) 
    236233                  t_s(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15, t_s(ji,jj,jk,jl) ) )     ! 100-rtt < t_i < rtt 
    237234               END DO 
     
    248245            DO jj = 1, jpj 
    249246               DO ji = 1, jpi 
    250                   zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    251                   tm_i(ji,jj) = tm_i(ji,jj) + zindb * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
     247                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
     248                  tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
    252249                     &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  ) 
    253250               END DO 
     
    295292      INTEGER  ::   ji, jj, jk, jl   ! dummy loop index 
    296293      REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac, zsal      ! local scalar 
    297       REAL(wp) ::   zind0, zind01, zindbal, zargtemp , zs_zero   !   -      - 
     294      REAL(wp) ::   zswi0, zswi01, zswibal, zargtemp , zs_zero   !   -      - 
    298295      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha   ! 3D pointer 
    299296      !!------------------------------------------------------------------ 
     
    330327            DO jj = 1, jpj 
    331328               DO ji = 1, jpi 
    332                   ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise 
    333                   zind0  = MAX( 0._wp   , SIGN( 1._wp  , s_i_0 - sm_i(ji,jj,jl) ) )  
    334                   ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
    335                   zind01 = ( 1._wp - zind0 ) * MAX( 0._wp   , SIGN( 1._wp  , s_i_1 - sm_i(ji,jj,jl) ) )  
    336                   ! If 2.sm_i GE sss_m then zindbal = 1 
     329                  ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise 
     330                  zswi0  = MAX( 0._wp   , SIGN( 1._wp  , s_i_0 - sm_i(ji,jj,jl) ) )  
     331                  ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
     332                  zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp   , SIGN( 1._wp  , s_i_1 - sm_i(ji,jj,jl) ) )  
     333                  ! If 2.sm_i GE sss_m then zswibal = 1 
    337334                  ! this is to force a constant salinity profile in the Baltic Sea 
    338                   zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 
    339                   zalpha(ji,jj,jl) = zind0  + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 ) 
    340                   zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zindbal ) 
     335                  zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 
     336                  zalpha(ji,jj,jl) = zswi0  + zswi01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 ) 
     337                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zswibal ) 
    341338               END DO 
    342339            END DO 
     
    390387      !!------------------------------------------------------------------ 
    391388      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    392       REAL(wp) ::   zindb   !   -      - 
    393389      !!------------------------------------------------------------------ 
    394390 
     
    399395            DO jj = 1, jpj 
    400396               DO ji = 1, jpi 
    401                   zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    402                   tm_i(ji,jj) = tm_i(ji,jj) + zindb * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
     397                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
     398                  tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
    403399                     &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  ) 
    404400               END DO 
     
    421417      !!------------------------------------------------------------------ 
    422418      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    423       REAL(wp) ::   zbvi, zinda, zindb      ! local scalars 
     419      REAL(wp) ::   zbvi             ! local scalars 
    424420      !!------------------------------------------------------------------ 
    425421      ! 
     
    429425            DO jj = 1, jpj 
    430426               DO ji = 1, jpi 
    431                   zinda = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi10 ) )  ) 
    432                   zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    433                   zbvi  = - zinda * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi10 )   & 
     427                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi10 ) )  ) 
     428                  zbvi  = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi10 )   & 
    434429                     &                   * v_i(ji,jj,jl)    / REAL(nlay_i,wp) 
    435                   bv_i(ji,jj) = bv_i(ji,jj) + zindb * zbvi  / MAX( vt_i(ji,jj) , epsi10 ) 
     430                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
     431                  bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi  / MAX( vt_i(ji,jj) , epsi10 ) 
    436432               END DO 
    437433            END DO 
     
    454450      INTEGER  ::   ii, ij  ! local integers 
    455451      REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal   ! local scalars 
    456       REAL(wp) ::   zalpha, zind0, zind01, zindbal, zs_zero              !   -      - 
     452      REAL(wp) ::   zalpha, zswi0, zswi01, zswibal, zs_zero              !   -      - 
    457453      ! 
    458454      REAL(wp), POINTER, DIMENSION(:) ::   z_slope_s 
     
    464460      ! Vertically constant, constant in time 
    465461      !--------------------------------------- 
    466       IF( num_sal == 1 )   s_i_b(:,:) = bulk_sal 
     462      IF( num_sal == 1 )   s_i_1d(:,:) = bulk_sal 
    467463 
    468464      !------------------------------------------------------ 
     
    473469         ! 
    474470         DO ji = kideb, kiut          ! Slope of the linear profile zs_zero 
    475             z_slope_s(ji) = 2._wp * sm_i_b(ji) / MAX( epsi10 , ht_i_b(ji) ) 
     471            z_slope_s(ji) = 2._wp * sm_i_1d(ji) / MAX( epsi10 , ht_i_1d(ji) ) 
    476472         END DO 
    477473 
     
    488484               ii =  MOD( npb(ji) - 1 , jpi ) + 1 
    489485               ij =     ( npb(ji) - 1 ) / jpi + 1 
    490                ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise 
    491                zind0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_b(ji) ) )  
    492                ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
    493                zind01 = ( 1._wp - zind0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_b(ji) ) )  
    494                ! if 2.sm_i GE sss_m then zindbal = 1 
     486               ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise 
     487               zswi0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_1d(ji) ) )  
     488               ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
     489               zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_1d(ji) ) )  
     490               ! if 2.sm_i GE sss_m then zswibal = 1 
    495491               ! this is to force a constant salinity profile in the Baltic Sea 
    496                zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_b(ji) - sss_m(ii,ij) ) ) 
     492               zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) ) 
    497493               ! 
    498                zalpha = (  zind0 + zind01 * ( sm_i_b(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zindbal ) 
     494               zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zswibal ) 
    499495               ! 
    500                zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_b(ji) * dummy_fac2 
     496               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * dummy_fac2 
    501497               ! weighting the profile 
    502                s_i_b(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_b(ji) 
     498               s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji) 
    503499            END DO ! ji 
    504500         END DO ! jk 
     
    512508      IF( num_sal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
    513509         ! 
    514          sm_i_b(:) = 2.30_wp 
     510         sm_i_1d(:) = 2.30_wp 
    515511         ! 
    516512!CDIR NOVERRCHK 
     
    519515            zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  ) 
    520516            DO ji = kideb, kiut 
    521                s_i_b(ji,jk) = zsal 
     517               s_i_1d(ji,jk) = zsal 
    522518            END DO 
    523519         END DO 
Note: See TracChangeset for help on using the changeset viewer.