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 5373 for branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90 – NEMO

Ignore:
Timestamp:
2015-06-08T12:47:17+02:00 (9 years ago)
Author:
cetlod
Message:

dev_r5204_CNRS_PISCES_dcy : add some corrections to improve passive tracers conservation

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r5367 r5373  
    1919   USE trc             ! ocean  passive tracers variables 
    2020   USE prtctl_trc      ! Print control for debbuging 
     21   USE iom 
    2122   USE trd_oce 
    2223   USE trdtra 
     
    6364      ! 
    6465      INTEGER  ::   ji, jj, jn                                     ! dummy loop indices 
    65       REAL(wp) ::   zse3t, zrtrn, zratio                           ! temporary scalars 
     66      REAL(wp) ::   zse3t, zrtrn, zratio, zfact                    ! temporary scalars 
    6667      REAL(wp) ::   zswitch, zftra, zcd, zdtra, ztfx, ztra         ! temporary scalars 
    6768      CHARACTER (len=22) :: charout 
     
    100101         IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition' 
    101102         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     103 
     104         IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file 
     105            iom_varid( numrtr, 'sbc_trc_b', ldstop = .FALSE. ) > 0 ) THEN 
     106            IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 
     107            zfact = 0.5_wp 
     108            DO jn = 1, jptra 
     109               CALL iom_get( numror, jpdom_autoglo, 'sbc_trc_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc 
     110            END DO 
     111         ELSE                                         ! No restart or restart not found: Euler forward time stepping 
     112           zfact = 1._wp 
     113           sbc_trc_b(:,:,:) = 0._wp 
     114         ENDIF 
     115      ELSE                                         ! Swap of forcing fields 
     116         IF( ln_top_euler ) THEN 
     117            zfact = 1._wp 
     118            sbc_trc_b(:,:,:) = 0._wp 
     119         ELSE 
     120            zfact = 0.5_wp 
     121            sbc_trc_b(:,:,:) = sbc_trc(:,:,:) 
     122         ENDIF 
     123         ! 
    102124      ENDIF 
    103125 
     
    122144            DO jj = 2, jpj 
    123145               DO ji = fs_2, fs_jpim1   ! vector opt. 
    124                   zse3t = 1. / fse3t(ji,jj,1) 
    125                   tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn) * zse3t 
     146                  sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn) 
    126147               END DO 
    127148            END DO 
     
    131152            DO jj = 2, jpj 
    132153               DO ji = fs_2, fs_jpim1   ! vector opt. 
    133  
    134154                  zse3t = 1. / fse3t(ji,jj,1) 
    135                    
    136155                  ! tracer flux at the ice/ocean interface (tracer/m2/s) 
    137156                  zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 
     
    142161                  ztfx  = zftra + zswitch * zcd                ! net tracer flux (+C/D if no ice/ocean mass exchange) 
    143162    
    144                   zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) ) * zse3t 
     163                  zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) )  
    145164                  IF ( zdtra < 0. ) THEN 
    146                      zratio = -zdtra * r2dt / ( trn(ji,jj,1,jn) + zrtrn ) 
     165                     zratio = -zdtra * zse3t * r2dt / ( trn(ji,jj,1,jn) + zrtrn ) 
    147166                     zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise 
    148167                  ENDIF 
    149                        
    150                   tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zdtra  
    151     
     168                  sbc_trc(ji,jj,jn) =  zdtra  
    152169               END DO 
    153170            END DO 
    154     
    155          ENDIF 
    156           
     171         ENDIF 
     172         !                                       Concentration dilution effect on tracers due to evaporation & precipitation  
     173         DO jj = 2, jpj 
     174            DO ji = fs_2, fs_jpim1   ! vector opt. 
     175               zse3t = zfact / fse3t(ji,jj,1) 
     176               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 
     177            END DO 
     178         END DO 
     179         ! 
    157180         IF( l_trdtrc ) THEN 
    158181            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
     
    162185      END DO                                                     ! tracer loop 
    163186      !                                                          ! =========== 
     187 
     188      !                                           Write in the tracer restar  file 
     189      !                                          ******************************* 
     190      IF( lrst_trc ) THEN 
     191         IF(lwp) WRITE(numout,*) 
     192         IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in tracer restart file ',   & 
     193            &                    'at it= ', kt,' date= ', ndastp 
     194         IF(lwp) WRITE(numout,*) '~~~~' 
     195         DO jn = 1, jptra 
     196            CALL iom_rstput( kt, nitrst, numrtw, 'sbc_trc_b', sbc_trc_b(:,:,jn) ) 
     197         END DO 
     198      ENDIF 
     199      ! 
    164200      IF( ln_ctl )   THEN 
    165201         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout) 
Note: See TracChangeset for help on using the changeset viewer.