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 9019 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90 – NEMO

Ignore:
Timestamp:
2017-12-13T15:58:53+01:00 (6 years ago)
Author:
timgraham
Message:

Merge of dev_CNRS_2017 into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r7753 r9019  
    5858      !! 
    5959      !!---------------------------------------------------------------------- 
    60       ! 
    61       INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    62       ! 
    63       INTEGER  ::   ji, jj, jn                                     ! dummy loop indices 
    64       REAL(wp) ::   zse3t, zrtrn, zratio, zfact                    ! temporary scalars 
    65       REAL(wp) ::   zswitch, zftra, zcd, zdtra, ztfx, ztra         ! temporary scalars 
     60      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     61      ! 
     62      INTEGER  ::   ji, jj, jn                      ! dummy loop indices 
     63      REAL(wp) ::   zse3t, zrtrn, zratio, zfact     ! local scalars 
     64      REAL(wp) ::   zftra, zcd, zdtra, ztfx, ztra   !   -      - 
    6665      CHARACTER (len=22) :: charout 
    67       REAL(wp), POINTER, DIMENSION(:,:  ) :: zsfx 
    68       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 
    69  
     66      REAL(wp), POINTER, DIMENSION(:,:)   ::   zsfx 
     67      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrd 
    7068      !!--------------------------------------------------------------------- 
    7169      ! 
     
    7775      ! 
    7876      zrtrn = 1.e-15_wp 
    79  
    80       SELECT CASE( nn_ice_embd )         ! levitating or embedded sea-ice option 
    81          CASE( 0    )   ;   zswitch = 1  ! (0) standard levitating sea-ice : salt exchange only 
    82          CASE( 1, 2 )   ;   zswitch = 0  ! (1) levitating sea-ice: salt and volume exchange but no pressure effect                                 
    83       !                                  ! (2) embedded sea-ice : salt and volume fluxes and pressure 
    84       END SELECT 
    8577 
    8678      IF( kt == nittrc000 ) THEN 
     
    8880         IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition' 
    8981         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    90  
     82         ! 
    9183         IF( ln_rsttr .AND. .NOT.ln_top_euler .AND.   &                     ! Restart: read in restart  file 
    9284            iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 
     
    125117         ! 
    126118         IF( l_trdtrc )   ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends 
    127  
    128          IF ( nn_ice_tr == -1 ) THEN  ! No tracers in sea ice (null concentration in sea ice) 
    129  
     119         ! 
     120         IF( nn_ice_tr == -1 ) THEN    ! No tracers in sea ice (null concentration in sea ice) 
    130121            DO jj = 2, jpj 
    131122               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    133124               END DO 
    134125            END DO 
    135  
    136126         ELSE 
    137  
    138127            DO jj = 2, jpj 
    139128               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    142131                  zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 
    143132                  zcd   =   trc_o(ji,jj,jn) * fmmflx(ji,jj) ! concentration dilution due to freezing-melting, 
    144                                                                ! only used in the levitating sea ice case 
     133                  !                                         ! only used in the levitating sea ice case 
    145134                  ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux 
    146135                  ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 
    147                   ztfx  = zftra + zswitch * zcd                ! net tracer flux (+C/D if no ice/ocean mass exchange) 
    148     
     136                  ztfx  = zftra                             ! net tracer flux 
     137                  ! 
    149138                  zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) )  
    150139                  IF ( zdtra < 0. ) THEN 
     
    173162      END DO                                                     ! tracer loop 
    174163      !                                                          ! =========== 
    175  
     164      ! 
    176165      !                                           Write in the tracer restar  file 
    177166      !                                          ******************************* 
Note: See TracChangeset for help on using the changeset viewer.