New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 2528 for trunk/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90 – NEMO

Ignore:
Timestamp:
2010-12-27T18:33:53+01:00 (13 years ago)
Author:
rblod
Message:

Update NEMOGCM from branch nemo_v3_3_beta

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90

    • Property svn:eol-style deleted
    r1694 r2528  
    44   !!   Sea-Ice dynamics :   
    55   !!====================================================================== 
    6    !! History :   1.0  !  01-04  (LIM)  Original code 
    7    !!             2.0  !  02-08  (C. Ethe, G. Madec)  F90, mpp 
    8    !!             2.0  !  03-08  (C. Ethe) add lim_dyn_init 
    9    !!             2.0  !  06-07  (G. Madec)  Surface module 
     6   !! History :  1.0  ! 2001-04  (LIM)  Original code 
     7   !!            2.0  ! 2002-08  (C. Ethe, G. Madec)  F90, mpp 
     8   !!            2.0  ! 2003-08  (C. Ethe) add lim_dyn_init 
     9   !!            2.0  ! 2006-07  (G. Madec)  Surface module 
     10   !!            3.3  ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case 
    1011   !!--------------------------------------------------------------------- 
    1112#if defined key_lim2 
     
    1617   !!    lim_dyn_init_2 : initialization and namelist read 
    1718   !!---------------------------------------------------------------------- 
    18    USE dom_oce        ! ocean space and time domain 
    19    USE sbc_oce        ! 
    20    USE phycst         ! 
    21    USE ice_2          ! 
    22    USE dom_ice_2      ! 
    23    USE limistate_2    ! 
    24    USE limrhg_2       ! ice rheology 
    25  
    26    USE lbclnk         ! 
    27    USE lib_mpp        ! 
    28    USE in_out_manager ! I/O manager 
    29    USE prtctl         ! Print control 
     19   USE dom_oce          ! ocean space and time domain 
     20   USE sbc_oce          ! ocean surface boundary condition 
     21   USE phycst           ! physical constant 
     22   USE ice_2            ! LIM-2: ice variables 
     23   USE sbc_ice          ! Surface boundary condition: sea-ice fields 
     24   USE dom_ice_2        ! LIM-2: ice domain 
     25   USE limistate_2      ! LIM-2: initial state 
     26   USE limrhg_2         ! LIM-2: VP  ice rheology 
     27   USE limrhg           ! LIM  : EVP ice rheology 
     28   USE lbclnk           ! lateral boundary condition - MPP link 
     29   USE lib_mpp          ! MPP library 
     30   USE in_out_manager   ! I/O manager 
     31   USE prtctl           ! Print control 
    3032 
    3133   IMPLICIT NONE 
    3234   PRIVATE 
    3335 
    34    PUBLIC   lim_dyn_2 ! routine called by sbc_ice_lim 
    35  
    36    !! * Module variables 
    37    REAL(wp)  ::  rone    = 1.e0   ! constant value 
    38  
     36   PUBLIC   lim_dyn_2   ! routine called by sbc_ice_lim 
     37 
     38   !! * Substitutions 
    3939#  include "vectopt_loop_substitute.h90" 
    4040   !!---------------------------------------------------------------------- 
    41    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006)  
     41   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    4242   !! $Id$ 
    43    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    44    !!---------------------------------------------------------------------- 
    45  
     43   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     44   !!---------------------------------------------------------------------- 
    4645CONTAINS 
    4746 
     
    8382         ! --------------------------------------------------- 
    8483          
    85          IF( lk_mpp .OR. nbit_cmp == 1 ) THEN                    ! mpp: compute over the whole domain 
     84         IF( lk_mpp .OR. lk_mpp_rep ) THEN                    ! mpp: compute over the whole domain 
    8685            i_j1 = 1    
    8786            i_jpj = jpj 
    8887            IF(ln_ctl)   CALL prt_ctl_info( 'lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 
    89             CALL lim_rhg_2( i_j1, i_jpj ) 
     88            IF( lk_lim2_vp )   THEN   ;   CALL lim_rhg_2( i_j1, i_jpj )             !  VP rheology 
     89            ELSE                      ;   CALL lim_rhg  ( i_j1, i_jpj )             ! EVP rheology 
     90            ENDIF 
    9091            ! 
    9192         ELSE                                 ! optimization of the computational area 
     
    105106                  i_j1 = i_j1 + 1 
    106107               END DO 
    107                i_j1 = MAX( 1, i_j1-1 ) 
    108                IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    109                !  
    110                CALL lim_rhg_2( i_j1, i_jpj ) 
    111                !  
     108               IF( lk_lim2_vp )   THEN             ! VP  rheology 
     109                  i_j1 = MAX( 1, i_j1-1 ) 
     110                  CALL lim_rhg_2( i_j1, i_jpj ) 
     111               ELSE                                ! EVP rheology 
     112                  i_j1 = MAX( 1, i_j1-2 ) 
     113                  CALL lim_rhg( i_j1, i_jpj ) 
     114               ENDIF 
     115               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, 'ij_jpj = ', i_jpj 
     116               ! 
    112117               ! Southern hemisphere 
    113118               i_j1  =  1  
     
    116121                  i_jpj = i_jpj - 1 
    117122               END DO 
    118                i_jpj = MIN( jpj, i_jpj+2 ) 
    119                IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    120                !  
    121                CALL lim_rhg_2( i_j1, i_jpj ) 
    122                !  
     123               IF( lk_lim2_vp )   THEN             ! VP  rheology 
     124                  i_jpj = MIN( jpj, i_jpj+2 ) 
     125                  CALL lim_rhg_2( i_j1, i_jpj ) 
     126               ELSE                                ! EVP rheology 
     127                  i_jpj = MIN( jpj, i_jpj+1 ) 
     128                  CALL lim_rhg( i_j1, i_jpj ) 
     129               ENDIF 
     130               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, 'ij_jpj = ', i_jpj 
     131               ! 
    123132            ELSE                                 ! local domain extends over one hemisphere only 
    124133               !                                 ! Rheology is computed only over the ice cover 
     
    134143                  i_jpj = i_jpj - 1 
    135144               END DO 
    136                i_jpj = MIN( jpj, i_jpj+2) 
    137      
     145               i_jpj = MIN( jpj, i_jpj+2 ) 
     146               !  
     147               IF( lk_lim2_vp )   THEN             ! VP  rheology 
     148                  i_jpj = MIN( jpj, i_jpj+2 ) 
     149                  CALL lim_rhg_2( i_j1, i_jpj )                !  VP rheology 
     150               ELSE                                ! EVP rheology 
     151                  i_j1  = MAX( 1  , i_j1-2  ) 
     152                  i_jpj = MIN( jpj, i_jpj+1 ) 
     153                  CALL lim_rhg  ( i_j1, i_jpj )                ! EVP rheology 
     154               ENDIF 
    138155               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : one hemisphere: i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    139                !  
    140                CALL lim_rhg_2( i_j1, i_jpj ) 
    141156               ! 
    142157            ENDIF 
     
    148163         ! computation of friction velocity 
    149164         ! -------------------------------- 
    150          ! ice-ocean velocity at U & V-points (u_ice v_ice at I-point ; ssu_m, ssv_m at U- & V-points) 
    151           
    152          DO jj = 1, jpjm1 
    153             DO ji = 1, jpim1   ! NO vector opt. 
    154                zu_io(ji,jj) = 0.5 * ( u_ice(ji+1,jj+1) + u_ice(ji+1,jj  ) ) - ssu_m(ji,jj) 
    155                zv_io(ji,jj) = 0.5 * ( v_ice(ji+1,jj+1) + v_ice(ji  ,jj+1) ) - ssv_m(ji,jj) 
    156             END DO 
    157          END DO 
     165         SELECT CASE( cp_ice_msh )           ! ice-ocean relative velocity at u- & v-pts 
     166         CASE( 'C' )                               ! EVP : C-grid ice dynamics 
     167            zu_io(:,:) = u_ice(:,:) - ssu_m(:,:)           ! ice-ocean & ice velocity at ocean velocity points 
     168            zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
     169         CASE( 'I' )                               ! VP  : B-grid ice dynamics (I-point)  
     170            DO jj = 1, jpjm1                               ! u_ice v_ice at I-point ; ssu_m, ssv_m at U- & V-points 
     171               DO ji = 1, jpim1   ! NO vector opt.         ! 
     172                  zu_io(ji,jj) = 0.5_wp * ( u_ice(ji+1,jj+1) + u_ice(ji+1,jj  ) ) - ssu_m(ji,jj) 
     173                  zv_io(ji,jj) = 0.5_wp * ( v_ice(ji+1,jj+1) + v_ice(ji  ,jj+1) ) - ssv_m(ji,jj) 
     174               END DO 
     175            END DO 
     176         END SELECT 
     177 
    158178         ! frictional velocity at T-point 
     179         zcoef = 0.5_wp * cw 
    159180         DO jj = 2, jpjm1 
    160181            DO ji = 2, jpim1   ! NO vector opt. because of zu_io 
    161                ust2s(ji,jj) = 0.5 * cw                                                          & 
    162                   &         * (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
    163                   &            + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1)   ) * tms(ji,jj) 
     182               ust2s(ji,jj) = zcoef * (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
     183                  &                    + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1)   ) * tms(ji,jj) 
    164184            END DO 
    165185         END DO 
     
    170190         DO jj = 2, jpjm1 
    171191            DO ji = fs_2, fs_jpim1   ! vector opt. 
    172                ust2s(ji,jj) = zcoef * tms(ji,jj) * SQRT(  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
    173                   &                                     + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) 
     192               ust2s(ji,jj) = zcoef * SQRT(  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
     193                  &                        + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1)   ) * tms(ji,jj) 
    174194            END DO 
    175195         END DO 
     
    180200      ! 
    181201      IF(ln_ctl)   CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn  : ust2s :') 
    182  
     202      ! 
    183203   END SUBROUTINE lim_dyn_2 
    184204 
     
    198218      NAMELIST/namicedyn/ epsd, alpha,     & 
    199219         &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   & 
    200          &                c_rhg, etamn, creepl, ecc, ahi0 
     220         &                c_rhg, etamn, creepl, ecc, ahi0,                  & 
     221         &                nevp, telast,alphaevp 
    201222      !!------------------------------------------------------------------- 
    202223 
     
    223244         WRITE(numout,*) '       eccentricity of the elliptical yield curve       ecc    = ', ecc 
    224245         WRITE(numout,*) '       horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0 
     246         WRITE(numout,*) '       number of iterations for subcycling nevp   = ', nevp 
     247         WRITE(numout,*) '       timescale for elastic waves telast = ', telast 
     248         WRITE(numout,*) '       coefficient for the solution of int. stresses alphaevp = ', alphaevp 
     249      ENDIF 
     250      ! 
     251      IF( angvg /= 0._wp .AND. .NOT.lk_lim2_vp ) THEN 
     252         CALL ctl_warn( 'lim_dyn_init_2: turning angle for oceanic stress not properly coded for EVP ',   & 
     253            &           '(see limsbc_2 module). We force  angvg = 0._wp'  ) 
     254         angvg = 0._wp 
    225255      ENDIF 
    226256 
Note: See TracChangeset for help on using the changeset viewer.