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 8486 for branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icerdgrft.F90 – NEMO

Ignore:
Timestamp:
2017-09-01T15:49:35+02:00 (7 years ago)
Author:
clem
Message:

changes in style - part1 - (now the code looks better txs to Gurvan's comments)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icerdgrft.F90

    r8426 r8486  
    1212   !!   'key_lim3'                                      LIM-3 sea-ice model 
    1313   !!---------------------------------------------------------------------- 
    14    USE par_oce          ! ocean parameters 
    15    USE dom_oce          ! ocean domain 
    16    USE phycst           ! physical constants (ocean directory)  
    17    USE sbc_oce, ONLY: sss_m, sst_m          ! surface boundary condition: ocean fields 
    18    USE ice1D            ! LIM thermodynamics 
    19    USE ice              ! LIM variables 
    20    USE icevar           ! LIM 
    21    USE icectl           ! control prints 
     14   USE par_oce        ! ocean parameters 
     15   USE dom_oce        ! ocean domain 
     16   USE phycst         ! physical constants (ocean directory)  
     17   USE sbc_oce , ONLY : sss_m, sst_m   ! surface boundary condition: ocean fields 
     18   USE ice1D          ! sea-ice: thermodynamics 
     19   USE ice            ! sea-ice: variables 
     20   USE icevar         ! sea-ice: operations 
     21   USE icectl         ! sea-ice: control prints 
    2222   ! 
    23    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    24    USE lib_mpp          ! MPP library 
    25    USE in_out_manager   ! I/O manager 
    26    USE iom              ! I/O manager 
    27    USE lib_fortran      ! glob_sum 
    28    USE timing           ! Timing 
     23   USE lbclnk         ! lateral boundary condition - MPP exchanges 
     24   USE lib_mpp        ! MPP library 
     25   USE in_out_manager ! I/O manager 
     26   USE iom            ! I/O manager 
     27   USE lib_fortran    ! glob_sum 
     28   USE timing         ! Timing 
    2929 
    3030   IMPLICIT NONE 
     
    3232 
    3333   PUBLIC   ice_rdgrft               ! called by ice_stp 
    34    PUBLIC   ice_rdgrft_icestrength 
    35    PUBLIC   ice_rdgrft_init 
    36    PUBLIC   ice_rdgrft_alloc        ! called by ice_init  
     34   PUBLIC   ice_rdgrft_icestrength   ! called by icerhg_evp 
     35   PUBLIC   ice_rdgrft_init          ! called by ice_stp 
     36   PUBLIC   ice_rdgrft_alloc         ! called by ice_init  
    3737 
    3838   !----------------------------------------------------------------------- 
     
    5252   REAL(wp), PARAMETER ::   kraft   = 0.5_wp    ! rafting multipliyer 
    5353 
    54    REAL(wp) ::   Cp                             !  
     54!!gm Cp is  1) not DOCTOR,  
     55!!          2) misleading name: heat capacity instead of a constant, 
     56!!          3) recomputed at each time-step, whereas it is stored in the module memory... 
     57!!             ===>>> compute it one for all inside the IF( kt == nit000 ) (i.e. without the ".AND. lwp") 
     58   REAL(wp)            ::   Cp                  ! ??? !!gm  Not doctor !  
     59    
    5560   ! 
    5661   ! 
    5762   !!---------------------------------------------------------------------- 
    58    !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010) 
     63   !! NEMO/ICE 4.0 , NEMO Consortium (2017) 
    5964   !! $Id: icerdgrft.F90 8378 2017-07-26 13:55:59Z clem $ 
    6065   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    6671      !!                ***  ROUTINE ice_rdgrft_alloc *** 
    6772      !!---------------------------------------------------------------------! 
    68       ALLOCATE(                                                                      & 
    69          !* Variables shared among ridging subroutines 
    70          &      asum (jpi,jpj)     , athorn(jpi,jpj,0:jpl) , aksum (jpi,jpj)     ,   & 
    71          &      hrmin(jpi,jpj,jpl) , hraft(jpi,jpj,jpl)    , aridge(jpi,jpj,jpl) ,   & 
    72          &      hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl)    , araft (jpi,jpj,jpl) , STAT=ice_rdgrft_alloc ) 
     73      ALLOCATE( asum (jpi,jpj)     , athorn(jpi,jpj,0:jpl) , aksum (jpi,jpj)     ,     & 
     74         &      hrmin(jpi,jpj,jpl) , hraft (jpi,jpj,jpl)   , aridge(jpi,jpj,jpl) ,     & 
     75         &      hrmax(jpi,jpj,jpl) , krdg  (jpi,jpj,jpl)   , araft (jpi,jpj,jpl) , STAT=ice_rdgrft_alloc ) 
    7376         ! 
    7477      IF( ice_rdgrft_alloc /= 0 )   CALL ctl_warn( 'ice_rdgrft_alloc: failed to allocate arrays' ) 
     
    105108      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    106109      !! 
    107       INTEGER  ::   ji, jj, jk, jl        ! dummy loop index 
    108       INTEGER  ::   niter                 ! local integer  
    109       INTEGER  ::   iterate_ridging       ! if true, repeat the ridging 
    110       REAL(wp) ::   za, zfac              ! local scalar 
     110      INTEGER  ::   ji, jj, jk, jl     ! dummy loop index 
     111      INTEGER  ::   niter              ! local integer  
     112      INTEGER  ::   iterate_ridging    ! if =1, repeat the ridging 
     113      REAL(wp) ::   za, zfac, zcs_2    ! local scalar 
    111114      CHARACTER (len = 15) ::   fieldid 
    112       REAL(wp), DIMENSION(jpi,jpj)   ::   closing_net     ! net rate at which area is removed    (1/s) 
    113                                                                ! (ridging ice area - area of new ridges) / dt 
    114       REAL(wp), DIMENSION(jpi,jpj)   ::   divu_adv        ! divu as implied by transport scheme  (1/s) 
    115       REAL(wp), DIMENSION(jpi,jpj)   ::   opning          ! rate of opening due to divergence/shear 
    116       REAL(wp), DIMENSION(jpi,jpj)   ::   closing_gross   ! rate at which area removed, not counting area of new ridges 
     115      REAL(wp), DIMENSION(jpi,jpj) ::   closing_net     ! net rate at which area is removed    (1/s) 
     116      !                                                 ! (ridging ice area - area of new ridges) / dt 
     117      REAL(wp), DIMENSION(jpi,jpj) ::   divu_adv        ! divu as implied by transport scheme  (1/s) 
     118      REAL(wp), DIMENSION(jpi,jpj) ::   opning          ! rate of opening due to divergence/shear 
     119      REAL(wp), DIMENSION(jpi,jpj) ::   closing_gross   ! rate at which area removed, not counting area of new ridges 
    117120      ! 
    118121      INTEGER, PARAMETER ::   nitermax = 20     
     
    124127      IF( kt == nit000 .AND. lwp ) THEN 
    125128         WRITE(numout,*) 
    126          WRITE(numout,*)'icerdgrft' 
    127          WRITE(numout,*)'~~~~~~~~~' 
     129         WRITE(numout,*)'icerdgrft : ice ridging and rafting' 
     130         WRITE(numout,*)'~~~~~~~~~~' 
    128131      ENDIF 
    129  
    130       ! conservation test 
    131       IF( ln_limdiachk ) CALL ice_cons_hsm(0, 'icerdgrft', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     132!!gm should be:       
     133!      IF( kt == nit000 ) THEN 
     134!         IF(lwp) WRITE(numout,*) 
     135!         IF(lwp) WRITE(numout,*)'icerdgrft : ???' 
     136!         IF(lwp) WRITE(numout,*)'~~~~~~~~~~' 
     137!         ! 
     138!         Cp    = 0.5 * grav * (rau0-rhoic) * rhoic * r1_rau0      ! proport const for PE 
     139!         ! 
     140!!gm why not adding here zcs_2 computation 
     141!         ! 
     142!      ENDIF 
     143!!gm end 
     144       
     145      !                    ! conservation test 
     146      IF( ln_limdiachk )   CALL ice_cons_hsm(0, 'icerdgrft', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    132147 
    133148      !-----------------------------------------------------------------------------! 
    134149      ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons 
    135150      !-----------------------------------------------------------------------------! 
    136       Cp = 0.5 * grav * (rau0-rhoic) * rhoic * r1_rau0             ! proport const for PE 
    137       ! 
    138       CALL ice_rdgrft_ridgeprep                                    ! prepare ridging 
    139       ! 
    140  
    141       DO jj = 1, jpj                                     ! Initialize arrays. 
     151      Cp    = 0.5 * grav * (rau0-rhoic) * rhoic * r1_rau0      ! proport const for PE 
     152      zcs_2 = rn_cs * 0.5_wp 
     153      ! 
     154      CALL ice_rdgrft_ridgeprep                             ! prepare ridging 
     155      ! 
     156      DO jj = 1, jpj                                        ! Initialize arrays. 
    142157         DO ji = 1, jpi 
    143  
    144158            !-----------------------------------------------------------------------------! 
    145159            ! 2) Dynamical inputs (closing rate, divu_adv, opning) 
     
    161175            !  (thick, newly ridged ice). 
    162176 
    163             closing_net(ji,jj) = rn_cs * 0.5 * ( delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp ) 
     177            closing_net(ji,jj) = zcs_2 * ( delta_i(ji,jj) - ABS( divu_i(ji,jj) ) ) - MIN( divu_i(ji,jj), 0._wp ) 
    164178 
    165179            ! 2.2 divu_adv 
     
    233247         ! 3.3 Redistribute area, volume, and energy. 
    234248         !-----------------------------------------------------------------------------! 
    235  
    236249         CALL ice_rdgrft_ridgeshift( opning, closing_gross ) 
    237  
    238250          
    239251         ! 3.4 Compute total area of ice plus open water after ridging. 
     
    246258         ! Check whether asum = 1.  If not (because the closing and opening 
    247259         ! rates were reduced above), ridge again with new rates. 
    248  
    249260         iterate_ridging = 0 
    250261         DO jj = 1, jpj 
     
    262273            END DO 
    263274         END DO 
    264  
    265275         IF( lk_mpp )   CALL mpp_max( iterate_ridging ) 
    266276 
    267277         ! Repeat if necessary. 
    268278         ! NOTE: If strength smoothing is turned on, the ridging must be 
    269          ! iterated globally because of the boundary update in the  
    270          ! smoothing. 
    271  
     279         ! iterated globally because of the boundary update in the smoothing. 
    272280         niter = niter + 1 
    273  
     281         ! 
    274282         IF( iterate_ridging == 1 ) THEN 
    275283            CALL ice_rdgrft_ridgeprep 
     
    279287            ENDIF 
    280288         ENDIF 
    281  
     289         ! 
    282290      END DO !! on the do while over iter 
    283291 
     
    287295      ! control prints 
    288296      !-----------------------------------------------------------------------------! 
    289       ! conservation test 
    290       IF( ln_limdiachk ) CALL ice_cons_hsm(1, 'icerdgrft', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    291  
    292       ! control prints 
    293       IF( ln_ctl )       CALL ice_prt3D( 'icerdgrft' ) 
     297      !                    ! conservation test 
     298      IF( ln_limdiachk )   CALL ice_cons_hsm(1, 'icerdgrft', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     299 
     300      !                    ! control prints 
     301      IF( ln_ctl       )   CALL ice_prt3D( 'icerdgrft' ) 
    294302      ! 
    295303      IF( nn_timing == 1 )  CALL timing_stop('icerdgrft') 
     304      ! 
    296305   END SUBROUTINE ice_rdgrft 
     306 
    297307 
    298308   SUBROUTINE ice_rdgrft_ridgeprep 
     
    305315      !!              participating in ridging and of the resulting ridges. 
    306316      !!---------------------------------------------------------------------! 
    307       INTEGER  ::   ji,jj, jl    ! dummy loop indices 
    308       REAL(wp) ::   Gstari, astari, hrmean, zdummy   ! local scalar 
     317      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
     318      REAL(wp) ::   Gstari, astari, hrmean, zdummy   ! local scalar     !!gm DOCTOR norme should start with z !!!!! 
    309319      REAL(wp), DIMENSION(jpi,jpj,-1:jpl) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n 
    310320      !------------------------------------------------------------------------------! 
    311321 
    312       Gstari     = 1.0/rn_gstar     
    313       astari     = 1.0/rn_astar     
    314       aksum(:,:)    = 0.0 
    315       athorn(:,:,:) = 0.0 
    316       aridge(:,:,:) = 0.0 
    317       araft (:,:,:) = 0.0 
    318  
    319       ! Zero out categories with very small areas 
    320       CALL ice_var_zapsmall 
    321  
    322       ! Ice thickness needed for rafting 
    323       DO jl = 1, jpl 
    324          DO jj = 1, jpj 
    325             DO ji = 1, jpi 
    326                rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 
    327                ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
    328            END DO 
    329          END DO 
    330       END DO 
     322      Gstari        = 1._wp / rn_gstar     
     323      astari        = 1._wp / rn_astar     
     324      aksum(:,:)    = 0._wp 
     325      athorn(:,:,:) = 0._wp 
     326      aridge(:,:,:) = 0._wp 
     327      araft (:,:,:) = 0._wp 
     328 
     329      CALL ice_var_zapsmall   ! Zero out categories with very small areas 
     330 
     331!      DO jl = 1, jpl          ! Ice thickness needed for rafting 
     332!         DO jj = 1, jpj 
     333!            DO ji = 1, jpi 
     334!!gm               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 
     335!!gm               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 
     336!               IF( a_i(ji,jj,jl) >= epsi20 ) THEN   ;   ht_i(ji,jj,jl) = v_i (ji,jj,jl) / a_i(ji,jj,jl) 
     337!               ELSE                                 ;   ht_i(ji,jj,jl) = 0._wp 
     338!               ENDIF 
     339!           END DO 
     340!         END DO 
     341!      END DO 
     342!!gm or even better : 
     343!     !                       ! Ice thickness needed for rafting 
     344      WHERE( a_i(:,:,:) >= epsi20 )   ;   ht_i(:,:,:) = v_i (:,:,:) / a_i(:,:,:) 
     345      ELSEWHERE                       ;   ht_i(:,:,:) = 0._wp 
     346      END WHERE 
     347!!gm end 
    331348 
    332349      !------------------------------------------------------------------------------! 
    333350      ! 1) Participation function  
    334351      !------------------------------------------------------------------------------! 
    335  
     352      ! 
    336353      ! Compute total area of ice plus open water. 
    337354      ! This is in general not equal to one because of divergence during transport 
    338355      asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 
    339  
     356      ! 
    340357      ! Compute cumulative thickness distribution function 
    341358      ! Compute the cumulative thickness distribution function Gsum, 
     
    348365         Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl) 
    349366      END DO 
    350  
     367      ! 
    351368      ! Normalize the cumulative distribution to 1 
    352369      DO jl = 0, jpl 
     
    366383      ! athorn is always >= 0 and SUM(athorn(0:jpl))=1 
    367384      !----------------------------------------------------------------- 
    368  
     385      ! 
    369386      IF( nn_partfun == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
    370387         DO jl = 0, jpl     
     
    383400            END DO 
    384401         END DO 
    385  
     402         ! 
    386403      ELSE                             !--- Exponential, more stable formulation (Lipscomb et al, 2007) 
    387404         !                         
     
    396413      ENDIF 
    397414 
    398       ! --- Ridging and rafting participation concentrations --- ! 
    399       IF( ln_rafting .AND. ln_ridging ) THEN 
    400          ! 
     415      !                                !--- Ridging and rafting participation concentrations 
     416      IF( ln_rafting .AND. ln_ridging ) THEN             !- ridging & rafting 
    401417         DO jl = 1, jpl 
    402418            DO jj = 1, jpj  
     
    408424            END DO 
    409425         END DO 
    410          ! 
    411       ELSEIF( ln_ridging .AND. .NOT. ln_rafting ) THEN 
    412          ! 
     426      ELSEIF( ln_ridging .AND. .NOT.ln_rafting ) THEN   !- ridging alone 
    413427         DO jl = 1, jpl 
    414428            aridge(:,:,jl) = athorn(:,:,jl) 
    415429         END DO 
    416          ! 
    417       ELSEIF( ln_rafting .AND. .NOT. ln_ridging ) THEN 
    418          ! 
     430      ELSEIF( ln_rafting .AND. .NOT.ln_ridging ) THEN   !- rafting alone    
    419431         DO jl = 1, jpl 
    420432            araft(:,:,jl) = athorn(:,:,jl) 
    421433         END DO 
    422          ! 
    423434      ENDIF 
    424435 
     
    454465         DO jj = 1, jpj 
    455466            DO ji = 1, jpi 
    456                 
    457                IF( athorn(ji,jj,jl) > 0._wp ) THEN 
     467               IF ( athorn(ji,jj,jl) > 0._wp ) THEN 
    458468                  hrmean          = MAX( SQRT( rn_hstar * ht_i(ji,jj,jl) ), ht_i(ji,jj,jl) * krdgmin ) 
    459469                  hrmin(ji,jj,jl) = MIN( 2._wp * ht_i(ji,jj,jl), 0.5_wp * ( hrmean + ht_i(ji,jj,jl) ) ) 
    460470                  hrmax(ji,jj,jl) = 2._wp * hrmean - hrmin(ji,jj,jl) 
    461471                  hraft(ji,jj,jl) = ht_i(ji,jj,jl) / kraft 
    462                   krdg(ji,jj,jl) = ht_i(ji,jj,jl) / MAX( hrmean, epsi20 ) 
    463  
     472                  krdg (ji,jj,jl) = ht_i(ji,jj,jl) / MAX( hrmean, epsi20 ) 
     473                  ! 
    464474                  ! Normalization factor : aksum, ensures mass conservation 
    465475                  aksum(ji,jj) = aksum(ji,jj) + aridge(ji,jj,jl) * ( 1._wp - krdg(ji,jj,jl) )    & 
    466476                     &                        + araft (ji,jj,jl) * ( 1._wp - kraft          ) 
    467  
    468477               ELSE 
    469478                  hrmin(ji,jj,jl)  = 0._wp  
     
    472481                  krdg (ji,jj,jl)  = 1._wp 
    473482               ENDIF 
    474  
    475483            END DO 
    476484         END DO 
    477485      END DO 
    478       ! 
    479486      ! 
    480487   END SUBROUTINE ice_rdgrft_ridgeprep 
     
    493500      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   closing_gross  ! rate at which area removed, excluding area of new ridges 
    494501      ! 
    495       CHARACTER (len=80) ::   fieldid   ! field identifier 
     502      CHARACTER (len=80) ::   fieldid   ! field identifier     !!gm DOCTOR name wrong 
    496503      ! 
    497504      INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices 
     
    740747 
    741748               ! Compute the fraction of rafted ice area and volume going to thickness category jl2 
    742                IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN 
    743                   zswitch(ij) = 1._wp 
    744                ELSE 
    745                   zswitch(ij) = 0._wp                   
     749!!gm see above               IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN 
     750               IF( hi_max(jl2-1) < hraft(ji,jj,jl1) .AND. hraft(ji,jj,jl1) <= hi_max(jl2)  ) THEN   ;   zswitch(ij) = 1._wp 
     751               ELSE                                                                                 ;   zswitch(ij) = 0._wp                   
    746752               ENDIF 
    747  
     753               ! 
    748754               a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + ( ardg2 (ij) * farea    + arft2 (ij) * zswitch(ij) ) 
    749755               oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + ( oirdg2(ij) * farea    + oirft2(ij) * zswitch(ij) ) 
     
    756762               ! MV MP 2016 
    757763               IF ( nn_pnd_scheme > 0 ) THEN 
    758                   v_ip (ji,jj,jl2) = v_ip (ji,jj,jl2)  + ( vprdg (ij) * rn_fpondrdg * fvol(ij)  +   & 
    759                                                        &   vprft (ij) * rn_fpondrft * zswitch(ij) ) 
    760                   a_ip (ji,jj,jl2) = a_ip(ji,jj,jl2)   + ( aprdg2(ij) * rn_fpondrdg * farea +       &  
    761                                                        &   aprft2(ij) * rn_fpondrft * zswitch(ji) ) 
     764                  v_ip (ji,jj,jl2) = v_ip(ji,jj,jl2) + (   vprdg (ij) * rn_fpondrdg * fvol   (ij)   & 
     765                     &                                   + vprft (ij) * rn_fpondrft * zswitch(ij)  ) 
     766                  a_ip (ji,jj,jl2) = a_ip(ji,jj,jl2) + (   aprdg2(ij) * rn_fpondrdg * farea         &  
     767                     &                                   + aprft2(ij) * rn_fpondrft * zswitch(ji)  ) 
    762768               ENDIF 
    763769               ! END MV MP 2016 
    764  
    765770            END DO 
    766771 
     
    774779            ! 
    775780         END DO ! jl2 
    776           
     781         ! 
    777782      END DO ! jl1 (deforming categories) 
    778783 
     
    782787      ! 
    783788   END SUBROUTINE ice_rdgrft_ridgeshift 
     789 
    784790 
    785791   SUBROUTINE ice_rdgrft_icestrength( kstrngth ) 
     
    798804      !!---------------------------------------------------------------------- 
    799805      INTEGER, INTENT(in) ::   kstrngth    ! = 1 for Rothrock formulation, 0 for Hibler (1979) 
     806      ! 
    800807      INTEGER             ::   ji,jj, jl   ! dummy loop indices 
    801       INTEGER             ::   ksmooth     ! smoothing the resistance to deformation 
    802       INTEGER             ::   numts_rm    ! number of time steps for the P smoothing 
     808      INTEGER             ::   ksmooth     ! smoothing the resistance to deformation    !!gm not DOCTOR : start with i !!! 
     809      INTEGER             ::   numts_rm    ! number of time steps for the P smoothing    !!gm not DOCTOR : start with i !!! 
    803810      REAL(wp)            ::   zp, z1_3    ! local scalars 
    804811      REAL(wp), DIMENSION(jpi,jpj) ::   zworka           ! temporary array used here 
     
    880887      ! 6) Smoothing ice strength 
    881888      !------------------------------------------------------------------------------! 
    882       ! 
    883       !------------------- 
    884       ! Spatial smoothing 
    885       !------------------- 
    886       IF ( ksmooth == 1 ) THEN 
    887  
     889      SELECT CASE( ksmooth ) 
     890      !                       !------------------- 
     891      CASE( 1 )               ! Spatial smoothing 
     892         !                    !------------------- 
    888893         DO jj = 2, jpjm1 
    889894            DO ji = 2, jpim1 
     
    905910         END DO 
    906911         CALL lbc_lnk( strength, 'T', 1. ) 
    907  
    908       ENDIF 
    909  
    910       !-------------------- 
    911       ! Temporal smoothing 
    912       !-------------------- 
    913       IF ( ksmooth == 2 ) THEN 
    914  
     912         ! 
     913         !                    !-------------------- 
     914      CASE( 2 )               ! Temporal smoothing 
     915         !                    !-------------------- 
    915916         IF ( kt_ice == nit000 ) THEN 
    916917            zstrp1(:,:) = 0._wp 
    917918            zstrp2(:,:) = 0._wp 
    918919         ENDIF 
    919  
     920         ! 
    920921         DO jj = 2, jpjm1 
    921922            DO ji = 2, jpim1 
     
    925926                  IF ( zstrp2(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 
    926927                  zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / numts_rm 
    927                   zstrp2(ji,jj) = zstrp1(ji,jj) 
    928                   zstrp1(ji,jj) = strength(ji,jj) 
     928                  zstrp2  (ji,jj) = zstrp1  (ji,jj) 
     929                  zstrp1  (ji,jj) = strength(ji,jj) 
    929930                  strength(ji,jj) = zp 
    930931               ENDIF 
    931932            END DO 
    932933         END DO 
    933  
    934934         CALL lbc_lnk( strength, 'T', 1. )      ! Boundary conditions 
    935  
    936       ENDIF ! ksmooth 
     935         ! 
     936      END SELECT 
    937937      ! 
    938938   END SUBROUTINE ice_rdgrft_icestrength 
     939 
    939940 
    940941   SUBROUTINE ice_rdgrft_init 
    941942      !!------------------------------------------------------------------- 
    942       !!                   ***  ROUTINE ice_rdgrft_init *** 
     943      !!                  ***  ROUTINE ice_rdgrft_init *** 
    943944      !! 
    944945      !! ** Purpose :   Physical constants and parameters linked  
     
    952953      !!------------------------------------------------------------------- 
    953954      INTEGER :: ios                 ! Local integer output status for namelist read 
    954       NAMELIST/namiceitdme/ rn_cs, nn_partfun, rn_gstar, rn_astar,             &  
    955         &                   ln_ridging, rn_hstar, rn_por_rdg, rn_fsnowrdg, rn_fpondrdg, &  
    956                             ln_rafting, rn_hraft, rn_craft,   rn_fsnowrft, rn_fpondrft 
     955      !! 
     956      NAMELIST/namiceitdme/ rn_cs     , nn_partfun, rn_gstar  , rn_astar   ,                &  
     957         &                  ln_ridging, rn_hstar  , rn_por_rdg, rn_fsnowrdg, rn_fpondrdg,   &  
     958         &                  ln_rafting, rn_hraft  , rn_craft  , rn_fsnowrft, rn_fpondrft 
    957959      !!------------------------------------------------------------------- 
    958960      ! 
     
    960962      READ  ( numnam_ice_ref, namiceitdme, IOSTAT = ios, ERR = 901) 
    961963901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitdme in reference namelist', lwp ) 
    962  
     964      ! 
    963965      REWIND( numnam_ice_cfg )              ! Namelist namiceitdme in configuration namelist : Ice mechanical ice redistribution 
    964966      READ  ( numnam_ice_cfg, namiceitdme, IOSTAT = ios, ERR = 902 ) 
     
    992994   !!   Default option         Empty module          NO LIM-3 sea-ice model 
    993995   !!---------------------------------------------------------------------- 
    994 CONTAINS 
    995    SUBROUTINE ice_rdgrft           ! Empty routines 
    996    END SUBROUTINE ice_rdgrft 
    997    SUBROUTINE ice_rdgrft_icestrength 
    998    END SUBROUTINE ice_rdgrft_icestrength 
    999    SUBROUTINE ice_rdgrft_init 
    1000    END SUBROUTINE ice_rdgrft_init 
    1001996#endif 
     997 
    1002998   !!====================================================================== 
    1003999END MODULE icerdgrft 
Note: See TracChangeset for help on using the changeset viewer.