Changeset 8517 for branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icerhg.F90

Timestamp:

2017-09-12T20:46:13+02:00 (7 years ago)

Author:

clem

Message:

changes in style - part6 - one more round

File:

• branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icerhg.F90 (modified) (5 diffs)

branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icerhg.F90

@@ -32 +32 @@
    PUBLIC   ice_rhg        ! called by icestp.F90
    PUBLIC   ice_rhg_init   ! called by icestp.F90
+
+   INTEGER ::              nice_rhg   ! choice of the type of rheology
+   !                                        ! associated indices:
+   INTEGER, PARAMETER ::   np_rhgEVP = 1   ! EVP rheology
+!! INTEGER, PARAMETER ::   np_rhgEAP = 2   ! EAP rheology
    
    !! * Substitutions
@@ -53 +58 @@
       !!--------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt     ! ice time step
-      !!
-      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
       !!--------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('icerhg')
+      ! controls
+      IF( nn_timing == 1 )   CALL timing_start('icerhg')                                                             ! timing
+      IF( ln_icediachk   )   CALL ice_cons_hsm(0, 'icerhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
       !
       IF( kt == nit000 .AND. lwp ) THEN
@@ -64 +68 @@
          WRITE(numout,*)'~~~~~~~'
       ENDIF
-      !                             ! -- conservation test
-      IF( ln_icediachk   )   CALL ice_cons_hsm(0, 'icerhg', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
-      ! -----------------------
-      ! Rheology (ice dynamics)
-      ! -----------------------   
-      CALL ice_rhg_evp( kt, stress1_i, stress2_i, stress12_i, u_ice, v_ice, shear_i, divu_i, delta_i )
+      ! --------
+      ! Rheology
+      ! --------   
+      SELECT CASE( nice_rhg )
+      !                                !------------------------!
+      CASE( np_rhgEVP )                ! Elasto-Viscous-Plastic !
+         !                             !------------------------!
+         CALL ice_rhg_evp( kt, stress1_i, stress2_i, stress12_i, u_ice, v_ice, shear_i, divu_i, delta_i )
+
+      END SELECT
       !
-      !                             !- conservation test
-      IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'icerhg', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
-      IF( ln_ctl         )   CALL ice_prt3D  ('icerhg')   !- Control prints
-      IF( nn_timing == 1 )   CALL timing_stop('icerhg')   !- timing
+      ! controls
+      IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'icerhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
+      IF( ln_ctl         )   CALL ice_prt3D   ('icerhg')                                                             ! prints
+      IF( nn_timing == 1 )   CALL timing_stop ('icerhg')                                                             ! timing
       !
    END SUBROUTINE ice_rhg
@@ -92 +100 @@
       !! ** input   :   Namelist namice_rhg
       !!-------------------------------------------------------------------
-      INTEGER ::   ios   ! Local integer output status for namelist read
+      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read
       !!
       NAMELIST/namice_rhg/  ln_rhg_EVP, rn_creepl, rn_ecc , nn_nevp, rn_relast
@@ -118 +126 @@
       ENDIF
       !
+      !                             !== set the choice of ice advection ==!
+      ioptio = 0 
+      IF( ln_rhg_EVP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEVP    ;   ENDIF
+!!    IF( ln_rhg_EAP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEAP    ;   ENDIF
+      IF( ioptio /= 1 )   CALL ctl_stop( 'ice_rhg_init: choose one and only one ice rheology' )
+
+     !                              ! allocate tke arrays
+!!clem example      IF( zdf_tke_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_tke_init : unable to allocate arrays' )
+      !
    END SUBROUTINE ice_rhg_init