Ignore:
Timestamp:
2017-09-12T20:46:13+02:00 (3 years ago)
Author:
clem
Message:

changes in style - part6 - one more round

File:
1 edited

Legend:

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

    r8516 r8517  
    3434   PUBLIC   ice_dyn_init   ! called by icestp.F90 
    3535    
    36    INTEGER ::              nice_dyn   ! choice of the type of advection scheme 
     36   INTEGER ::              nice_dyn   ! choice of the type of dynamics 
    3737   !                                        ! associated indices: 
    38    INTEGER, PARAMETER ::   np_dynNO   = 0   ! no ice dynamics and ice advection 
    39    INTEGER, PARAMETER ::   np_dynFULL = 1   ! full ice dynamics  (rheology + advection + ridging/rafting + correction) 
    40    INTEGER, PARAMETER ::   np_dyn     = 2   ! no ridging/rafting (rheology + advection                   + correction) 
    41    INTEGER, PARAMETER ::   np_dynPURE = 3   ! pure dynamics      (rheology + advection)  
    42  
     38   INTEGER, PARAMETER ::   np_dynFULL    = 1   ! full ice dynamics               (rheology + advection + ridging/rafting + correction) 
     39   INTEGER, PARAMETER ::   np_dynRHGADV1 = 2   ! no ridging/rafting              (rheology + advection                   + correction) 
     40   INTEGER, PARAMETER ::   np_dynRHGADV2 = 3   ! pure dynamics                   (rheology + advection)  
     41   INTEGER, PARAMETER ::   np_dynADV     = 4   ! only advection w prescribed vel.(rn_uvice + advection) 
     42   ! 
     43   ! ** namelist (namdyn) ** 
     44   REAL(wp) ::   rn_uice          ! prescribed u-vel (case np_dynADV) 
     45   REAL(wp) ::   rn_vice          ! prescribed v-vel (case np_dynADV) 
     46    
    4347   !! * Substitutions 
    4448#  include "vectopt_loop_substitute.h90" 
     
    6165      INTEGER, INTENT(in) ::   kt     ! ice time step 
    6266      !! 
    63       INTEGER  ::   jl   ! dummy loop indices 
     67      INTEGER ::   ji, jj, jl         ! dummy loop indices 
     68      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zhmax 
    6469      !!-------------------------------------------------------------------- 
    6570      ! 
     
    7277      ENDIF 
    7378 
    74       CALL ice_var_agg(1)           ! -- aggregate ice categories 
    7579      !                       
    76       IF( ln_landfast ) THEN        ! -- Landfast ice parameterization: define max bottom friction 
     80      IF( ln_landfast ) THEN            !-- Landfast ice parameterization: define max bottom friction 
    7781         tau_icebfr(:,:) = 0._wp 
    7882         DO jl = 1, jpl 
     
    8185      ENDIF 
    8286 
    83       SELECT CASE( nice_dyn )       ! -- Set which dynamics is running 
     87      zhmax(:,:,:) = ht_i_b(:,:,:)      !-- Record max of the surrounding 9-pts ice thick. (for CALL Hbig) 
     88      DO jl = 1, jpl 
     89         DO jj = 2, jpjm1 
     90            DO ji = 2, jpim1 
     91!!gm use of MAXVAL here is very probably less efficient than expending the 9 values 
     92               zhmax(ji,jj,jl) = MAX( epsi20, MAXVAL( ht_i_b(ji-1:ji+1,jj-1:jj+1,jl) ) ) 
     93            END DO 
     94         END DO 
     95      END DO 
     96      CALL lbc_lnk( zhmax(:,:,:), 'T', 1. ) 
     97      ! 
     98      ! 
     99      SELECT CASE( nice_dyn )           !-- Set which dynamics is running 
    84100 
    85101      CASE ( np_dynFULL )          !==  all dynamical processes  ==! 
    86          CALL ice_rhg   ( kt )          ! -- rheology   
    87          CALL ice_adv   ( kt )          ! -- advection of ice 
    88          CALL ice_rdgrft( kt )          ! -- ridging/rafting  
    89          CALL ice_cor   ( kt , 1 )      ! -- Corrections 
    90  
    91       CASE ( np_dyn )              !==  pure dynamics only ==!   (no ridging/rafting)   (nono cat. case 2) 
    92          CALL ice_rhg   ( kt )          ! -- rheology   
    93          CALL ice_adv   ( kt )          ! -- advection of ice 
    94          CALL ice_cor   ( kt , 1 )      ! -- Corrections 
    95  
    96       CASE ( np_dynPURE )          !==  pure dynamics only ==!   (nn_icedyn= 1 ) 
    97          CALL ice_rhg   ( kt )          ! -- rheology   
    98          CALL ice_adv   ( kt )          ! -- advection of ice 
    99  
    100       CASE ( np_dynNO )            !==  prescribed ice velocities ==!   (nn_icedyn= 0 ) 
     102         CALL ice_rhg   ( kt )                            ! -- rheology   
     103         CALL ice_adv   ( kt )   ;   CALL Hbig( zhmax )   ! -- advection of ice + correction on ice thickness 
     104         CALL ice_rdgrft( kt )                            ! -- ridging/rafting  
     105         CALL ice_cor   ( kt , 1 )                        ! -- Corrections 
     106 
     107      CASE ( np_dynRHGADV1 )       !==  no ridge/raft ==!   (mono cat. case 2) 
     108         CALL ice_rhg   ( kt )                            ! -- rheology   
     109         CALL ice_adv   ( kt )                            ! -- advection of ice 
     110         CALL Hpiling                                     ! -- simple pile-up (replaces ridging/rafting) 
     111         CALL ice_cor   ( kt , 1 )                        ! -- Corrections 
     112 
     113      CASE ( np_dynRHGADV2 )       !==  no ridge/raft & no corrections ==! 
     114         CALL ice_rhg   ( kt )                            ! -- rheology   
     115         CALL ice_adv   ( kt )                            ! -- advection of ice 
     116         CALL Hpiling                                     ! -- simple pile-up (replaces ridging/rafting) 
     117 
     118      CASE ( np_dynADV )           !==  pure advection ==!   (prescribed velocities) 
    101119         u_ice(:,:) = rn_uice * umask(:,:,1) 
    102120         v_ice(:,:) = rn_vice * vmask(:,:,1) 
    103121         !!CALL RANDOM_NUMBER(u_ice(:,:)) 
    104122         !!CALL RANDOM_NUMBER(v_ice(:,:)) 
     123         CALL ice_adv   ( kt )                            ! -- advection of ice 
    105124 
    106125      END SELECT 
     
    110129   END SUBROUTINE ice_dyn 
    111130 
     131   SUBROUTINE Hbig( phmax ) 
     132      !!------------------------------------------------------------------- 
     133      !!                  ***  ROUTINE Hbig  *** 
     134      !! 
     135      !! ** Purpose : Thickness correction in case advection scheme creates 
     136      !!              abnormally tick ice 
     137      !! 
     138      !! ** Method  : 1- check whether ice thickness resulting from advection is 
     139      !!                 larger than the surrounding 9-points before advection 
     140      !!                 and reduce it if a) divergence or b) convergence & at_i>0.8 
     141      !!              2- bound ice thickness with hi_max (99m) 
     142      !! 
     143      !! ** input   : Max thickness of the surrounding 9-points 
     144      !!------------------------------------------------------------------- 
     145      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   phmax   ! max ice thick from surrounding 9-pts 
     146      ! 
     147      INTEGER  ::   ji, jj, jl         ! dummy loop indices 
     148      REAL(wp) ::   zh, zdv 
     149      !!------------------------------------------------------------------- 
     150      ! 
     151      CALL ice_var_zapsmall                       !-- zap small areas 
     152      ! 
     153      DO jl = 1, jpl 
     154         DO jj = 1, jpj 
     155            DO ji = 1, jpi 
     156               IF ( v_i(ji,jj,jl) > 0._wp ) THEN  !-- bound to hmax 
     157                  ! 
     158                  zh  = v_i (ji,jj,jl) / a_i(ji,jj,jl) 
     159                  zdv = v_i(ji,jj,jl) - v_i_b(ji,jj,jl)   
     160                  ! 
     161                  IF ( ( zdv >  0.0 .AND. zh > phmax(ji,jj,jl) .AND. at_i_b(ji,jj) < 0.80 ) .OR. & 
     162                     & ( zdv <= 0.0 .AND. zh > phmax(ji,jj,jl) ) ) THEN 
     163                     a_i (ji,jj,jl) = v_i(ji,jj,jl) / MIN( phmax(ji,jj,jl), hi_max(jpl) )   !-- bound ht_i to hi_max (99 m) 
     164                  ENDIF 
     165                  ! 
     166               ENDIF 
     167            END DO 
     168         END DO 
     169      END DO 
     170             
     171      IF ( nn_pnd_scheme > 0 ) THEN               !-- correct pond fraction to avoid a_ip > a_i 
     172         WHERE( a_ip(:,:,:) > a_i(:,:,:) )   a_ip(:,:,:) = a_i(:,:,:) 
     173      ENDIF 
     174      ! 
     175   END SUBROUTINE Hbig 
     176 
     177   SUBROUTINE Hpiling 
     178      !!------------------------------------------------------------------- 
     179      !!                  ***  ROUTINE Hpiling  *** 
     180      !! 
     181      !! ** Purpose : Simple conservative piling comparable with 1-cat models 
     182      !! 
     183      !! ** Method  : pile-up ice when no ridging/rafting 
     184      !! 
     185      !! ** input   : a_i 
     186      !!------------------------------------------------------------------- 
     187      INTEGER ::   jl         ! dummy loop indices 
     188      !!------------------------------------------------------------------- 
     189      ! 
     190      CALL ice_var_zapsmall                       !-- zap small areas 
     191      ! 
     192      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     193      DO jl = 1, jpl 
     194         WHERE( at_i(:,:) > epsi20 ) 
     195            a_i(:,:,jl) = a_i(:,:,jl) * (  1._wp + MIN( rn_amax_2d(:,:) - at_i(:,:) , 0._wp ) / at_i(:,:)  ) 
     196         END WHERE 
     197      END DO 
     198      ! 
     199   END SUBROUTINE Hpiling 
    112200 
    113201   SUBROUTINE ice_dyn_init 
     
    123211      !! ** input   :   Namelist namice_dyn 
    124212      !!------------------------------------------------------------------- 
    125       INTEGER ::   ios   ! Local integer output status for namelist read 
    126       !! 
    127       NAMELIST/namice_dyn/ ln_icedyn  , nn_icedyn, rn_uice  , rn_vice ,    & 
     213      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read 
     214      !! 
     215      NAMELIST/namice_dyn/ ln_dynFULL, ln_dynRHGADV, ln_dynADV, rn_uice, rn_vice,  & 
    128216         &                 rn_ishlat  , rn_cio   ,                         & 
    129217         &                 ln_landfast, rn_gamma , rn_icebfr, rn_lfrelax 
     
    144232         WRITE(numout,*) '~~~~~~~~~~~~' 
    145233         WRITE(numout,*) '   Namelist namice_dyn' 
    146          WRITE(numout,*) '      Ice dynamics       (T) or not (F)                         ln_icedyn  = ', ln_icedyn 
    147          WRITE(numout,*) '         associated switch                                      nn_icedyn  = ', nn_icedyn 
    148          WRITE(numout,*) '            =2 all processes (default option)' 
    149          WRITE(numout,*) '            =1 advection only (no ridging/rafting)' 
    150          WRITE(numout,*) '            =0 advection only with prescribed velocity given by ' 
     234         WRITE(numout,*) '      Full ice dynamics      (rhg + adv + ridge/raft + corr)  ln_dynFULL   = ', ln_dynFULL 
     235         WRITE(numout,*) '      No ridge/raft & No cor (rhg + adv)                      ln_dynRHGADV = ', ln_dynRHGADV 
     236         WRITE(numout,*) '      Advection only         (rn_uvice + adv)                 ln_dynADV    = ', ln_dynADV 
     237         WRITE(numout,*) '           with prescribed velocity given by ' 
    151238         WRITE(numout,*) '               a uniform field               (u,v)_ice = (rn_uice,rn_vice) = (', rn_uice,',', rn_vice,')' 
    152239         WRITE(numout,*) '      lateral boundary condition for sea ice dynamics        rn_ishlat     = ', rn_ishlat 
     
    158245      ENDIF 
    159246      !                             !== set the choice of ice dynamics ==! 
    160       SELECT CASE( nn_icedyn ) 
    161       CASE( 2 )                     
    162          IF( nn_monocat /= 2 ) THEN          !--- full dynamics (rheology + advection + ridging/rafting + correction) 
    163             nice_dyn = np_dynFULL 
    164          ELSE 
    165             nice_dyn = np_dyn                !--- dynamics without ridging/rafting 
    166          ENDIF 
    167       CASE( 1 )                              !--- dynamics without ridging/rafting and correction  
    168          nice_dyn = np_dynPURE 
    169       CASE( 0 )                              !--- prescribed ice velocities (from namelist)  
    170          nice_dyn = np_dynNO 
    171       END SELECT 
     247      ioptio = 0  
     248      !      !--- full dynamics                               (rheology + advection + ridging/rafting + correction) 
     249      IF( ln_dynFULL .AND. nn_monocat /= 2 ) THEN   ;   ioptio = ioptio + 1   ;   nice_dyn = np_dynFULL      ;   ENDIF 
     250      !      !--- dynamics without ridging/rafting            (rheology + advection                   + correction) 
     251      IF( ln_dynFULL .AND. nn_monocat == 2 ) THEN   ;   ioptio = ioptio + 1   ;   nice_dyn = np_dynRHGADV1   ;   ENDIF 
     252      !      !--- dynamics without ridging/rafting and corr   (rheology + advection) 
     253      IF( ln_dynRHGADV                     ) THEN   ;   ioptio = ioptio + 1   ;   nice_dyn = np_dynRHGADV2   ;   ENDIF 
     254      !      !--- advection only with prescribed ice velocities (from namelist) 
     255      IF( ln_dynADV                        ) THEN   ;   ioptio = ioptio + 1   ;   nice_dyn = np_dynADV       ;   ENDIF 
     256      ! 
     257      IF( ioptio /= 1 )    CALL ctl_stop( 'ice_dyn_init: one and only one ice dynamics option has to be defined ' ) 
    172258      ! 
    173259      !                                      !--- Lateral boundary conditions 
     
    177263      ELSEIF ( 2. < rn_ishlat                      ) THEN   ;   IF(lwp) WRITE(numout,*) '   ===>>>   ice lateral  strong-slip' 
    178264      ENDIF 
    179       ! 
    180265      !                                      !--- NO Landfast ice : set to zero once for all 
    181266      IF( .NOT. ln_landfast )   tau_icebfr(:,:) = 0._wp  
    182267      ! 
    183       !                                      !--- simple conservative piling, comparable with LIM2 
    184       l_piling = nn_icedyn == 1 .OR. ( nn_monocat == 2  .AND.  jpl == 1 ) 
    185       ! 
    186268   END SUBROUTINE ice_dyn_init 
    187269 
Note: See TracChangeset for help on using the changeset viewer.