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 5600 for branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90 – NEMO

Ignore:
Timestamp:
2015-07-15T17:46:12+02:00 (9 years ago)
Author:
andrewryan
Message:

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r5034 r5600  
    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 
     
    2627 
    2728   PUBLIC   trc_sbc   ! routine called by step.F90 
     29 
     30   REAL(wp) ::   r2dt  !  time-step at surface 
    2831 
    2932   !! * Substitutions 
     
    6063      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    6164      ! 
    62       INTEGER  ::   ji, jj, jn           ! dummy loop indices 
    63       REAL(wp) ::   zsrau, zse3t   ! temporary scalars 
     65      INTEGER  ::   ji, jj, jn                                     ! dummy loop indices 
     66      REAL(wp) ::   zse3t, zrtrn, zratio, zfact                    ! temporary scalars 
     67      REAL(wp) ::   zswitch, zftra, zcd, zdtra, ztfx, ztra         ! temporary scalars 
    6468      CHARACTER (len=22) :: charout 
    6569      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsfx 
    6670      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 
     71 
    6772      !!--------------------------------------------------------------------- 
    6873      ! 
     
    7277                      CALL wrk_alloc( jpi, jpj,      zsfx   ) 
    7378      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrd ) 
     79      ! 
     80      zrtrn = 1.e-15_wp 
     81 
     82      SELECT CASE( nn_ice_embd )         ! levitating or embedded sea-ice option 
     83         CASE( 0    )   ;   zswitch = 1  ! (0) standard levitating sea-ice : salt exchange only 
     84         CASE( 1, 2 )   ;   zswitch = 0  ! (1) levitating sea-ice: salt and volume exchange but no pressure effect                                 
     85                                         ! (2) embedded sea-ice : salt and volume fluxes and pressure 
     86      END SELECT 
     87 
     88      IF( ln_top_euler) THEN 
     89         r2dt =  rdttrc(1)              ! = rdttrc (use Euler time stepping) 
     90      ELSE 
     91         IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
     92            r2dt = rdttrc(1)           ! = rdttrc (restarting with Euler time stepping) 
     93         ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
     94            r2dt = 2. * rdttrc(1)       ! = 2 rdttrc (leapfrog) 
     95         ENDIF 
     96      ENDIF 
     97 
    7498 
    7599      IF( kt == nittrc000 ) THEN 
     
    77101         IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition' 
    78102         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     103 
     104         IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file 
     105            iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_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( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_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         ! 
    79124      ENDIF 
    80125 
     
    90135 
    91136      ! 0. initialization 
    92       zsrau = 1. / rau0 
    93137      DO jn = 1, jptra 
    94138         ! 
    95139         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends 
    96140         !                                             ! add the trend to the general tracer trend 
     141 
     142         IF ( nn_ice_tr == -1 ) THEN  ! No tracers in sea ice (null concentration in sea ice) 
     143 
     144            DO jj = 2, jpj 
     145               DO ji = fs_2, fs_jpim1   ! vector opt. 
     146                  sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn) 
     147               END DO 
     148            END DO 
     149 
     150         ELSE 
     151 
     152            DO jj = 2, jpj 
     153               DO ji = fs_2, fs_jpim1   ! vector opt. 
     154                  zse3t = 1. / fse3t(ji,jj,1) 
     155                  ! tracer flux at the ice/ocean interface (tracer/m2/s) 
     156                  zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 
     157                  zcd   =   trc_o(ji,jj,jn) * fmmflx(ji,jj) ! concentration dilution due to freezing-melting, 
     158                                                               ! only used in the levitating sea ice case 
     159                  ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux 
     160                  ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 
     161                  ztfx  = zftra + zswitch * zcd                ! net tracer flux (+C/D if no ice/ocean mass exchange) 
     162    
     163                  zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) )  
     164                  IF ( zdtra < 0. ) THEN 
     165                     zratio = -zdtra * zse3t * r2dt / ( trn(ji,jj,1,jn) + zrtrn ) 
     166                     zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise 
     167                  ENDIF 
     168                  sbc_trc(ji,jj,jn) =  zdtra  
     169               END DO 
     170            END DO 
     171         ENDIF 
     172         !                                       Concentration dilution effect on tracers due to evaporation & precipitation  
    97173         DO jj = 2, jpj 
    98174            DO ji = fs_2, fs_jpim1   ! vector opt. 
    99                zse3t = 1. / fse3t(ji,jj,1) 
    100                tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) *  zsrau * trn(ji,jj,1,jn) * zse3t 
     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 
    101177            END DO 
    102178         END DO 
    103           
     179         ! 
    104180         IF( l_trdtrc ) THEN 
    105181            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
     
    109185      END DO                                                     ! tracer loop 
    110186      !                                                          ! =========== 
     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_'//TRIM(ctrcnm(jn))//'_b', sbc_trc(:,:,jn) ) 
     197         END DO 
     198      ENDIF 
     199      ! 
    111200      IF( ln_ctl )   THEN 
    112201         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout) 
Note: See TracChangeset for help on using the changeset viewer.