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/icerhg.F90

    r8516 r8517  
    3232   PUBLIC   ice_rhg        ! called by icestp.F90 
    3333   PUBLIC   ice_rhg_init   ! called by icestp.F90 
     34 
     35   INTEGER ::              nice_rhg   ! choice of the type of rheology 
     36   !                                        ! associated indices: 
     37   INTEGER, PARAMETER ::   np_rhgEVP = 1   ! EVP rheology 
     38!! INTEGER, PARAMETER ::   np_rhgEAP = 2   ! EAP rheology 
    3439    
    3540   !! * Substitutions 
     
    5358      !!-------------------------------------------------------------------- 
    5459      INTEGER, INTENT(in) ::   kt     ! ice time step 
    55       !! 
    56       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    5760      !!-------------------------------------------------------------------- 
    58       ! 
    59       IF( nn_timing == 1 )  CALL timing_start('icerhg') 
     61      ! controls 
     62      IF( nn_timing == 1 )   CALL timing_start('icerhg')                                                             ! timing 
     63      IF( ln_icediachk   )   CALL ice_cons_hsm(0, 'icerhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
    6064      ! 
    6165      IF( kt == nit000 .AND. lwp ) THEN 
     
    6468         WRITE(numout,*)'~~~~~~~' 
    6569      ENDIF 
    66       !                             ! -- conservation test 
    67       IF( ln_icediachk   )   CALL ice_cons_hsm(0, 'icerhg', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    6870 
    69       ! ----------------------- 
    70       ! Rheology (ice dynamics) 
    71       ! -----------------------    
    72       CALL ice_rhg_evp( kt, stress1_i, stress2_i, stress12_i, u_ice, v_ice, shear_i, divu_i, delta_i ) 
     71      ! -------- 
     72      ! Rheology 
     73      ! --------    
     74      SELECT CASE( nice_rhg ) 
     75      !                                !------------------------! 
     76      CASE( np_rhgEVP )                ! Elasto-Viscous-Plastic ! 
     77         !                             !------------------------! 
     78         CALL ice_rhg_evp( kt, stress1_i, stress2_i, stress12_i, u_ice, v_ice, shear_i, divu_i, delta_i ) 
     79 
     80      END SELECT 
    7381      ! 
    74       !                             !- conservation test 
    75       IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'icerhg', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    76       IF( ln_ctl         )   CALL ice_prt3D  ('icerhg')   !- Control prints 
    77       IF( nn_timing == 1 )   CALL timing_stop('icerhg')   !- timing 
     82      ! controls 
     83      IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'icerhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
     84      IF( ln_ctl         )   CALL ice_prt3D   ('icerhg')                                                             ! prints 
     85      IF( nn_timing == 1 )   CALL timing_stop ('icerhg')                                                             ! timing 
    7886      ! 
    7987   END SUBROUTINE ice_rhg 
     
    92100      !! ** input   :   Namelist namice_rhg 
    93101      !!------------------------------------------------------------------- 
    94       INTEGER ::   ios   ! Local integer output status for namelist read 
     102      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read 
    95103      !! 
    96104      NAMELIST/namice_rhg/  ln_rhg_EVP, rn_creepl, rn_ecc , nn_nevp, rn_relast 
     
    118126      ENDIF 
    119127      ! 
     128      !                             !== set the choice of ice advection ==! 
     129      ioptio = 0  
     130      IF( ln_rhg_EVP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEVP    ;   ENDIF 
     131!!    IF( ln_rhg_EAP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEAP    ;   ENDIF 
     132      IF( ioptio /= 1 )   CALL ctl_stop( 'ice_rhg_init: choose one and only one ice rheology' ) 
     133 
     134     !                              ! allocate tke arrays 
     135!!clem example      IF( zdf_tke_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_tke_init : unable to allocate arrays' ) 
     136      ! 
    120137   END SUBROUTINE ice_rhg_init 
    121138 
Note: See TracChangeset for help on using the changeset viewer.