Changeset 6736 for branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

Timestamp:

2016-06-24T09:50:27+02:00 (8 years ago)

Author:

jamesharle

Message:

FASTNEt code modifications

File:

• branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90 (modified) (14 diffs)

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

@@ -8 +8 @@
    !!             -   !  2008-11  (M. Vancoppenolle, S. Bouillon, Y. Aksenov) add surface tilt in ice rheolohy 
    !!            3.3  !  2009-05  (G.Garric) addition of the lim2_evp cas
-   !!            3.4  !  2011-01  (A. Porter)  dynamical allocation 
-   !!            3.5  !  2012-08  (R. Benshila)  AGRIF 
+   !!            3.4  !  2011-01  (A Porter)  dynamical allocation 
    !!----------------------------------------------------------------------
 #if defined key_lim3 || (  defined key_lim2 && ! defined key_lim2_vp )
@@ -16 +15 @@
    !!   'key_lim2' AND NOT 'key_lim2_vp'            EVP LIM-2 sea-ice model
    !!----------------------------------------------------------------------
-   !!   lim_rhg       : computes ice velocities
+   !!   lim_rhg   : computes ice velocities
    !!----------------------------------------------------------------------
-   USE phycst         ! Physical constant
-   USE oce     , ONLY :  snwice_mass, snwice_mass_b
-   USE par_oce        ! Ocean parameters
-   USE dom_oce        ! Ocean domain
-   USE sbc_oce        ! Surface boundary condition: ocean fields
-   USE sbc_ice        ! Surface boundary condition: ice fields
+   USE phycst           ! Physical constant
+   USE par_oce          ! Ocean parameters
+   USE dom_oce          ! Ocean domain
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice fields
+   USE lbclnk           ! Lateral Boundary Condition / MPP link
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE in_out_manager   ! I/O manager
+   USE prtctl           ! Print control
+   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
 #if defined key_lim3
-   USE ice            ! LIM-3: ice variables
-   USE dom_ice        ! LIM-3: ice domain
-   USE limitd_me      ! LIM-3: 
+   USE ice              ! LIM-3: ice variables
+   USE dom_ice          ! LIM-3: ice domain
+   USE limitd_me        ! LIM-3: 
 #else
-   USE ice_2          ! LIM-2: ice variables
-   USE dom_ice_2      ! LIM-2: ice domain
-#endif
-   USE lbclnk         ! Lateral Boundary Condition / MPP link
-   USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! work arrays
-   USE in_out_manager ! I/O manager
-   USE prtctl         ! Print control
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-#if defined key_agrif && defined key_lim2
-   USE agrif_lim2_interp
+   USE ice_2            ! LIM2: ice variables
+   USE dom_ice_2        ! LIM2: ice domain
 #endif
 
@@ -130 +125 @@
       REAL(wp) ::   zindb         ! ice (1) or not (0)      
       REAL(wp) ::   zdummy        ! dummy argument
-      REAL(wp) ::   zintb, zintn  ! dummy argument
 
       REAL(wp), POINTER, DIMENSION(:,:) ::   zpresh           ! temporary array for ice strength
@@ -152 +146 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   zs12             ! Non-diagonal stress tensor component zs12
       REAL(wp), POINTER, DIMENSION(:,:) ::   zu_ice, zv_ice, zresr   ! Local error on velocity
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zpice            ! array used for the calculation of ice surface slope:
-                                                              !   ocean surface (ssh_m) if ice is not embedded
-                                                              !   ice top surface if ice is embedded   
       !!-------------------------------------------------------------------
 
@@ -160 +151 @@
       CALL wrk_alloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                )
       CALL wrk_alloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds  , zdst  )
-      CALL wrk_alloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
+      CALL wrk_alloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr                         )
 
 #if  defined key_lim2 && ! defined key_lim2_vp
@@ -171 +162 @@
 # endif
      at_i(:,:) = 1. - frld(:,:)
-#endif
-#if defined key_agrif && defined key_lim2 
-    CALL agrif_rhg_lim2_load      ! First interpolation of coarse values
 #endif
       !
@@ -244 +232 @@
       !  v_oce2: ocean v component on v points                        
 
-      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==!
-          !                                            
-          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
-          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
-         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp     
-          !
-          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
-          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
-         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
-          !
-         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0
-          !
-      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==!
-         zpice(:,:) = ssh_m(:,:)
-      ENDIF
-
       DO jj = k_j1+1, k_jpj-1
          DO ji = fs_2, fs_jpim1
@@ -302 +274 @@
             ! include it later
 
-            zdsshx =  ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj)
-            zdsshy =  ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj)
+            zdsshx =  ( ssh_m(ji+1,jj) - ssh_m(ji,jj) ) / e1u(ji,jj)
+            zdsshy =  ( ssh_m(ji,jj+1) - ssh_m(ji,jj) ) / e2v(ji,jj)
 
             za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx
@@ -520 +492 @@
 
             CALL lbc_lnk( u_ice(:,:), 'U', -1. )
-#if defined key_agrif
-            CALL agrif_rhg_lim2( jter, nevp, 'U' )
-#endif
 
 !CDIR NOVERRCHK
@@ -548 +517 @@
 
             CALL lbc_lnk( v_ice(:,:), 'V', -1. )
-#if defined key_agrif
-            CALL agrif_rhg_lim2( jter, nevp, 'V' )
-#endif
 
          ELSE 
@@ -577 +543 @@
 
             CALL lbc_lnk( v_ice(:,:), 'V', -1. )
-#if defined key_agrif
-            CALL agrif_rhg_lim2( jter, nevp , 'V' )
-#endif
 
 !CDIR NOVERRCHK
@@ -608 +571 @@
 
             CALL lbc_lnk( u_ice(:,:), 'U', -1. )
-#if defined key_agrif
-            CALL agrif_rhg_lim2( jter, nevp, 'U' )
-#endif
 
          ENDIF
@@ -651 +611 @@
       CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
       CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
-#if defined key_agrif
-      CALL agrif_rhg_lim2( nevp , nevp, 'U' )
-      CALL agrif_rhg_lim2( nevp , nevp, 'V' )
-#endif
 
       DO jj = k_j1+1, k_jpj-1 
@@ -790 +746 @@
       CALL wrk_dealloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                )
       CALL wrk_dealloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds  , zdst  )
-      CALL wrk_dealloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
+      CALL wrk_dealloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr                         )
 
    END SUBROUTINE lim_rhg