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 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcbc.F90 – NEMO

Ignore:
Timestamp:
2020-05-14T21:46:00+02:00 (4 years ago)
Author:
smueller
Message:

Synchronizing with /NEMO/trunk@12925 (ticket #2170)

Location:
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser

    • Property svn:externals
      •  

        old new  
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@HEAD         sette 
  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/trcbc.F90

    r12178 r12928  
    77   !!            3.6 !  2015 (T . Lovato) Revision and BDY support 
    88   !!            4.0 !  2016 (T . Lovato) Include application of sbc and cbc 
    9    !!---------------------------------------------------------------------- 
    10 #if defined key_top 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_top'                                                TOP model  
    139   !!---------------------------------------------------------------------- 
    1410   !!   trc_bc       :  Apply tracer Boundary Conditions 
     
    4541#endif 
    4642 
     43#if defined key_top 
     44   !!---------------------------------------------------------------------- 
     45   !!   'key_top'                                                TOP model  
     46   !!---------------------------------------------------------------------- 
     47 
    4748   !! * Substitutions 
    48 #  include "vectopt_loop_substitute.h90" 
     49#  include "do_loop_substitute.h90" 
    4950   !!---------------------------------------------------------------------- 
    5051   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
     
    5455CONTAINS 
    5556 
    56    SUBROUTINE trc_bc_ini( ntrc ) 
     57   SUBROUTINE trc_bc_ini( ntrc, Kmm ) 
    5758      !!---------------------------------------------------------------------- 
    5859      !!                   ***  ROUTINE trc_bc_ini  *** 
     
    6364      !!              - allocates passive tracer BC data structure  
    6465      !!---------------------------------------------------------------------- 
    65       INTEGER,INTENT(in) :: ntrc                           ! number of tracers 
     66      INTEGER, INTENT(in) :: ntrc                          ! number of tracers 
     67      INTEGER, INTENT(in) ::   Kmm                         ! time level index 
    6668      ! 
    6769      INTEGER            :: jl, jn , ib, ibd, ii, ij, ik   ! dummy loop indices 
     
    8183      !! 
    8284      NAMELIST/namtrc_bc/ cn_dir_obc, sn_trcobc, rn_trofac, cn_dir_sbc, sn_trcsbc, rn_trsfac, &  
    83                         & cn_dir_cbc, sn_trccbc, rn_trcfac, ln_rnf_ctl, rn_bc_time 
     85                        & cn_dir_cbc, sn_trccbc, rn_trcfac, ln_rnf_ctl, rn_sbc_time, rn_cbc_time 
    8486      NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy 
    8587      !!---------------------------------------------------------------------- 
     
    120122      ! 
    121123      ! Read Boundary Conditions Namelists 
    122       REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 
    123124      READ  ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901) 
    124125901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_bc in reference namelist' ) 
    125       REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 
    126126      READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 ) 
    127127902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist' ) 
     
    129129 
    130130      IF ( ln_bdy ) THEN 
    131          REWIND( numnat_ref )              ! Namelist namtrc_bdy in reference namelist : Passive tracer data structure 
    132131         READ  ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903) 
    133132903      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist' ) 
     
    135134         cn_trc     (2:jp_bdy) = cn_trc     (1) 
    136135         cn_trc_dflt(2:jp_bdy) = cn_trc_dflt(1) 
    137          REWIND( numnat_cfg )              ! Namelist namtrc_bdy in configuration namelist : Passive tracer data structure 
    138136         READ  ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 ) 
    139137904      IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist' ) 
     
    153151               IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) /= 0 )  & 
    154152                   & CALL ctl_stop( 'trc_bc_ini: Use FRS OR relaxation' ) 
    155                IF(  .NOT.( 0 < nn_trcdmp_bdy(ib)  .AND.  nn_trcdmp_bdy(ib) <= 2 )  )   & 
     153               IF(  .NOT.( 0 <= nn_trcdmp_bdy(ib)  .AND.  nn_trcdmp_bdy(ib) <= 2 )  )   & 
    156154                   & CALL ctl_stop( 'trc_bc_ini: Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 
    157155            END DO 
     
    264262                        ii = idx_bdy(ib)%nbi(ibd,igrd) 
    265263                        ij = idx_bdy(ib)%nbj(ibd,igrd) 
    266                         trcdta_bdy(jn,ib)%trc(ibd,ik) = trn(ii,ij,ik,jn) * tmask(ii,ij,ik) 
     264                        trcdta_bdy(jn,ib)%trc(ibd,ik) = tr(ii,ij,ik,jn,Kmm) * tmask(ii,ij,ik) 
    267265                     END DO 
    268266                  END DO 
     
    339337 
    340338 
    341    SUBROUTINE trc_bc(kt, jit) 
     339   SUBROUTINE trc_bc(kt, Kmm, ptr, Krhs, jit) 
    342340      !!---------------------------------------------------------------------- 
    343341      !!                   ***  ROUTINE trc_bc  *** 
     
    350348      USE fldread 
    351349      !!       
    352       INTEGER, INTENT(in)           ::   kt    ! ocean time-step index 
    353       INTEGER, INTENT(in), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
     350      INTEGER                                   , INTENT(in)           ::   kt        ! ocean time-step index 
     351      INTEGER                                   , INTENT(in)           ::   Kmm, Krhs ! time level indices 
     352      INTEGER                                   , INTENT(in), OPTIONAL ::   jit       ! subcycle time-step index (for timesplitting option) 
     353      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation 
    354354      !! 
    355355      INTEGER  :: ji, jj, jk, jn, jl             ! Loop index 
     
    368368      IF( PRESENT(jit) ) THEN  
    369369         ! 
    370          ! OPEN boundary conditions (use kt_offset=+1 as they are applied at the end of the step) 
     370         ! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step 
    371371         IF( nb_trcobc > 0 ) THEN 
    372372           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
    373            CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kit=jit, kt_offset=+1) 
     373           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kit=jit, pt_offset = 0.5_wp ) 
    374374         ENDIF 
    375375         ! 
     
    388388      ELSE 
    389389         ! 
    390          ! OPEN boundary conditions (use kt_offset=+1 as they are applied at the end of the step) 
     390         ! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step 
    391391         IF( nb_trcobc > 0 ) THEN 
    392392           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
    393            CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kt_offset=+1) 
     393           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, pt_offset = 0.5_wp ) 
    394394         ENDIF 
    395395         ! 
     
    414414         ! Remove river dilution for tracers with absent river load 
    415415         IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN 
    416             DO jj = 2, jpj 
    417                DO ji = fs_2, fs_jpim1 
    418                   DO jk = 1, nk_rnf(ji,jj) 
    419                      zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 
    420                      tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)  + (trn(ji,jj,jk,jn) * zrnf) 
    421                   END DO 
     416            DO_2D_01_00 
     417               DO jk = 1, nk_rnf(ji,jj) 
     418                  zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rho0 / h_rnf(ji,jj) 
     419                  ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs)  + (ptr(ji,jj,jk,jn,Kmm) * zrnf) 
    422420               END DO 
    423             END DO 
     421            END_2D 
    424422         ENDIF 
    425423         ! 
     
    429427         IF( ln_trc_sbc(jn) ) THEN 
    430428            jl = n_trc_indsbc(jn) 
    431             DO jj = 2, jpj 
    432                DO ji = fs_2, fs_jpim1   ! vector opt. 
    433                   zfact = 1. / ( e3t_n(ji,jj,1) * rn_bc_time ) 
    434                   tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact 
     429            sf_trcsbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trcsbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation 
     430            DO_2D_01_00 
     431               zfact = 1. / ( e3t(ji,jj,1,Kmm) * rn_sbc_time ) 
     432               ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact 
     433            END_2D 
     434         ENDIF 
     435         ! 
     436         ! COASTAL boundary conditions 
     437         IF( ( ln_rnf .OR. l_offline ) .AND. ln_trc_cbc(jn) ) THEN 
     438            IF( l_offline )   rn_rfact = 1._wp 
     439            jl = n_trc_indcbc(jn) 
     440            DO_2D_01_00 
     441               DO jk = 1, nk_rnf(ji,jj) 
     442                  zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) 
     443                  ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 
    435444               END DO 
    436             END DO 
    437          ENDIF 
    438          ! 
    439          ! COASTAL boundary conditions 
    440          IF( ln_rnf .AND. ln_trc_cbc(jn) ) THEN 
    441             jl = n_trc_indcbc(jn) 
    442             DO jj = 2, jpj 
    443                DO ji = fs_2, fs_jpim1   ! vector opt. 
    444                   DO jk = 1, nk_rnf(ji,jj) 
    445                      zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_bc_time )  
    446                      tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 
    447                   END DO 
    448                END DO 
    449             END DO 
     445            END_2D 
    450446         ENDIF 
    451447         !                                                       ! =========== 
     
    461457   !!---------------------------------------------------------------------- 
    462458CONTAINS 
    463    SUBROUTINE trc_bc_ini( ntrc )        ! Empty routine 
    464       INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
    465       WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', kt 
     459   SUBROUTINE trc_bc_ini( ntrc, Kmm )        ! Empty routine 
     460      INTEGER, INTENT(IN) :: ntrc                           ! number of tracers 
     461      INTEGER, INTENT(in) :: Kmm                            ! time level index 
     462      WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', ntrc, Kmm 
    466463   END SUBROUTINE trc_bc_ini 
    467    SUBROUTINE trc_bc( kt )        ! Empty routine 
    468       WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt 
     464   SUBROUTINE trc_bc( kt, Kmm, Krhs )        ! Empty routine 
     465      INTEGER, INTENT(in) :: kt, Kmm, Krhs ! time level indices 
     466      WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt, Kmm, Krhs  
    469467   END SUBROUTINE trc_bc 
    470468#endif 
Note: See TracChangeset for help on using the changeset viewer.