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 4899 for branches/2014/dev_r4743_NOC2_ZTS/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90 – NEMO

Ignore:
Timestamp:
2014-11-27T16:21:44+01:00 (9 years ago)
Author:
acc
Message:

Branch 2014/dev_r4743_NOC2_ZTS. Merged in trunk changes from r4743 to r4879 in preparation for the annual merge. See ticket #1367 and https://forge.ipsl.jussieu.fr/nemo/wiki/ticket/1367_NOC2_ZTS

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4743_NOC2_ZTS/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    r4688 r4899  
    6767      !! 
    6868      !!--------------------------------------------------------------------- 
    69       INTEGER  ::   ji, jj, jk, jl, jm    ! dummy loop indices 
    70       INTEGER  ::   jbnd1, jbnd2 
     69      INTEGER  ::   ji, jj, jk, jl    ! dummy loop indices 
    7170      INTEGER  ::   i_ice_switch 
    7271      REAL(wp) ::   zh, zsal 
     
    8988      ! Rebin categories with thickness out of bounds 
    9089      !---------------------------------------------------- 
    91       DO jm = 1, jpm 
    92          jbnd1 = ice_cat_bounds(jm,1) 
    93          jbnd2 = ice_cat_bounds(jm,2) 
    94          IF (ice_ncat_types(jm) .GT. 1 )   CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 
    95       END DO 
     90      IF ( jpl > 1 )   CALL lim_itd_th_reb(1, jpl) 
    9691 
    9792      !---------------------------------------------------------------------- 
    9893      ! Constrain the thickness of the smallest category above hiclim 
    9994      !---------------------------------------------------------------------- 
    100       DO jm = 1, jpm 
    101          DO jj = 1, jpj  
    102             DO ji = 1, jpi 
    103                jl = ice_cat_bounds(jm,1) 
    104                IF( v_i(ji,jj,jl) > 0._wp .AND. ht_i(ji,jj,jl) < hiclim ) THEN 
    105                   zh             = hiclim / ht_i(ji,jj,jl) 
    106                   ht_s(ji,jj,jl) = ht_s(ji,jj,jl) * zh 
    107                   ht_i(ji,jj,jl) = ht_i(ji,jj,jl) * zh 
    108                   a_i (ji,jj,jl) = a_i(ji,jj,jl)  / zh 
    109                ENDIF 
    110             END DO !ji 
    111          END DO !jj 
    112       END DO !jm 
     95      DO jj = 1, jpj  
     96         DO ji = 1, jpi 
     97            IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < hiclim ) THEN 
     98               zh             = hiclim / ht_i(ji,jj,1) 
     99               ht_s(ji,jj,1) = ht_s(ji,jj,1) * zh 
     100               ht_i(ji,jj,1) = ht_i(ji,jj,1) * zh 
     101               a_i (ji,jj,1) = a_i(ji,jj,1)  / zh 
     102            ENDIF 
     103         END DO 
     104      END DO 
    113105       
    114106      !----------------------------------------------------- 
     
    139131      ! Final thickness distribution rebinning 
    140132      ! -------------------------------------- 
    141       DO jm = 1, jpm 
    142          jbnd1 = ice_cat_bounds(jm,1) 
    143          jbnd2 = ice_cat_bounds(jm,2) 
    144          IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 
    145          IF (ice_ncat_types(jm) .EQ. 1 ) THEN 
    146          ENDIF 
    147       END DO 
     133      IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl ) 
    148134 
    149135      !----------------- 
     
    196182      ! Diagnostics 
    197183      ! ------------------------------------------------- 
    198       d_a_i_thd(:,:,:)   = a_i(:,:,:)   - old_a_i(:,:,:)  
    199       d_v_s_thd(:,:,:)   = v_s(:,:,:)   - old_v_s(:,:,:) 
    200       d_v_i_thd(:,:,:)   = v_i(:,:,:)   - old_v_i(:,:,:)   
    201       d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:)  
    202       d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - old_e_i(:,:,1:nlay_i,:) 
    203       !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - old_oa_i (:,:,:) 
     184      d_a_i_thd(:,:,:)   = a_i(:,:,:)   - a_i_b(:,:,:)  
     185      d_v_s_thd(:,:,:)   = v_s(:,:,:)   - v_s_b(:,:,:) 
     186      d_v_i_thd(:,:,:)   = v_i(:,:,:)   - v_i_b(:,:,:)   
     187      d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - e_s_b(:,:,:,:)  
     188      d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:) 
     189      !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - oa_i_b (:,:,:) 
    204190      d_smv_i_thd(:,:,:) = 0._wp 
    205       IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 
     191      IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:) 
    206192      ! diag only (clem) 
    207193      dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
     
    211197         DO ji = 1, jpi             
    212198            diag_heat_dhc(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) +  &  
    213                &                     SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) ) ) * unit_fac * r1_rdtice / area(ji,jj)    
     199               &                     SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) )    & 
     200               &                   ) * unit_fac * r1_rdtice / area(ji,jj)    
    214201         END DO 
    215202      END DO 
     
    228215         CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update2  : strength    :') 
    229216         CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update2  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :') 
    230          CALL prt_ctl(tab2d_1=old_u_ice  , clinfo1=' lim_update2  : old_u_ice   :', tab2d_2=old_v_ice  , clinfo2=' old_v_ice   :') 
     217         CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update2  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :') 
    231218 
    232219         DO jl = 1, jpl 
     
    241228            CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' lim_update2  : o_i         : ') 
    242229            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update2  : a_i         : ') 
    243             CALL prt_ctl(tab2d_1=old_a_i    (:,:,jl)        , clinfo1= ' lim_update2  : old_a_i     : ') 
     230            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : a_i_b       : ') 
    244231            CALL prt_ctl(tab2d_1=d_a_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_a_i_thd   : ') 
    245232            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update2  : v_i         : ') 
    246             CALL prt_ctl(tab2d_1=old_v_i    (:,:,jl)        , clinfo1= ' lim_update2  : old_v_i     : ') 
     233            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_i_b       : ') 
    247234            CALL prt_ctl(tab2d_1=d_v_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_i_thd   : ') 
    248235            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update2  : v_s         : ') 
    249             CALL prt_ctl(tab2d_1=old_v_s    (:,:,jl)        , clinfo1= ' lim_update2  : old_v_s     : ') 
     236            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_s_b       : ') 
    250237            CALL prt_ctl(tab2d_1=d_v_s_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_s_thd   : ') 
    251238            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1        : ') 
    252             CALL prt_ctl(tab2d_1=old_e_i    (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : old_e_i1    : ') 
     239            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1_b      : ') 
    253240            CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : de_i1_thd   : ') 
    254241            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2        : ') 
    255             CALL prt_ctl(tab2d_1=old_e_i    (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : old_e_i2    : ') 
     242            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2_b      : ') 
    256243            CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : de_i2_thd   : ') 
    257244            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow      : ') 
    258             CALL prt_ctl(tab2d_1=old_e_s    (:,:,1,jl)      , clinfo1= ' lim_update2  : old_e_snow  : ') 
     245            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow_b    : ') 
    259246            CALL prt_ctl(tab2d_1=d_e_s_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : d_e_s_thd   : ') 
    260247            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update2  : smv_i       : ') 
    261             CALL prt_ctl(tab2d_1=old_smv_i  (:,:,jl)        , clinfo1= ' lim_update2  : old_smv_i   : ') 
     248            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update2  : smv_i_b     : ') 
    262249            CALL prt_ctl(tab2d_1=d_smv_i_thd(:,:,jl)        , clinfo1= ' lim_update2  : d_smv_i_thd : ') 
    263250            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update2  : oa_i        : ') 
    264             CALL prt_ctl(tab2d_1=old_oa_i   (:,:,jl)        , clinfo1= ' lim_update2  : old_oa_i    : ') 
     251            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update2  : oa_i_b      : ') 
    265252            CALL prt_ctl(tab2d_1=d_oa_i_thd (:,:,jl)        , clinfo1= ' lim_update2  : d_oa_i_thd  : ') 
    266253 
Note: See TracChangeset for help on using the changeset viewer.