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

Ignore:
Timestamp:
2010-05-03T13:59:46+02:00 (14 years ago)
Author:
gm
Message:

ticket:#665 Reverting previous commit and going back to revision 1850

File:
1 edited

Legend:

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

    r1855 r1857  
    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    !!---------------------------------------------------------------------- 
    106#if defined key_lim2 
    117   !!---------------------------------------------------------------------- 
     
    1511   !!   lim_trp_init_2 : initialization and namelist read 
    1612   !!---------------------------------------------------------------------- 
     13   !! * Modules used 
    1714   USE phycst 
    1815   USE dom_oce 
     
    2926   PRIVATE 
    3027 
    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     ! 
     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 
    4042 
    4143   !! * Substitution 
    4244#  include "vectopt_loop_substitute.h90" 
    4345   !!---------------------------------------------------------------------- 
    44    !! NEMO/LIM 3.3,  UCL-LOCEAN-IPSL (2010)  
     46   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    4547   !! $Id$ 
    46    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     48   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    4749   !!---------------------------------------------------------------------- 
    4850 
     
    6062      !! 
    6163      !! ** 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 
    6269      !!--------------------------------------------------------------------- 
    6370      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    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   !  -      - 
     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 
    7194      !--------------------------------------------------------------------- 
    7295 
     
    7598      zsm(:,:) = area(:,:) 
    7699       
    77       !                             !-------------------------------------! 
    78       IF( ln_limdyn ) THEN          !   Advection of sea ice properties   ! 
    79          !                          !-------------------------------------! 
     100      IF( ln_limdyn ) THEN 
     101         !-------------------------------------! 
     102         !   Advection of sea ice properties   ! 
     103         !-------------------------------------! 
    80104 
    81105         ! ice velocities at ocean U- and V-points (zui_u,zvi_v) 
     
    89113            END DO 
    90114         END DO 
    91          CALL lbc_lnk( zui_u, 'U', -1. )   ;   CALL lbc_lnk( zvi_v, 'V', -1. )         ! Lateral boundary conditions 
     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. ) 
    92118 
    93119         ! CFL test for stability 
     
    97123         zcfl  = MAX( zcfl, MAXVAL( ABS( zvi_v( :     ,1:jpjm1) ) * rdt_ice / e2v( :     ,1:jpjm1) ) ) 
    98124 
    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 
     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 
    102128 
    103129         ! content of properties 
     
    118144         zusnit = 1.0 / REAL( initad )  
    119145          
    120          IF( MOD( nday , 2 ) == 0) THEN 
     146         IF ( MOD( nday , 2 ) == 0) THEN 
    121147            DO jk = 1,initad 
    122148               CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice ) 
     
    202228         !   Up-dating and limitation of sea ice properties after transport   ! 
    203229         ! -------------------------------------------------------------------! 
     230 
     231         ! Up-dating and limitation of sea ice properties after transport. 
    204232         DO jj = 1, jpj 
     233!!!iii      zindhe = REAL( MAX( 0, isign(1, jj - njeq ) ) )              !ibug mpp  !!bugmpp  njeq! 
    205234            zindhe = MAX( 0.e0, SIGN( 1.e0, fcor(1,jj) ) )              ! = 0 for SH, =1 for NH 
    206235            DO ji = 1, jpi 
    207                !                                                        ! Recover mean values over the grid squares. 
     236 
     237               ! Recover mean values over the grid squares. 
    208238               zs0sn (ji,jj) = MAX( rzero, zs0sn (ji,jj)/area(ji,jj) ) 
    209239               zs0ice(ji,jj) = MAX( rzero, zs0ice(ji,jj)/area(ji,jj) ) 
     
    213243               zs0c2 (ji,jj) = MAX( rzero, zs0c2 (ji,jj)/area(ji,jj) ) 
    214244               zs0st (ji,jj) = MAX( rzero, zs0st (ji,jj)/area(ji,jj) ) 
    215                !                                                        ! Recover in situ values. 
     245 
     246               ! Recover in situ values. 
    216247               zindb         = MAX( rzero, SIGN( rone, zs0a(ji,jj) - epsi06 ) ) 
    217248               zacrith       = 1.0 - ( zindhe * acrit(1) + ( 1.0 - zindhe ) * acrit(2) ) 
     
    231262               zrtt          = 173.15 * rone  
    232263               ztsn          =          zignm   * tbif(ji,jj,1)  & 
    233                   &           + ( 1.0 - zignm ) * MIN( MAX( zrtt, rt0_snow * zusvosn * zs0c0(ji,jj)) , tfu(ji,jj) )  
     264                              + ( 1.0 - zignm ) * MIN( MAX( zrtt, rt0_snow * zusvosn * zs0c0(ji,jj)) , tfu(ji,jj) )  
    234265               ztic1          = MIN( MAX( zrtt, rt0_ice * zusvoic * zs0c1(ji,jj) ) , tfu(ji,jj) ) 
    235266               ztic2          = MIN( MAX( zrtt, rt0_ice * zusvoic * zs0c2(ji,jj) ) , tfu(ji,jj) ) 
    236                ! 
     267  
    237268               tbif(ji,jj,1) = zindsn * ztsn  + ( 1.0 - zindsn ) * tfu(ji,jj)                
    238269               tbif(ji,jj,2) = zindic * ztic1 + ( 1.0 - zindic ) * tfu(ji,jj) 
     
    241272            END DO 
    242273         END DO 
    243          ! 
     274          
    244275      ENDIF 
    245       ! 
     276       
    246277   END SUBROUTINE lim_trp_2 
    247278 
     
    257288      !! 
    258289      !! ** input   :   Namelist namicetrp 
     290      !! 
     291      !! history : 
     292      !!   2.0  !  03-08 (C. Ethe)  Original code 
    259293      !!------------------------------------------------------------------- 
    260294      NAMELIST/namicetrp/ bound 
    261295      !!------------------------------------------------------------------- 
    262       ! 
    263       REWIND ( numnam_ice )                  ! Read Namelist namicetrp 
     296 
     297      ! Read Namelist namicetrp 
     298      REWIND ( numnam_ice ) 
    264299      READ   ( numnam_ice  , namicetrp ) 
    265       IF(lwp) THEN                           ! control print 
     300      IF(lwp) THEN 
    266301         WRITE(numout,*) 
    267302         WRITE(numout,*) 'lim_trp_init_2 : Ice parameters for advection ' 
     
    269304         WRITE(numout,*) '   boundary conditions (0. no-slip, 1. free-slip) bound  = ', bound 
    270305      ENDIF 
    271       !  
     306             
    272307   END SUBROUTINE lim_trp_init_2 
    273308 
     
    276311   !!   Default option         Empty Module                No sea-ice model 
    277312   !!---------------------------------------------------------------------- 
     313CONTAINS 
     314   SUBROUTINE lim_trp_2        ! Empty routine 
     315   END SUBROUTINE lim_trp_2 
    278316#endif 
    279317 
Note: See TracChangeset for help on using the changeset viewer.