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 2319 for branches/nemo_v3_3_beta/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90 – NEMO

Ignore:
Timestamp:
2010-10-27T15:18:11+02:00 (13 years ago)
Author:
cbricaud
Message:

put new EVP rheology lost during the merge

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r2287 r2319  
    44   !!           computation of the flux at the sea ice/ocean interface 
    55   !!====================================================================== 
    6    !! History : 00-01 (H. Goosse) Original code 
    7    !!           02-07 (C. Ethe, G. Madec) re-writing F90 
    8    !!           06-07 (G. Madec) surface module 
     6   !! History :  LIM  ! 2000-01 (H. Goosse) Original code 
     7   !!            1.0  ! 2002-07 (C. Ethe, G. Madec) re-writing F90 
     8   !!            3.0  ! 2006-07 (G. Madec) surface module 
     9   !!            3.3  ! 2009-05 (G.Garric, C. Bricaud) addition of the lim2_evp case 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_lim2 
     
    1718   USE par_oce          ! ocean parameters 
    1819   USE dom_oce          ! ocean domain 
    19    USE sbc_ice          ! surface boundary condition 
    20    USE sbc_oce          ! surface boundary condition 
     20   USE sbc_ice          ! surface boundary condition: ice 
     21   USE sbc_oce          ! surface boundary condition: ocean 
    2122   USE phycst           ! physical constants 
    22    USE ice_2            ! LIM sea-ice variables 
    23  
    24    USE lbclnk           ! ocean lateral boundary condition 
     23   USE ice_2            ! LIM2: ice variables 
     24 
     25   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges 
    2526   USE in_out_manager   ! I/O manager 
    2627   USE diaar5, ONLY :   lk_diaar5 
     
    3536   PUBLIC lim_sbc_2     ! called by sbc_ice_lim_2 
    3637 
    37    REAL(wp)  ::   epsi16 = 1.e-16  ! constant values 
    38    REAL(wp)  ::   rzero  = 0.e0     
    39    REAL(wp)  ::   rone   = 1.e0 
    40    REAL(wp), DIMENSION(jpi,jpj)  ::   soce_r 
    41    REAL(wp), DIMENSION(jpi,jpj)  ::   sice_r 
     38   REAL(wp)  ::   r1_rdtice                    ! constant values 
     39   REAL(wp)  ::   epsi16 = 1.e-16              !     -      - 
     40   REAL(wp)  ::   rzero  = 0.e0                !     -      - 
     41   REAL(wp)  ::   rone   = 1.e0                !     -      - 
     42   ! 
     43   REAL(wp), DIMENSION(jpi,jpj) ::   soce_r, sice_r   ! constant SSS and ice salinity used in levitating sea-ice case 
    4244 
    4345   !! * Substitutions 
     
    7880      !! 
    7981      INTEGER  ::   ji, jj           ! dummy loop indices 
    80       INTEGER  ::   ifvt, i1mfr, idfr               ! some switches 
    81       INTEGER  ::   iflt, ial, iadv, ifral, ifrdv 
    82       REAL(wp) ::   zrdtir           ! 1. / rdt_ice 
    83       REAL(wp) ::   zqsr  , zqns     ! solar & non solar heat flux 
    84       REAL(wp) ::   zinda            ! switch for testing the values of ice concentration 
    85       REAL(wp) ::   zfons            ! salt exchanges at the ice/ocean interface 
    86       REAL(wp) ::   zemp             ! freshwater exchanges at the ice/ocean interface 
    87       REAL(wp) ::   zfrldu, zfrldv   ! lead fraction at U- & V-points 
    88       REAL(wp) ::   zutau , zvtau    ! lead fraction at U- & V-points 
    89       REAL(wp) ::   zu_io , zv_io    ! 2 components of the ice-ocean velocity 
    90 ! interface 2D --> 3D 
    91       REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb     ! albedo of ice under overcast sky 
    92       REAL(wp), DIMENSION(jpi,jpj,1) ::   zalbp    ! albedo of ice under clear sky 
    93       REAL(wp) ::   zsang, zmod, zztmp, zfm 
    94       REAL(wp), DIMENSION(jpi,jpj) ::   ztio_u, ztio_v   ! component of ocean stress below sea-ice at I-point 
    95       REAL(wp), DIMENSION(jpi,jpj) ::   ztiomi           ! module    of ocean stress below sea-ice at I-point 
    96       REAL(wp), DIMENSION(jpi,jpj) ::   zqnsoce          ! save qns before its modification by ice model 
     82      INTEGER  ::   ii0, ii1, ij0, ij1         ! local integers 
     83      INTEGER  ::   ifvt, i1mfr, idfr, iflt    !   -       - 
     84      INTEGER  ::   ial, iadv, ifral, ifrdv    !   -       - 
     85      REAL(wp) ::   zqsr, zqns, zsang, zmod, zfm   ! local scalars 
     86      REAL(wp) ::   zinda, zfons, zemp, zztmp      !   -      - 
     87      REAL(wp) ::   zfrldu, zutau, zu_io           !   -      - 
     88      REAL(wp) ::   zfrldv, zvtau, zv_io           !   -      - 
     89      REAL(wp), DIMENSION(jpi,jpj)   ::   ztio_u, ztio_v    ! 2D workspace 
     90      REAL(wp), DIMENSION(jpi,jpj)   ::   ztiomi, zqnsoce   !  -     - 
     91      REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb, zalbp   ! 2D/3D workspace 
    9792 
    9893      !!--------------------------------------------------------------------- 
    9994      
    100       zrdtir = 1. / rdt_ice 
    10195       
    10296      IF( kt == nit000 ) THEN 
    10397         IF(lwp) WRITE(numout,*) 
    104          IF(lwp) WRITE(numout,*) 'lim_sbc_2 : LIM 2.0 sea-ice - surface boundary condition' 
     98#if defined key_lim2_vp 
     99         IF(lwp) WRITE(numout,*) 'lim_sbc_2 : LIM 2.0 sea-ice (VP rheology)  - surface boundary condition' 
     100#else 
     101         IF(lwp) WRITE(numout,*) 'lim_sbc_2 : LIM 2.0 sea-ice (EVP rheology) - surface boundary condition' 
     102#endif 
    105103         IF(lwp) WRITE(numout,*) '~~~~~~~~~   ' 
    106  
     104         ! 
     105         r1_rdtice = 1. / rdt_ice 
     106         ! 
    107107         soce_r(:,:) = soce 
    108108         sice_r(:,:) = sice 
     
    186186            zqns    =  - ( 1. - thcm(ji,jj) ) * zqsr   &   ! part of the solar energy used in leads 
    187187               &       + iflt    * ( fscmbq(ji,jj) + ffltbif(ji,jj) )                            & 
    188                &       + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * zrdtir    & 
    189                &       + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * zrdtir 
     188               &       + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice    & 
     189               &       + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) )                   * r1_rdtice  
    190190 
    191191            fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj)     ! ??? 
     
    198198      CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) )       
    199199      CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) )       
    200       CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1. - pfrld(:,:)) ) 
     200      CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) ) 
    201201 
    202202      !------------------------------------------! 
     
    212212             
    213213#if defined key_coupled 
    214           zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !  
    215              &   + rdmsnif(ji,jj) * zrdtir                                      !  freshwaterflux due to snow melting  
    216 #else 
    217 !!$            !  computing freshwater exchanges at the ice/ocean interface 
    218 !!$            zpme = - evap(ji,jj)    *   frld(ji,jj)           &   !  evaporation over oceanic fraction 
    219 !!$               &   + tprecip(ji,jj)                           &   !  total precipitation 
    220 !!$               &   - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )   &   !  remov. snow precip over ice 
    221 !!$               &   - rdmsnif(ji,jj) / rdt_ice                     !  freshwaterflux due to snow melting  
     214            ! freshwater exchanges at the ice-atmosphere / ocean interface (coupled mode) 
     215            zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !  
     216               &   + rdmsnif(ji,jj) * r1_rdtice                                   !  freshwaterflux due to snow melting  
     217#else 
    222218            !  computing freshwater exchanges at the ice/ocean interface 
    223219            zemp = + emp(ji,jj)     *         frld(ji,jj)      &   !  e-p budget over open ocean fraction  
    224220               &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &   !  liquid precipitation reaches directly the ocean 
    225221               &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !  taking into account change in ice cover within the time step 
    226                &   + rdmsnif(ji,jj) * zrdtir                       !  freshwaterflux due to snow melting  
     222               &   + rdmsnif(ji,jj) * r1_rdtice                    !  freshwaterflux due to snow melting  
    227223               !                                                   !  ice-covered fraction: 
    228224#endif             
    229225 
    230226            !  computing salt exchanges at the ice/ocean interface 
    231             zfons =  ( soce_r(ji,jj) - sice_r(ji,jj) ) * ( rdmicif(ji,jj) * zrdtir )  
     227            zfons =  ( soce_r(ji,jj) - sice_r(ji,jj) ) * ( rdmicif(ji,jj) * r1_rdtice )  
    232228             
    233229            !  converting the salt flux from ice to a freshwater flux from ocean 
     
    241237 
    242238      IF( lk_diaar5 ) THEN 
    243          CALL iom_put( 'isnwmlt_cea'  ,                 rdmsnif(:,:) * zrdtir ) 
    244          CALL iom_put( 'fsal_virt_cea',   soce_r(:,:) * rdmicif(:,:) * zrdtir ) 
    245          CALL iom_put( 'fsal_real_cea', - sice_r(:,:) * rdmicif(:,:) * zrdtir ) 
     239         CALL iom_put( 'isnwmlt_cea'  ,                 rdmsnif(:,:) * r1_rdtice ) 
     240         CALL iom_put( 'fsal_virt_cea',   soce_r(:,:) * rdmicif(:,:) * r1_rdtice ) 
     241         CALL iom_put( 'fsal_real_cea', - sice_r(:,:) * rdmicif(:,:) * r1_rdtice ) 
    246242      ENDIF 
    247243 
     
    277273            DO ji = 2, jpim1   ! NO vector opt. 
    278274               ! ... components of ice-ocean stress at U and V-points  (from I-point values) 
    279                zutau  = 0.5 * ( ztio_u(ji+1,jj) + ztio_u(ji+1,jj+1) ) 
     275#if defined key_lim2_vp 
     276               zutau  = 0.5 * ( ztio_u(ji+1,jj) + ztio_u(ji+1,jj+1) )      ! VP rheology 
    280277               zvtau  = 0.5 * ( ztio_v(ji,jj+1) + ztio_v(ji+1,jj+1) ) 
     278#else 
     279               zutau  = ztio_u(ji,jj)                                      ! EVP rheology 
     280               zvtau  = ztio_v(ji,jj) 
     281#endif 
    281282               ! ... open-ocean (lead) fraction at U- & V-points (from T-point values) 
    282283               zfrldu = 0.5 * ( frld(ji,jj) + frld(ji+1,jj  ) ) 
Note: See TracChangeset for help on using the changeset viewer.