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 5078 for branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90 – NEMO

Ignore:
Timestamp:
2015-02-11T16:15:11+01:00 (9 years ago)
Author:
clem
Message:

LIM3: cosmetic changes to increase readability and performance

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r5067 r5078  
    196196                  ! 
    197197                  zaaa       =  cpic                  ! Conversion q(S,T) -> T (second order equation) 
    198                   zbbb       =  ( rcp - cpic ) * ( ztmelts - rtt ) + zq_i / rhoic - lfus 
     198                  zbbb       =  ( rcp - cpic ) * ( ztmelts - rtt ) + zq_i * r1_rhoic - lfus 
    199199                  zccc       =  lfus * (ztmelts-rtt) 
    200200                  zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) ) 
     
    280280      !!------------------------------------------------------------------ 
    281281      INTEGER  ::   ji, jj, jk, jl   ! dummy loop index 
    282       REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac, zsal 
    283       REAL(wp) ::   zswi0, zswi01, zswibal, zargtemp , zs_zero    
     282      REAL(wp) ::   zfac0, zfac1, zsal 
     283      REAL(wp) ::   zswi0, zswi01, zargtemp , zs_zero    
    284284      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha 
    285285      REAL(wp), PARAMETER :: zsi0 = 3.5_wp 
     
    311311         END DO 
    312312         ! 
    313          dummy_fac0 = 1._wp / ( zsi0 - zsi1 )       ! Weighting factor between zs_zero and zs_inf 
    314          dummy_fac1 = zsi1 / ( zsi1 - zsi0 ) 
     313         zfac0 = 1._wp / ( zsi0 - zsi1 )       ! Weighting factor between zs_zero and zs_inf 
     314         zfac1 = zsi1 / ( zsi1 - zsi0 ) 
    315315         ! 
    316316         zalpha(:,:,:) = 0._wp 
     
    322322                  ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws  
    323323                  zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp   , SIGN( 1._wp  , zsi1 - sm_i(ji,jj,jl) ) )  
    324                   ! If 2.sm_i GE sss_m then zswibal = 1 
     324                  ! If 2.sm_i GE sss_m then rswitch = 1 
    325325                  ! this is to force a constant salinity profile in the Baltic Sea 
    326                   zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 
    327                   zalpha(ji,jj,jl) = zswi0  + zswi01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 ) 
    328                   zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zswibal ) 
    329                END DO 
    330             END DO 
    331          END DO 
    332  
    333          dummy_fac = 1._wp / REAL( nlay_i )                   ! Computation of the profile 
     326                  rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 
     327                  zalpha(ji,jj,jl) = zswi0  + zswi01 * ( sm_i(ji,jj,jl) * zfac0 + zfac1 ) 
     328                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - rswitch ) 
     329               END DO 
     330            END DO 
     331         END DO 
     332 
     333         ! Computation of the profile 
    334334         DO jl = 1, jpl 
    335335            DO jk = 1, nlay_i 
     
    337337                  DO ji = 1, jpi 
    338338                     !                                      ! linear profile with 0 at the surface 
    339                      zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * dummy_fac 
     339                     zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * r1_nlay_i 
    340340                     !                                      ! weighting the profile 
    341341                     s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl) 
     
    357357         DO jl = 1, jpl 
    358358            DO jk = 1, nlay_i 
    359                zargtemp  = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp) 
     359               zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 
    360360               zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  ) 
    361361               s_i(:,:,jk,jl) =  zsal 
     
    387387                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    388388                  tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
    389                      &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 ) ) 
     389                     &                      * r1_nlay_i / MAX( vt_i(ji,jj) , epsi10 ) 
    390390               END DO 
    391391            END DO 
     
    417417                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi10 ) )  ) 
    418418                  zbvi  = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi10 )   & 
    419                      &                   * v_i(ji,jj,jl)    / REAL(nlay_i,wp) 
     419                     &                   * v_i(ji,jj,jl) * r1_nlay_i 
    420420                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
    421421                  bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi  / MAX( vt_i(ji,jj) , epsi10 ) 
     
    439439      INTEGER  ::   ji, jk    ! dummy loop indices 
    440440      INTEGER  ::   ii, ij    ! local integers 
    441       REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal   ! local scalars 
    442       REAL(wp) ::   zalpha, zswi0, zswi01, zswibal, zs_zero              !   -      - 
     441      REAL(wp) ::   zfac0, zfac1, zargtemp, zsal   ! local scalars 
     442      REAL(wp) ::   zalpha, zswi0, zswi01, zs_zero              !   -      - 
    443443      ! 
    444444      REAL(wp), POINTER, DIMENSION(:) ::   z_slope_s 
     
    466466         ! Weighting factor between zs_zero and zs_inf 
    467467         !--------------------------------------------- 
    468          dummy_fac0 = 1._wp / ( zsi0 - zsi1 ) 
    469          dummy_fac1 = zsi1 / ( zsi1 - zsi0 ) 
    470          dummy_fac2 = 1._wp / REAL(nlay_i,wp) 
    471  
     468         zfac0 = 1._wp / ( zsi0 - zsi1 ) 
     469         zfac1 = zsi1 / ( zsi1 - zsi0 ) 
    472470         DO jk = 1, nlay_i 
    473471            DO ji = kideb, kiut 
     
    478476               ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws  
    479477               zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , zsi1 - sm_i_1d(ji) ) )  
    480                ! if 2.sm_i GE sss_m then zswibal = 1 
     478               ! if 2.sm_i GE sss_m then rswitch = 1 
    481479               ! this is to force a constant salinity profile in the Baltic Sea 
    482                zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) ) 
     480               rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) ) 
    483481               ! 
    484                zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zswibal ) 
     482               zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * zfac0 + zfac1 )  ) * ( 1.0 - rswitch ) 
    485483               ! 
    486                zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * dummy_fac2 
     484               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * r1_nlay_i 
    487485               ! weighting the profile 
    488486               s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji) 
     
    501499         ! 
    502500         DO jk = 1, nlay_i 
    503             zargtemp  = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp) 
     501            zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 
    504502            zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  ) 
    505503            DO ji = kideb, kiut 
     
    734732               ! recompute ht_i, ht_s avoiding out of bounds values 
    735733               zht_i(ji,jl) = MIN( hi_max(jl), zht_i(ji,jl) + zdh ) 
    736                zht_s(ji,jl) = MAX( 0._wp, zht_s(ji,jl) - zdh * rhoic / rhosn ) 
     734               zht_s(ji,jl) = MAX( 0._wp, zht_s(ji,jl) - zdh * rhoic * r1_rhosn ) 
    737735            ENDIF 
    738736         ENDDO 
Note: See TracChangeset for help on using the changeset viewer.