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 1855 for branches/DEV_r1837_mass_heat_salt_fluxes/NEMO/LIM_SRC_2/limtrp_2.F90 – NEMO

Ignore:
Timestamp:
2010-04-30T17:49:04+02:00 (14 years ago)
Author:
gm
Message:

ticket:#665 style change only, with the suppression of thd_ice_2 (merged in ice_2)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/DEV_r1837_mass_heat_salt_fluxes/NEMO/LIM_SRC_2/limtrp_2.F90

    r1715 r1855  
    44   !! LIM 2.0 transport ice model : sea-ice advection/diffusion 
    55   !!====================================================================== 
     6   !! History :  LIM  ! 2000-01 (LIM)  Original code 
     7   !!            1.0  ! 2001-05 (G. Madec, R. Hordoir) opa norm 
     8   !!            2.0  ! 2004-01 (G. Madec, C. Ethe)  F90, mpp 
     9   !!---------------------------------------------------------------------- 
    610#if defined key_lim2 
    711   !!---------------------------------------------------------------------- 
     
    1115   !!   lim_trp_init_2 : initialization and namelist read 
    1216   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    1417   USE phycst 
    1518   USE dom_oce 
     
    2629   PRIVATE 
    2730 
    28    !! * Routine accessibility 
    29    PUBLIC lim_trp_2     ! called by sbc_ice_lim_2 
    30  
    31    !! * Shared module variables 
    32    REAL(wp), PUBLIC  ::   &  !: 
    33       bound  = 0.e0          !: boundary condit. (0.0 no-slip, 1.0 free-slip) 
    34  
    35    !! * Module variables 
    36    REAL(wp)  ::           &  ! constant values 
    37       epsi06 = 1.e-06  ,  & 
    38       epsi03 = 1.e-03  ,  & 
    39       epsi16 = 1.e-16  ,  & 
    40       rzero  = 0.e0    ,  & 
    41       rone   = 1.e0 
     31   PUBLIC   lim_trp_2   ! called by sbc_ice_lim_2 
     32 
     33   REAL(wp), PUBLIC  ::   bound  = 0.e0   !: boundary condit. (0.0 no-slip, 1.0 free-slip) 
     34 
     35   REAL(wp) ::   epsi06 = 1.e-06   ! constant values 
     36   REAL(wp) ::   epsi03 = 1.e-03   ! 
     37   REAL(wp) ::   epsi16 = 1.e-16   ! 
     38   REAL(wp) ::   rzero  = 0.e0     ! 
     39   REAL(wp) ::   rone   = 1.e0     ! 
    4240 
    4341   !! * Substitution 
    4442#  include "vectopt_loop_substitute.h90" 
    4543   !!---------------------------------------------------------------------- 
    46    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
     44   !! NEMO/LIM 3.3,  UCL-LOCEAN-IPSL (2010)  
    4745   !! $Id$ 
    48    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     46   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4947   !!---------------------------------------------------------------------- 
    5048 
     
    6260      !! 
    6361      !! ** action : 
    64       !! 
    65       !! History : 
    66       !!   1.0  !  00-01 (LIM)  Original code 
    67       !!        !  01-05 (G. Madec, R. Hordoir) opa norm 
    68       !!   2.0  !  04-01 (G. Madec, C. Ethe)  F90, mpp 
    6962      !!--------------------------------------------------------------------- 
    7063      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    71  
    72       INTEGER  ::   ji, jj, jk,   &  ! dummy loop indices 
    73          &          initad           ! number of sub-timestep for the advection 
    74  
    75       REAL(wp) ::  &                               
    76          zindb  ,  & 
    77          zacrith, & 
    78          zindsn , & 
    79          zindic , & 
    80          zusvosn, & 
    81          zusvoic, & 
    82          zignm  , & 
    83          zindhe , & 
    84          zvbord , & 
    85          zcfl   , & 
    86          zusnit , & 
    87          zrtt, ztsn, ztic1, ztic2 
    88  
    89       REAL(wp), DIMENSION(jpi,jpj)  ::   &  ! temporary workspace 
    90          zui_u , zvi_v , zsm   ,         & 
    91          zs0ice, zs0sn , zs0a  ,         & 
    92          zs0c0 , zs0c1 , zs0c2 ,         & 
    93          zs0st 
     64      !! 
     65      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     66      INTEGER  ::   initad       ! number of sub-timestep for the advection 
     67      REAL(wp) ::   zindb , zacrith, zindsn , zignm , zvbord, zrtt, ztic1, zusnit 
     68      REAL(wp) ::   zindic, zusvosn, zusvoic, zindhe, zcfl  , ztsn, ztic2 
     69      REAL(wp), DIMENSION(jpi,jpj) ::   zui_u , zs0sn, zs0c0, zs0a , zsm      ! 2D workspace 
     70      REAL(wp), DIMENSION(jpi,jpj) ::   zvi_v , zs0st, zs0c1, zs0c2, zs0ice   !  -      - 
    9471      !--------------------------------------------------------------------- 
    9572 
     
    9875      zsm(:,:) = area(:,:) 
    9976       
    100       IF( ln_limdyn ) THEN 
    101          !-------------------------------------! 
    102          !   Advection of sea ice properties   ! 
    103          !-------------------------------------! 
     77      !                             !-------------------------------------! 
     78      IF( ln_limdyn ) THEN          !   Advection of sea ice properties   ! 
     79         !                          !-------------------------------------! 
    10480 
    10581         ! ice velocities at ocean U- and V-points (zui_u,zvi_v) 
     
    11389            END DO 
    11490         END DO 
    115          ! Lateral boundary conditions on zui_u, zvi_v 
    116          CALL lbc_lnk( zui_u, 'U', -1. ) 
    117          CALL lbc_lnk( zvi_v, 'V', -1. ) 
     91         CALL lbc_lnk( zui_u, 'U', -1. )   ;   CALL lbc_lnk( zvi_v, 'V', -1. )         ! Lateral boundary conditions 
    11892 
    11993         ! CFL test for stability 
     
    12397         zcfl  = MAX( zcfl, MAXVAL( ABS( zvi_v( :     ,1:jpjm1) ) * rdt_ice / e2v( :     ,1:jpjm1) ) ) 
    12498 
    125          IF (lk_mpp ) CALL mpp_max(zcfl) 
    126  
    127          IF ( zcfl > 0.5 .AND. lwp )   WRITE(numout,*) 'lim_trp_2 : violation of cfl criterion the ',nday,'th day, cfl = ',zcfl 
     99         IF( lk_mpp ) CALL mpp_max( zcfl ) 
     100 
     101         IF( zcfl > 0.5 .AND. lwp )   WRITE(numout,*) 'lim_trp_2 : CFL violation at the ',nday,'th day, cfl = ',zcfl 
    128102 
    129103         ! content of properties 
     
    144118         zusnit = 1.0 / REAL( initad )  
    145119          
    146          IF ( MOD( nday , 2 ) == 0) THEN 
     120         IF( MOD( nday , 2 ) == 0) THEN 
    147121            DO jk = 1,initad 
    148122               CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice ) 
     
    228202         !   Up-dating and limitation of sea ice properties after transport   ! 
    229203         ! -------------------------------------------------------------------! 
    230  
    231          ! Up-dating and limitation of sea ice properties after transport. 
    232204         DO jj = 1, jpj 
    233 !!!iii      zindhe = REAL( MAX( 0, isign(1, jj - njeq ) ) )              !ibug mpp  !!bugmpp  njeq! 
    234205            zindhe = MAX( 0.e0, SIGN( 1.e0, fcor(1,jj) ) )              ! = 0 for SH, =1 for NH 
    235206            DO ji = 1, jpi 
    236  
    237                ! Recover mean values over the grid squares. 
     207               !                                                        ! Recover mean values over the grid squares. 
    238208               zs0sn (ji,jj) = MAX( rzero, zs0sn (ji,jj)/area(ji,jj) ) 
    239209               zs0ice(ji,jj) = MAX( rzero, zs0ice(ji,jj)/area(ji,jj) ) 
     
    243213               zs0c2 (ji,jj) = MAX( rzero, zs0c2 (ji,jj)/area(ji,jj) ) 
    244214               zs0st (ji,jj) = MAX( rzero, zs0st (ji,jj)/area(ji,jj) ) 
    245  
    246                ! Recover in situ values. 
     215               !                                                        ! Recover in situ values. 
    247216               zindb         = MAX( rzero, SIGN( rone, zs0a(ji,jj) - epsi06 ) ) 
    248217               zacrith       = 1.0 - ( zindhe * acrit(1) + ( 1.0 - zindhe ) * acrit(2) ) 
     
    262231               zrtt          = 173.15 * rone  
    263232               ztsn          =          zignm   * tbif(ji,jj,1)  & 
    264                               + ( 1.0 - zignm ) * MIN( MAX( zrtt, rt0_snow * zusvosn * zs0c0(ji,jj)) , tfu(ji,jj) )  
     233                  &           + ( 1.0 - zignm ) * MIN( MAX( zrtt, rt0_snow * zusvosn * zs0c0(ji,jj)) , tfu(ji,jj) )  
    265234               ztic1          = MIN( MAX( zrtt, rt0_ice * zusvoic * zs0c1(ji,jj) ) , tfu(ji,jj) ) 
    266235               ztic2          = MIN( MAX( zrtt, rt0_ice * zusvoic * zs0c2(ji,jj) ) , tfu(ji,jj) ) 
    267   
     236               ! 
    268237               tbif(ji,jj,1) = zindsn * ztsn  + ( 1.0 - zindsn ) * tfu(ji,jj)                
    269238               tbif(ji,jj,2) = zindic * ztic1 + ( 1.0 - zindic ) * tfu(ji,jj) 
     
    272241            END DO 
    273242         END DO 
    274           
     243         ! 
    275244      ENDIF 
    276        
     245      ! 
    277246   END SUBROUTINE lim_trp_2 
    278247 
     
    288257      !! 
    289258      !! ** input   :   Namelist namicetrp 
    290       !! 
    291       !! history : 
    292       !!   2.0  !  03-08 (C. Ethe)  Original code 
    293259      !!------------------------------------------------------------------- 
    294260      NAMELIST/namicetrp/ bound 
    295261      !!------------------------------------------------------------------- 
    296  
    297       ! Read Namelist namicetrp 
    298       REWIND ( numnam_ice ) 
     262      ! 
     263      REWIND ( numnam_ice )                  ! Read Namelist namicetrp 
    299264      READ   ( numnam_ice  , namicetrp ) 
    300       IF(lwp) THEN 
     265      IF(lwp) THEN                           ! control print 
    301266         WRITE(numout,*) 
    302267         WRITE(numout,*) 'lim_trp_init_2 : Ice parameters for advection ' 
     
    304269         WRITE(numout,*) '   boundary conditions (0. no-slip, 1. free-slip) bound  = ', bound 
    305270      ENDIF 
    306              
     271      !  
    307272   END SUBROUTINE lim_trp_init_2 
    308273 
     
    311276   !!   Default option         Empty Module                No sea-ice model 
    312277   !!---------------------------------------------------------------------- 
    313 CONTAINS 
    314    SUBROUTINE lim_trp_2        ! Empty routine 
    315    END SUBROUTINE lim_trp_2 
    316278#endif 
    317279 
Note: See TracChangeset for help on using the changeset viewer.