Ignore:
Timestamp:
2017-09-15T20:07:33+02:00 (3 years ago)
Author:
clem
Message:

changes in style - part6 - more clarity (still not finished)

File:
1 edited

Legend:

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

    r8518 r8531  
    1212   !!   'key_lim3'                                      LIM-3 sea-ice model 
    1313   !!---------------------------------------------------------------------- 
    14    USE par_oce        ! ocean parameters 
    1514   USE dom_oce        ! ocean domain 
    1615   USE phycst         ! physical constants (ocean directory)  
     
    3130   PRIVATE 
    3231 
    33    PUBLIC   ice_rdgrft               ! called by ice_stp 
    34    PUBLIC   ice_rdgrft_strength      ! called by icerhg_evp 
    35    PUBLIC   ice_rdgrft_init          ! called by ice_stp 
     32   PUBLIC   ice_rdgrft        ! called by icestp 
     33   PUBLIC   ice_strength      ! called by icerhg_evp 
     34   PUBLIC   ice_rdgrft_init   ! called by icedyn 
    3635 
    3736   ! Variables shared among ridging subroutines 
    3837   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   asum     ! sum of total ice and open water area 
    3938   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   aksum    ! ratio of area removed to area ridged 
    40    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   athorn   ! participation function; fraction of ridging/closing associated w/ category n 
     39   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   apartf   ! participation function; fraction of ridging/closing associated w/ category n 
    4140   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hrmin    ! minimum ridge thickness 
    4241   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hrmax    ! maximum ridge thickness 
    4342   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hraft    ! thickness of rafted ice 
    44    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   krdg     ! thickness of ridging ice / mean ridge thickness 
     43   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hi_hrdg  ! thickness of ridging ice / mean ridge thickness 
    4544   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aridge   ! participating ice ridging 
    4645   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   araft    ! participating ice rafting 
    4746   ! 
    48    REAL(wp), PARAMETER ::   krdgmin = 1.1_wp    ! min ridge thickness multiplier 
    49    REAL(wp), PARAMETER ::   kraft   = 0.5_wp    ! rafting multipliyer 
    50    REAL(wp)            ::   zdrho               !  
     47   REAL(wp), PARAMETER ::   hrdg_hi_min = 1.1_wp    ! min ridge thickness multiplier: min(hrdg/hi) 
     48   REAL(wp), PARAMETER ::   hi_hrft     = 0.5_wp    ! rafting multipliyer: (hi/hraft) 
     49   REAL(wp)            ::   zdrho                   !  
    5150   ! 
    52    ! ** namelist (namice_rdgrft) ** 
     51   ! ** namelist (namdyn_rdgrft) ** 
    5352   LOGICAL  ::   ln_str_H79       ! ice strength parameterization (Hibler79) 
    5453   REAL(wp) ::   rn_pstar         ! determines ice strength, Hibler JPO79 
     
    8382      !!                ***  ROUTINE ice_rdgrft_alloc *** 
    8483      !!---------------------------------------------------------------------! 
    85       ALLOCATE( asum (jpi,jpj)     , athorn(jpi,jpj,0:jpl) , aksum (jpi,jpj)     ,     & 
    86          &      hrmin(jpi,jpj,jpl) , hraft (jpi,jpj,jpl)   , aridge(jpi,jpj,jpl) ,     & 
    87          &      hrmax(jpi,jpj,jpl) , krdg  (jpi,jpj,jpl)   , araft (jpi,jpj,jpl) , STAT=ice_rdgrft_alloc ) 
     84      ALLOCATE( asum (jpi,jpj)     , apartf (jpi,jpj,0:jpl) , aksum (jpi,jpj)     ,     & 
     85         &      hrmin(jpi,jpj,jpl) , hraft  (jpi,jpj,jpl)   , aridge(jpi,jpj,jpl) ,     & 
     86         &      hrmax(jpi,jpj,jpl) , hi_hrdg(jpi,jpj,jpl)   , araft (jpi,jpj,jpl) , STAT=ice_rdgrft_alloc ) 
    8887 
    8988      IF( lk_mpp                )   CALL mpp_sum ( ice_rdgrft_alloc ) 
     
    124123      INTEGER  ::   niter              ! local integer  
    125124      INTEGER  ::   iterate_ridging    ! if =1, repeat the ridging 
    126       REAL(wp) ::   z               ! local scalar 
     125      REAL(wp) ::   zfac               ! local scalar 
    127126      REAL(wp), DIMENSION(jpi,jpj) ::   closing_net     ! net rate at which area is removed    (1/s) 
    128127      !                                                 ! (ridging ice area - area of new ridges) / dt 
     
    150149      !-----------------------------------------------------------------------------! 
    151150      ! 
    152       CALL ice_rdgrft_prep                             ! prepare ridging 
     151      CALL rdgrft_prep                             ! prepare ridging 
    153152      ! 
    154153      DO jj = 1, jpj                                        ! Initialize arrays. 
     
    203202      DO WHILE ( iterate_ridging > 0 .AND. niter < nitermax ) 
    204203 
    205          ! 3.2 closing_gross 
     204         ! 3.1 closing_gross 
    206205         !-----------------------------------------------------------------------------! 
    207206         ! Based on the ITD of ridging and ridged ice, convert the net 
     
    216215         DO jj = 1, jpj 
    217216            DO ji = 1, jpi 
    218                za   = ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice 
    219                IF    ( za < 0._wp .AND. za > - ato_i(ji,jj) ) THEN                  ! would lead to negative ato_i 
    220                   opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) - ato_i(ji,jj) * r1_rdtice  
    221                ELSEIF( za > 0._wp .AND. za > ( asum(ji,jj) - ato_i(ji,jj) ) ) THEN  ! would lead to ato_i > asum 
    222                   opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) + ( asum(ji,jj) - ato_i(ji,jj) ) * r1_rdtice  
     217               zfac   = ( opning(ji,jj) - apartf(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice 
     218               IF    ( zfac < 0._wp .AND. zfac > - ato_i(ji,jj) ) THEN                  ! would lead to negative ato_i 
     219                  opning(ji,jj) = apartf(ji,jj,0) * closing_gross(ji,jj) - ato_i(ji,jj) * r1_rdtice  
     220               ELSEIF( zfac > 0._wp .AND. zfac > ( asum(ji,jj) - ato_i(ji,jj) ) ) THEN  ! would lead to ato_i > asum 
     221                  opning(ji,jj) = apartf(ji,jj,0) * closing_gross(ji,jj) + ( asum(ji,jj) - ato_i(ji,jj) ) * r1_rdtice  
    223222               ENDIF 
    224223            END DO 
     
    232231            DO jj = 1, jpj 
    233232               DO ji = 1, jpi 
    234                   za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 
    235                   IF( za  >  a_i(ji,jj,jl) ) THEN 
    236                      closing_gross(ji,jj) = closing_gross(ji,jj) * a_i(ji,jj,jl) / za 
     233                  zfac = apartf(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 
     234                  IF( zfac  >  a_i(ji,jj,jl) ) THEN 
     235                     closing_gross(ji,jj) = closing_gross(ji,jj) * a_i(ji,jj,jl) / zfac 
    237236                  ENDIF 
    238237               END DO 
     
    240239         END DO 
    241240 
    242          ! 3.3 Redistribute area, volume, and energy. 
     241         ! 3.2 Redistribute area, volume, and energy. 
    243242         !-----------------------------------------------------------------------------! 
    244          CALL ice_rdgrft_ridgeshift( opning, closing_gross ) 
     243         CALL rdgrft_shift( opning, closing_gross ) 
    245244          
    246          ! 3.4 Compute total area of ice plus open water after ridging. 
     245         ! 3.3 Compute total area of ice plus open water after ridging. 
    247246         !-----------------------------------------------------------------------------! 
    248247         ! This is in general not equal to one because of divergence during transport 
    249248         asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 
    250249 
    251          ! 3.5 Do we keep on iterating? 
     250         ! 3.4 Do we keep on iterating? 
    252251         !-----------------------------------------------------------------------------! 
    253252         ! Check whether asum = 1.  If not (because the closing and opening 
     
    276275         ! 
    277276         IF( iterate_ridging == 1 ) THEN 
    278             CALL ice_rdgrft_prep 
     277            CALL rdgrft_prep 
    279278            IF( niter  >  nitermax ) THEN 
    280279               WRITE(numout,*) ' ALERTE : non-converging ridging scheme ' 
     
    295294 
    296295 
    297    SUBROUTINE ice_rdgrft_prep 
     296   SUBROUTINE rdgrft_prep 
    298297      !!---------------------------------------------------------------------! 
    299       !!                ***  ROUTINE ice_rdgrft_prep *** 
     298      !!                ***  ROUTINE rdgrft_prep *** 
    300299      !! 
    301300      !! ** Purpose :   preparation for ridging and strength calculations 
     
    319318      END WHERE 
    320319 
    321       !------------------------------------------------------------------------------! 
    322       ! 1) Participation function  
    323       !------------------------------------------------------------------------------! 
     320      !----------------------------------------------------------------- 
     321      ! 1) Participation function: a(h) = b(h).g(h) (apartf) 
     322      !----------------------------------------------------------------- 
     323      ! Compute the participation function apartf; this is analogous to 
     324      ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975). 
     325      ! area lost from category n due to ridging/closing 
     326      ! apartf(n)   = total area lost due to ridging/closing 
     327      ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar).  
     328      ! 
     329      ! The expressions for apartf are found by integrating b(h)g(h) between 
     330      ! the category boundaries. 
     331      ! apartf is always >= 0 and SUM(apartf(0:jpl))=1 
     332      !----------------------------------------------------------------- 
    324333      ! 
    325334      ! Compute total area of ice plus open water. 
     
    337346      END DO 
    338347 
    339       ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn) 
    340       !-------------------------------------------------------------------------------------------------- 
    341       ! Compute the participation function athorn; this is analogous to 
    342       ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975). 
    343       ! area lost from category n due to ridging/closing 
    344       ! athorn(n)   = total area lost due to ridging/closing 
    345       ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar).  
    346       ! 
    347       ! The expressions for athorn are found by integrating b(h)g(h) between 
    348       ! the category boundaries. 
    349       ! athorn is always >= 0 and SUM(athorn(0:jpl))=1 
    350       !----------------------------------------------------------------- 
    351348      ! 
    352349      IF( ln_partf_lin ) THEN          !--- Linear formulation (Thorndike et al., 1975) 
     
    355352               DO ji = 1, jpi 
    356353                  IF    ( zGsum(ji,jj,jl)   < rn_gstar ) THEN 
    357                      athorn(ji,jj,jl) = z1_gstar * ( zGsum(ji,jj,jl) - zGsum(ji,jj,jl-1) ) * & 
     354                     apartf(ji,jj,jl) = z1_gstar * ( zGsum(ji,jj,jl) - zGsum(ji,jj,jl-1) ) * & 
    358355                        &                          ( 2._wp - ( zGsum(ji,jj,jl-1) + zGsum(ji,jj,jl) ) * z1_gstar ) 
    359356                  ELSEIF( zGsum(ji,jj,jl-1) < rn_gstar ) THEN 
    360                      athorn(ji,jj,jl) = z1_gstar * ( rn_gstar        - zGsum(ji,jj,jl-1) ) *  & 
     357                     apartf(ji,jj,jl) = z1_gstar * ( rn_gstar        - zGsum(ji,jj,jl-1) ) *  & 
    361358                        &                          ( 2._wp - ( zGsum(ji,jj,jl-1) + rn_gstar        ) * z1_gstar ) 
    362359                  ELSE 
    363                      athorn(ji,jj,jl) = 0._wp 
     360                     apartf(ji,jj,jl) = 0._wp 
    364361                  ENDIF 
    365362               END DO 
     
    374371         END DO 
    375372         DO jl = 0, jpl 
    376             athorn(:,:,jl) = zGsum(:,:,jl-1) - zGsum(:,:,jl) 
     373            apartf(:,:,jl) = zGsum(:,:,jl-1) - zGsum(:,:,jl) 
    377374         END DO 
    378375         ! 
     
    384381            DO jj = 1, jpj  
    385382               DO ji = 1, jpi 
    386                   aridge(ji,jj,jl) = ( 1._wp + TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) ) * 0.5_wp * athorn(ji,jj,jl) 
    387                   araft (ji,jj,jl) = athorn(ji,jj,jl) - aridge(ji,jj,jl) 
     383                  aridge(ji,jj,jl) = ( 1._wp + TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) ) * 0.5_wp * apartf(ji,jj,jl) 
     384                  araft (ji,jj,jl) = apartf(ji,jj,jl) - aridge(ji,jj,jl) 
    388385               END DO 
    389386            END DO 
    390387         END DO 
    391388      ELSEIF( ln_ridging .AND. .NOT. ln_rafting ) THEN   !- ridging alone 
    392          aridge(:,:,:) = athorn(:,:,1:jpl) 
     389         aridge(:,:,:) = apartf(:,:,1:jpl) 
    393390         araft (:,:,:) = 0._wp 
    394391      ELSEIF( ln_rafting .AND. .NOT. ln_ridging ) THEN   !- rafting alone    
    395392        aridge(:,:,:) = 0._wp 
    396          araft (:,:,:) = athorn(:,:,1:jpl) 
     393         araft (:,:,:) = apartf(:,:,1:jpl) 
    397394      ELSE                                               !- no ridging & no rafting 
    398395         aridge(:,:,:) = 0._wp 
     
    408405      ! This parameterization is a modified version of Hibler (1980). 
    409406      ! The mean ridging thickness, zhmean, is proportional to hi^(0.5) 
    410       !  and for very thick ridging ice must be >= krdgmin*hi 
     407      !  and for very thick ridging ice must be >= hrdg_hi_min*hi 
    411408      ! 
    412409      ! The minimum ridging thickness, hrmin, is equal to 2*hi  
     
    426423      !----------------------------------------------------------------- 
    427424 
    428       aksum(:,:) = athorn(:,:,0) 
     425      aksum(:,:) = apartf(:,:,0) 
     426      zdummy = 1._wp / hi_hrft 
    429427      ! Transfer function 
    430428      DO jl = 1, jpl !all categories have a specific transfer function 
    431429         DO jj = 1, jpj 
    432430            DO ji = 1, jpi 
    433                IF ( athorn(ji,jj,jl) > 0._wp ) THEN 
    434                   zhmean          = MAX( SQRT( rn_hstar * ht_i(ji,jj,jl) ), ht_i(ji,jj,jl) * krdgmin ) 
    435                   hrmin(ji,jj,jl) = MIN( 2._wp * ht_i(ji,jj,jl), 0.5_wp * ( zhmean + ht_i(ji,jj,jl) ) ) 
    436                   hrmax(ji,jj,jl) = 2._wp * zhmean - hrmin(ji,jj,jl) 
    437                   hraft(ji,jj,jl) = ht_i(ji,jj,jl) / kraft 
    438                   krdg (ji,jj,jl) = ht_i(ji,jj,jl) / MAX( zhmean, epsi20 ) 
     431               IF ( apartf(ji,jj,jl) > 0._wp ) THEN 
     432                  zhmean            = MAX( SQRT( rn_hstar * ht_i(ji,jj,jl) ), ht_i(ji,jj,jl) * hrdg_hi_min ) 
     433                  hrmin  (ji,jj,jl) = MIN( 2._wp * ht_i(ji,jj,jl), 0.5_wp * ( zhmean + ht_i(ji,jj,jl) ) ) 
     434                  hrmax  (ji,jj,jl) = 2._wp * zhmean - hrmin(ji,jj,jl) 
     435                  hraft  (ji,jj,jl) = ht_i(ji,jj,jl) * zdummy 
     436                  hi_hrdg(ji,jj,jl) = ht_i(ji,jj,jl) / MAX( zhmean, epsi20 ) 
    439437                  ! 
    440438                  ! Normalization factor : aksum, ensures mass conservation 
    441                   aksum(ji,jj) = aksum(ji,jj) + aridge(ji,jj,jl) * ( 1._wp - krdg(ji,jj,jl) )    & 
    442                      &                        + araft (ji,jj,jl) * ( 1._wp - kraft          ) 
     439                  aksum(ji,jj) = aksum(ji,jj) + aridge(ji,jj,jl) * ( 1._wp - hi_hrdg(ji,jj,jl) )    & 
     440                     &                        + araft (ji,jj,jl) * ( 1._wp - hi_hrft ) 
    443441               ELSE 
    444                   hrmin(ji,jj,jl) = 0._wp  
    445                   hrmax(ji,jj,jl) = 0._wp  
    446                   hraft(ji,jj,jl) = 0._wp  
    447                   krdg (ji,jj,jl) = 1._wp 
     442                  hrmin  (ji,jj,jl) = 0._wp  
     443                  hrmax  (ji,jj,jl) = 0._wp  
     444                  hraft  (ji,jj,jl) = 0._wp  
     445                  hi_hrdg(ji,jj,jl) = 1._wp 
    448446               ENDIF 
    449447            END DO 
     
    451449      END DO 
    452450      ! 
    453    END SUBROUTINE ice_rdgrft_prep 
    454  
    455  
    456    SUBROUTINE ice_rdgrft_ridgeshift( opning, closing_gross ) 
     451   END SUBROUTINE rdgrft_prep 
     452 
     453 
     454   SUBROUTINE rdgrft_shift( opning, closing_gross ) 
    457455      !!---------------------------------------------------------------------- 
    458       !!                ***  ROUTINE ice_rdgrft_strength *** 
     456      !!                ***  ROUTINE rdgrft_shift *** 
    459457      !! 
    460458      !! ** Purpose :   shift ridging ice among thickness categories of ice thickness 
     
    463461      !!              and add to thicker ice categories. 
    464462      !!---------------------------------------------------------------------- 
    465       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   opning         ! rate of opening due to divergence/shear 
    466       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   closing_gross  ! rate at which area retreats, excluding area of new ridges 
    467       ! 
    468       INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices 
    469       INTEGER ::   ij                ! horizontal index, combines i and j loops 
    470       INTEGER ::   icells            ! number of cells with a_i > puny 
    471       REAL(wp) ::   hL, hR, farea    ! left and right limits of integration and new area going to jl2 
    472  
    473       INTEGER , DIMENSION(jpij) ::   indxi, indxj   ! compressed indices 
    474       REAL(wp), DIMENSION(jpij) ::   zswitch, fvol   ! new ridge volume going to jl2 
     463      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   opning         ! rate of opening due to divergence/shear 
     464      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   closing_gross  ! rate at which area retreats, excluding area of new ridges 
     465      ! 
     466      INTEGER  ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices 
     467      INTEGER  ::   ij                         ! horizontal index, combines i and j loops 
     468      INTEGER  ::   icells                     ! number of cells with a_i > puny 
     469      REAL(wp) ::   hL, hR, farea              ! left and right limits of integration and new area going to jl2 
     470 
     471      INTEGER , DIMENSION(jpij) ::   indxi, indxj     ! compressed indices 
     472      REAL(wp), DIMENSION(jpij) ::   zswitch, fvol    ! new ridge volume going to jl2 
    475473 
    476474      REAL(wp), DIMENSION(jpij) ::   afrac            ! fraction of category area ridged  
     
    482480      REAL(wp), DIMENSION(jpij) ::   aprdg2           ! pond area of ridging ice 
    483481      ! END MV MP 2016 
    484       REAL(wp), DIMENSION(jpij) ::   dhr   , dhr2     ! hrmax - hrmin  &  hrmax^2 - hrmin^2 
    485  
    486       REAL(wp), DIMENSION(jpij) ::   vrdg1   ! volume of ice ridged 
    487       REAL(wp), DIMENSION(jpij) ::   vrdg2   ! volume of new ridges 
    488       REAL(wp), DIMENSION(jpij) ::   vsw     ! volume of seawater trapped into ridges 
    489       REAL(wp), DIMENSION(jpij) ::   srdg1   ! sal*volume of ice ridged 
    490       REAL(wp), DIMENSION(jpij) ::   srdg2   ! sal*volume of new ridges 
    491       REAL(wp), DIMENSION(jpij) ::   smsw    ! sal*volume of water trapped into ridges 
     482      REAL(wp), DIMENSION(jpij) ::   dhr, dhr2        ! hrmax - hrmin  &  hrmax^2 - hrmin^2 
     483 
     484      REAL(wp), DIMENSION(jpij) ::   vrdg1            ! volume of ice ridged 
     485      REAL(wp), DIMENSION(jpij) ::   vrdg2            ! volume of new ridges 
     486      REAL(wp), DIMENSION(jpij) ::   vsw              ! volume of seawater trapped into ridges 
     487      REAL(wp), DIMENSION(jpij) ::   srdg1            ! sal*volume of ice ridged 
     488      REAL(wp), DIMENSION(jpij) ::   srdg2            ! sal*volume of new ridges 
     489      REAL(wp), DIMENSION(jpij) ::   smsw             ! sal*volume of water trapped into ridges 
    492490      REAL(wp), DIMENSION(jpij) ::   oirdg1, oirdg2   ! ice age of ice ridged 
    493491 
     
    503501      REAL(wp), DIMENSION(jpij) ::   oirft1, oirft2   ! ice age of ice rafted 
    504502 
    505       REAL(wp), DIMENSION(jpij,nlay_i) ::   eirft      ! ice energy of rafting ice 
    506       REAL(wp), DIMENSION(jpij,nlay_i) ::   erdg1      ! enth*volume of ice ridged 
    507       REAL(wp), DIMENSION(jpij,nlay_i) ::   erdg2      ! enth*volume of new ridges 
    508       REAL(wp), DIMENSION(jpij,nlay_i) ::   ersw       ! enth of water trapped into ridges 
     503      REAL(wp), DIMENSION(jpij,nlay_i) ::   eirft     ! ice energy of rafting ice 
     504      REAL(wp), DIMENSION(jpij,nlay_i) ::   erdg1     ! enth*volume of ice ridged 
     505      REAL(wp), DIMENSION(jpij,nlay_i) ::   erdg2     ! enth*volume of new ridges 
     506      REAL(wp), DIMENSION(jpij,nlay_i) ::   ersw      ! enth of water trapped into ridges 
    509507      !!---------------------------------------------------------------------- 
    510508 
     
    515513         DO ji = 1, jpi 
    516514            ato_i(ji,jj) = MAX( 0._wp, ato_i(ji,jj) +  & 
    517                &                     ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice ) 
     515               &                     ( opning(ji,jj) - apartf(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice ) 
    518516         END DO 
    519517      END DO 
    520518 
    521519      !----------------------------------------------------------------- 
    522       ! 3) Pump everything from ice which is being ridged / rafted 
     520      ! 2) Pump everything from ice which is being ridged / rafted 
    523521      !----------------------------------------------------------------- 
    524522      ! Compute the area, volume, and energy of ice ridging in each 
     
    528526 
    529527         !------------------------------------------------ 
    530          ! 3.1) Identify grid cells with nonzero ridging 
     528         ! 2.1) Identify grid cells with nonzero ridging 
    531529         !------------------------------------------------ 
    532530         icells = 0 
    533531         DO jj = 1, jpj 
    534532            DO ji = 1, jpi 
    535                IF( athorn(ji,jj,jl1) > 0._wp .AND. closing_gross(ji,jj) > 0._wp ) THEN 
     533               IF( apartf(ji,jj,jl1) > 0._wp .AND. closing_gross(ji,jj) > 0._wp ) THEN 
    536534                  icells = icells + 1 
    537535                  indxi(icells) = ji 
     
    545543 
    546544            !-------------------------------------------------------------------- 
    547             ! 3.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2) 
     545            ! 2.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2) 
    548546            !-------------------------------------------------------------------- 
    549547            ardg1(ij) = aridge(ji,jj,jl1) * closing_gross(ji,jj) * rdt_ice 
     
    551549 
    552550            !--------------------------------------------------------------- 
    553             ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1  
     551            ! 2.3) Compute ridging /rafting fractions, make sure afrac <=1  
    554552            !--------------------------------------------------------------- 
    555553            afrac(ij) = ardg1(ij) / a_i(ji,jj,jl1) !ridging 
    556554            afrft(ij) = arft1(ij) / a_i(ji,jj,jl1) !rafting 
    557             ardg2(ij) = ardg1(ij) * krdg(ji,jj,jl1) 
    558             arft2(ij) = arft1(ij) * kraft 
     555            ardg2(ij) = ardg1(ij) * hi_hrdg(ji,jj,jl1) 
     556            arft2(ij) = arft1(ij) * hi_hrft 
    559557 
    560558            !-------------------------------------------------------------------------- 
    561             ! 3.4) Substract area, volume, and energy from ridging  
     559            ! 2.4) Substract area, volume, and energy from ridging  
    562560            !     / rafting category n1. 
    563561            !-------------------------------------------------------------------------- 
     
    571569            IF ( nn_pnd_scheme > 0 ) THEN 
    572570               aprdg1(ij) = a_ip(ji,jj, jl1) * afrac(ij) 
    573                aprdg2(ij) = a_ip(ji,jj, jl1) * afrac(ij) * krdg(ji,jj,jl1) 
     571               aprdg2(ij) = a_ip(ji,jj, jl1) * afrac(ij) * hi_hrdg(ji,jj,jl1) 
    574572               vprdg(ij)  = v_ip(ji,jj, jl1) * afrac(ij) 
    575573            ENDIF 
     
    577575            srdg1 (ij) = smv_i(ji,jj,  jl1) * afrac(ij) 
    578576            oirdg1(ij) = oa_i (ji,jj,  jl1) * afrac(ij) 
    579             oirdg2(ij) = oa_i (ji,jj,  jl1) * afrac(ij) * krdg(ji,jj,jl1)  
     577            oirdg2(ij) = oa_i (ji,jj,  jl1) * afrac(ij) * hi_hrdg(ji,jj,jl1)  
    580578 
    581579            ! rafting volumes, heat contents ... 
     
    585583            IF ( nn_pnd_scheme > 0 ) THEN 
    586584               aprft1(ij) = a_ip (ji,jj,  jl1) * afrft(ij) 
    587                aprft2(ij) = a_ip (ji,jj,  jl1) * afrft(ij) * kraft 
     585               aprft2(ij) = a_ip (ji,jj,  jl1) * afrft(ij) * hi_hrft 
    588586               vprft(ij)  = v_ip(ji,jj,jl1)    * afrft(ij) 
    589587            ENDIF 
     
    593591            smrft (ij) = smv_i(ji,jj,  jl1) * afrft(ij)  
    594592            oirft1(ij) = oa_i (ji,jj,  jl1) * afrft(ij)  
    595             oirft2(ij) = oa_i (ji,jj,  jl1) * afrft(ij) * kraft  
     593            oirft2(ij) = oa_i (ji,jj,  jl1) * afrft(ij) * hi_hrft  
    596594 
    597595            !----------------------------------------------------------------- 
    598             ! 3.5) Compute properties of new ridges 
     596            ! 2.5) Compute properties of new ridges 
    599597            !----------------------------------------------------------------- 
    600598            smsw(ij)  = vsw(ij) * sss_m(ji,jj)                   ! salt content of seawater frozen in voids 
     
    612610 
    613611            !------------------------------------------             
    614             ! 3.7 Put the snow somewhere in the ocean 
     612            ! 2.6 Put the snow somewhere in the ocean 
    615613            !------------------------------------------             
    616614            !  Place part of the snow lost by ridging into the ocean.  
     
    627625            ! MV MP 2016 
    628626            !------------------------------------------             
    629             ! 3.X Put the melt pond water in the ocean 
     627            ! 2.7 Put the melt pond water in the ocean 
    630628            !------------------------------------------             
    631629            !  Place part of the melt pond volume into the ocean.  
     
    637635 
    638636            !----------------------------------------------------------------- 
    639             ! 3.8 Compute quantities used to apportion ice among categories 
     637            ! 2.8 Compute quantities used to apportion ice among categories 
    640638            ! in the n2 loop below 
    641639            !----------------------------------------------------------------- 
     
    662660 
    663661         !-------------------------------------------------------------------- 
    664          ! 3.9 Compute ridging ice enthalpy, remove it from ridging ice and 
     662         ! 2.9 Compute ridging ice enthalpy, remove it from ridging ice and 
    665663         !      compute ridged ice enthalpy  
    666664         !-------------------------------------------------------------------- 
     
    689687 
    690688         !------------------------------------------------------------------------------- 
    691          ! 4) Add area, volume, and energy of new ridge to each category jl2 
     689         ! 3) Add area, volume, and energy of new ridge to each category jl2 
    692690         !------------------------------------------------------------------------------- 
    693691         DO jl2  = 1, jpl  
     
    710708!!gm see above               IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN 
    711709               IF( hi_max(jl2-1) < hraft(ji,jj,jl1) .AND. hraft(ji,jj,jl1) <= hi_max(jl2)  ) THEN   ;   zswitch(ij) = 1._wp 
    712                ELSE                                                                                 ;   zswitch(ij) = 0._wp                   
     710               ELSE                                                                                 ;   zswitch(ij) = 0._wp 
    713711               ENDIF 
    714712               ! 
     
    743741      END DO ! jl1 (deforming categories) 
    744742      ! 
    745    END SUBROUTINE ice_rdgrft_ridgeshift 
    746  
    747  
    748    SUBROUTINE ice_rdgrft_strength 
     743   END SUBROUTINE rdgrft_shift 
     744 
     745 
     746   SUBROUTINE ice_strength 
    749747      !!---------------------------------------------------------------------- 
    750       !!                ***  ROUTINE ice_rdgrft_strength *** 
     748      !!                ***  ROUTINE ice_strength *** 
    751749      !! 
    752750      !! ** Purpose :   computes ice strength used in dynamics routines of ice thickness 
     
    767765 
    768766      !                              !--------------------------------------------------! 
    769       CALL ice_rdgrft_prep           ! Thickness distribution of ridging and ridged ice ! 
     767      CALL rdgrft_prep               ! Thickness distribution of ridging and ridged ice ! 
    770768      !                              !--------------------------------------------------! 
    771769 
     
    775773         z1_3 = 1._wp / 3._wp 
    776774         DO jl = 1, jpl 
    777             WHERE( athorn(:,:,jl) > 0._wp ) 
    778                strength(:,:) =  -         athorn(:,:,jl) * ht_i(:,:,jl) * ht_i(:,:,jl)   &  ! PE loss from deforming ice 
    779                   &             + 2._wp * araft (:,:,jl) * ht_i(:,:,jl) * ht_i(:,:,jl)   &  ! PE gain from rafting ice 
    780                   &             +         aridge(:,:,jl) * krdg(:,:,jl) * z1_3 *   &        ! PE gain from ridging ice 
    781                   &                      ( hrmax(:,:,jl) * hrmax(:,:,jl) +         & 
    782                   &                        hrmin(:,:,jl) * hrmin(:,:,jl) +         & 
    783                   &                        hrmax(:,:,jl) * hrmin(:,:,jl) ) 
     775            WHERE( apartf(:,:,jl) > 0._wp ) 
     776               strength(:,:) =  -         apartf(:,:,jl) * ht_i   (:,:,jl) * ht_i(:,:,jl)   &  ! PE loss from deforming ice 
     777                  &             + 2._wp * araft (:,:,jl) * ht_i   (:,:,jl) * ht_i(:,:,jl)   &  ! PE gain from rafting ice 
     778                  &             +         aridge(:,:,jl) * hi_hrdg(:,:,jl) * z1_3 *         &  ! PE gain from ridging ice 
     779                  &                      ( hrmax(:,:,jl) * hrmax  (:,:,jl) +                & 
     780                  &                        hrmin(:,:,jl) * hrmin  (:,:,jl) +                & 
     781                  &                        hrmax(:,:,jl) * hrmin  (:,:,jl) ) 
    784782            ELSEWHERE 
    785783               strength(:,:) = 0._wp 
     
    844842      END SELECT 
    845843      ! 
    846    END SUBROUTINE ice_rdgrft_strength 
     844   END SUBROUTINE ice_strength 
    847845 
    848846 
     
    854852      !!                to the mechanical ice redistribution 
    855853      !! 
    856       !! ** Method  :   Read the namice_rdgrft namelist  
     854      !! ** Method  :   Read the namdyn_rdgrft namelist  
    857855      !!                and check the parameters values  
    858856      !!                called at the first timestep (nit000) 
    859857      !! 
    860       !! ** input   :   Namelist namice_rdgrft 
     858      !! ** input   :   Namelist namdyn_rdgrft 
    861859      !!------------------------------------------------------------------- 
    862860      INTEGER :: ios                 ! Local integer output status for namelist read 
    863861      !! 
    864       NAMELIST/namice_rdgrft/ ln_str_H79, rn_pstar, rn_crhg, & 
     862      NAMELIST/namdyn_rdgrft/ ln_str_H79, rn_pstar, rn_crhg, & 
    865863         &                    ln_str_R75, rn_perdg,          & 
    866864         &                    rn_csrdg  ,                    & 
     
    872870      ! 
    873871      REWIND( numnam_ice_ref )              ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution 
    874       READ  ( numnam_ice_ref, namice_rdgrft, IOSTAT = ios, ERR = 901) 
    875 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namice_rdgrft in reference namelist', lwp ) 
    876       ! 
    877       REWIND( numnam_ice_cfg )              ! Namelist namice_rdgrft in configuration namelist : Ice mechanical ice redistribution 
    878       READ  ( numnam_ice_cfg, namice_rdgrft, IOSTAT = ios, ERR = 902 ) 
    879 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namice_rdgrft in configuration namelist', lwp ) 
    880       IF(lwm) WRITE ( numoni, namice_rdgrft ) 
     872      READ  ( numnam_ice_ref, namdyn_rdgrft, IOSTAT = ios, ERR = 901) 
     873901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist', lwp ) 
     874      ! 
     875      REWIND( numnam_ice_cfg )              ! Namelist namdyn_rdgrft in configuration namelist : Ice mechanical ice redistribution 
     876      READ  ( numnam_ice_cfg, namdyn_rdgrft, IOSTAT = ios, ERR = 902 ) 
     877902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist', lwp ) 
     878      IF(lwm) WRITE ( numoni, namdyn_rdgrft ) 
    881879      ! 
    882880      IF (lwp) THEN                          ! control print 
     
    884882         WRITE(numout,*) 'ice_rdgrft_init: ice parameters for ridging/rafting ' 
    885883         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    886          WRITE(numout,*) '   Namelist namice_rdgrft' 
     884         WRITE(numout,*) '   Namelist namdyn_rdgrft:' 
    887885         WRITE(numout,*) '      ice strength parameterization Hibler (1979)              ln_str_H79   = ', ln_str_H79  
    888886         WRITE(numout,*) '            1st bulk-rheology parameter                        rn_pstar     = ', rn_pstar 
     
    915913      ENDIF 
    916914      !                              ! allocate tke arrays 
    917       IF( ice_rdgrft_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'ice_rdgrft_init : unable to allocate arrays' ) 
     915      IF( ice_rdgrft_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'ice_rdgrft_init: unable to allocate arrays' ) 
    918916      ! 
    919917  END SUBROUTINE ice_rdgrft_init 
Note: See TracChangeset for help on using the changeset viewer.