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.
trcbc.F90 in NEMO/trunk/src/TOP – NEMO

source: NEMO/trunk/src/TOP/trcbc.F90 @ 12460

Last change on this file since 12460 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

  • Property svn:keywords set to Id
File size: 23.4 KB
RevLine 
[4058]1MODULE trcbc
2   !!======================================================================
[6140]3   !!                     ***  MODULE  trcbc  ***
[4058]4   !! TOP :  module for passive tracer boundary conditions
5   !!=====================================================================
[7646]6   !! History :  3.5 !  2014 (M. Vichi, T. Lovato)  Original
7   !!            3.6 !  2015 (T . Lovato) Revision and BDY support
8   !!            4.0 !  2016 (T . Lovato) Include application of sbc and cbc
[4058]9   !!----------------------------------------------------------------------
[7646]10   !!   trc_bc       :  Apply tracer Boundary Conditions
[4058]11   !!----------------------------------------------------------------------
12   USE par_trc       !  passive tracers parameters
13   USE oce_trc       !  shared variables between ocean and passive tracers
14   USE trc           !  passive tracers common variables
15   USE iom           !  I/O manager
16   USE lib_mpp       !  MPP library
17   USE fldread       !  read input fields
[7646]18   USE bdy_oce,  ONLY: ln_bdy, nb_bdy , idx_bdy, ln_coords_file, rn_time_dmp, rn_time_dmp_out
[4058]19
20   IMPLICIT NONE
21   PRIVATE
22
[7646]23   PUBLIC   trc_bc         ! called in trcstp.F90 or within TOP modules
24   PUBLIC   trc_bc_ini     ! called in trcini.F90
[4058]25
[6140]26   INTEGER  , SAVE, PUBLIC                             :: nb_trcobc    ! number of tracers with open BC
27   INTEGER  , SAVE, PUBLIC                             :: nb_trcsbc    ! number of tracers with surface BC
28   INTEGER  , SAVE, PUBLIC                             :: nb_trccbc    ! number of tracers with coastal BC
[4058]29   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indobc ! index of tracer with OBC data
30   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indsbc ! index of tracer with SBC data
31   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indcbc ! index of tracer with CBC data
[6140]32   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trsfac    ! multiplicative factor for SBC tracer values
33   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcsbc    ! structure of data input SBC (file informations, fields read)
34   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trcfac    ! multiplicative factor for CBC tracer values
35   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trccbc    ! structure of data input CBC (file informations, fields read)
36   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trofac    ! multiplicative factor for OBCtracer values
[9800]37#if defined key_agrif
[9788]38   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcobc    ! structure of data input OBC (file informations, fields read)
[9800]39#else
40   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET  :: sf_trcobc
41#endif
[4058]42
[12377]43#if defined key_top
44   !!----------------------------------------------------------------------
45   !!   'key_top'                                                TOP model
46   !!----------------------------------------------------------------------
47
[7646]48   !! * Substitutions
[12377]49#  include "do_loop_substitute.h90"
[4058]50   !!----------------------------------------------------------------------
[9598]51   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
[6140]52   !! $Id$
[10068]53   !! Software governed by the CeCILL license (see ./LICENSE)
[4058]54   !!----------------------------------------------------------------------
55CONTAINS
56
[12377]57   SUBROUTINE trc_bc_ini( ntrc, Kmm )
[4058]58      !!----------------------------------------------------------------------
[7646]59      !!                   ***  ROUTINE trc_bc_ini  ***
[4058]60      !!                   
61      !! ** Purpose :   initialisation of passive tracer BC data
62      !!
63      !! ** Method  : - Read namtsd namelist
64      !!              - allocates passive tracer BC data structure
65      !!----------------------------------------------------------------------
[12377]66      INTEGER, INTENT(in) :: ntrc                          ! number of tracers
67      INTEGER, INTENT(in) ::   Kmm                         ! time level index
[9169]68      !
[6140]69      INTEGER            :: jl, jn , ib, ibd, ii, ij, ik   ! dummy loop indices
[4058]70      INTEGER            :: ierr0, ierr1, ierr2, ierr3     ! temporary integers
[6140]71      INTEGER            :: ios                            ! Local integer output status for namelist read
72      INTEGER            :: nblen, igrd                    ! support arrays for BDY
[4058]73      CHARACTER(len=100) :: clndta, clntrc
74      !
[6140]75      CHARACTER(len=100) :: cn_dir_sbc, cn_dir_cbc, cn_dir_obc
[4058]76      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i  ! local array of namelist informations on the fields to read
77      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc    ! open
78      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcsbc    ! surface
79      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trccbc    ! coastal
80      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trofac    ! multiplicative factor for tracer values
81      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trsfac    ! multiplicative factor for tracer values
82      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trcfac    ! multiplicative factor for tracer values
83      !!
[7646]84      NAMELIST/namtrc_bc/ cn_dir_obc, sn_trcobc, rn_trofac, cn_dir_sbc, sn_trcsbc, rn_trsfac, & 
[12377]85                        & cn_dir_cbc, sn_trccbc, rn_trcfac, ln_rnf_ctl, rn_sbc_time, rn_cbc_time
[6140]86      NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy
[4058]87      !!----------------------------------------------------------------------
88      !
[6140]89      IF( lwp ) THEN
[9169]90         WRITE(numout,*)
[7646]91         WRITE(numout,*) 'trc_bc_ini : Tracers Boundary Conditions (BC)'
[6140]92         WRITE(numout,*) '~~~~~~~~~~~ '
93      ENDIF
[4058]94      !  Initialisation and local array allocation
[9169]95      ierr0 = 0   ;   ierr1 = 0   ;   ierr2 = 0   ;   ierr3 = 0 
[4058]96      ALLOCATE( slf_i(ntrc), STAT=ierr0 )
97      IF( ierr0 > 0 ) THEN
[7646]98         CALL ctl_stop( 'trc_bc_ini: unable to allocate local slf_i' )   ;   RETURN
[4058]99      ENDIF
100
101      ! Compute the number of tracers to be initialised with open, surface and boundary data
102      ALLOCATE( n_trc_indobc(ntrc), STAT=ierr0 )
103      IF( ierr0 > 0 ) THEN
[7646]104         CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indobc' )   ;   RETURN
[4058]105      ENDIF
[9169]106      nb_trcobc       = 0
[4058]107      n_trc_indobc(:) = 0
108      !
109      ALLOCATE( n_trc_indsbc(ntrc), STAT=ierr0 )
110      IF( ierr0 > 0 ) THEN
[7646]111         CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indsbc' )   ;   RETURN
[4058]112      ENDIF
[9169]113      nb_trcsbc       = 0
[4058]114      n_trc_indsbc(:) = 0
115      !
116      ALLOCATE( n_trc_indcbc(ntrc), STAT=ierr0 )
117      IF( ierr0 > 0 ) THEN
[7646]118         CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indcbc' )   ;   RETURN
[4058]119      ENDIF
[9169]120      nb_trccbc       = 0
[4058]121      n_trc_indcbc(:) = 0
122      !
[6140]123      ! Read Boundary Conditions Namelists
124      READ  ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901)
[11536]125901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_bc in reference namelist' )
[6140]126      READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 )
[11536]127902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist' )
[6140]128      IF(lwm) WRITE ( numont, namtrc_bc )
129
[7646]130      IF ( ln_bdy ) THEN
131         READ  ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903)
[11536]132903      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist' )
133         ! make sur that all elements of the namelist variables have a default definition from namelist_ref
134         cn_trc     (2:jp_bdy) = cn_trc     (1)
135         cn_trc_dflt(2:jp_bdy) = cn_trc_dflt(1)
[7646]136         READ  ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 )
[11536]137904      IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist' )
[7646]138         IF(lwm) WRITE ( numont, namtrc_bdy )
139     
140         ! setup up preliminary informations for BDY structure
141         DO jn = 1, ntrc
142            DO ib = 1, nb_bdy
143               ! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml)
[9169]144               IF ( ln_trc_obc(jn) ) THEN   ;   trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc     (ib) )
145               ELSE                         ;   trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) )
[7646]146               ENDIF
147               ! set damping use in BDY data structure
148               trcdta_bdy(jn,ib)%dmp = .false.
[9169]149               IF(nn_trcdmp_bdy(ib) == 1 .AND. ln_trc_obc(jn) )   trcdta_bdy(jn,ib)%dmp = .true.
150               IF(nn_trcdmp_bdy(ib) == 2                      )   trcdta_bdy(jn,ib)%dmp = .true.
151               IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) /= 0 )  &
152                   & CALL ctl_stop( 'trc_bc_ini: Use FRS OR relaxation' )
153               IF(  .NOT.( 0 < nn_trcdmp_bdy(ib)  .AND.  nn_trcdmp_bdy(ib) <= 2 )  )   &
154                   & CALL ctl_stop( 'trc_bc_ini: Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' )
155            END DO
156         END DO
[7646]157      ELSE
158         ! Force all tracers OBC to false if bdy not used
159         ln_trc_obc = .false.
160      ENDIF
[6140]161
162      ! compose BC data indexes
163      DO jn = 1, ntrc
[4058]164         IF( ln_trc_obc(jn) ) THEN
[9169]165             nb_trcobc       = nb_trcobc + 1   ;   n_trc_indobc(jn) = nb_trcobc
[4058]166         ENDIF
167         IF( ln_trc_sbc(jn) ) THEN
[9169]168             nb_trcsbc       = nb_trcsbc + 1   ;   n_trc_indsbc(jn) = nb_trcsbc
[4058]169         ENDIF
170         IF( ln_trc_cbc(jn) ) THEN
[9169]171             nb_trccbc       = nb_trccbc + 1   ;   n_trc_indcbc(jn) = nb_trccbc
[4058]172         ENDIF
[9169]173      END DO
[4058]174
[6140]175      ! Print summmary of Boundary Conditions
176      IF( lwp ) THEN
[9169]177         WRITE(numout,*)
[6140]178         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with SURFACE BCs data:', nb_trcsbc
179         IF ( nb_trcsbc > 0 ) THEN
180            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. '
181            DO jn = 1, ntrc
182               IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn)
[9169]183            END DO
[6140]184         ENDIF
185         WRITE(numout,'(2a)') '   SURFACE BC data repository : ', TRIM(cn_dir_sbc)
[9169]186         !
187         WRITE(numout,*)
[6140]188         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with COASTAL BCs data:', nb_trccbc
[7646]189         IF( nb_trccbc > 0 ) THEN
[6140]190            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. '
191            DO jn = 1, ntrc
192               IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn)
[9169]193            END DO
[6140]194         ENDIF
195         WRITE(numout,'(2a)') '   COASTAL BC data repository : ', TRIM(cn_dir_cbc)
[9169]196         IF( .NOT.ln_rnf .OR. .NOT.ln_linssh )   ln_rnf_ctl = .FALSE.
[9119]197         IF( ln_rnf_ctl )  WRITE(numout,'(a)') &
198              &            ' -> Remove runoff dilution effect on tracers with absent river load (ln_rnf_ctl = .TRUE.)'
[9169]199         WRITE(numout,*)
[6140]200         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with OPEN BCs data:', nb_trcobc
[7646]201
202         IF( ln_bdy .AND. nb_trcobc > 0 ) THEN
[6140]203            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact.   OBC Settings'
204            DO jn = 1, ntrc
[9119]205               IF (       ln_trc_obc(jn) )  WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn)%clvar ), 'OBC', rn_trofac(jn), &
206                    &                                           (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy)
207               IF ( .NOT. ln_trc_obc(jn) )  WRITE(numout, 9002) jn, 'Set data to IC and use default condition'       , &
208                    &                                           (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy)
[9169]209            END DO
[6140]210            WRITE(numout,*) ' '
211            DO ib = 1, nb_bdy
[9169]212               IF(nn_trcdmp_bdy(ib) == 0) WRITE(numout,9003) '   Boundary ', ib, &
213                  &                                          ' -> NO damping of tracers'
214               IF(nn_trcdmp_bdy(ib) == 1) WRITE(numout,9003) '   Boundary ', ib, &
215                  &                                          ' -> damping ONLY for tracers with external data provided'
216               IF(nn_trcdmp_bdy(ib) == 2) WRITE(numout,9003) '   Boundary ', ib, &
217                  &                                          ' -> damping of ALL tracers'
218               IF(nn_trcdmp_bdy(ib) >  0) THEN
[6140]219                   WRITE(numout,9003) '     USE damping parameters from nambdy for boundary ', ib,' : '
[9169]220                   WRITE(numout,'(a,f10.2,a)') '     - Inflow damping time scale  : ',rn_time_dmp    (ib),' days'
[6140]221                   WRITE(numout,'(a,f10.2,a)') '     - Outflow damping time scale : ',rn_time_dmp_out(ib),' days'
[9169]222               ENDIF
223            END DO
[6140]224         ENDIF
[9169]225         !
[6140]226         WRITE(numout,'(2a)') '   OPEN BC data repository : ', TRIM(cn_dir_obc)
[4058]227      ENDIF
[6140]2289001  FORMAT(2x,i5, 3x, a15, 3x, a5, 6x, e11.3, 4x, 10a13)
2299002  FORMAT(2x,i5, 3x, a41, 3x, 10a13)
2309003  FORMAT(a, i5, a)
[4058]231      !
[9169]232      !
[4058]233      ! OPEN Lateral boundary conditions
[7646]234      IF( ln_bdy .AND. nb_trcobc > 0 ) THEN
[11536]235         ALLOCATE ( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), STAT=ierr1 )
[4058]236         IF( ierr1 > 0 ) THEN
[7646]237            CALL ctl_stop( 'trc_bc_ini: unable to allocate sf_trcobc structure' )   ;   RETURN
[4058]238         ENDIF
[9169]239         !
[6140]240         igrd = 1                       ! Everything is at T-points here
[9169]241         !
[4058]242         DO jn = 1, ntrc
[6140]243            DO ib = 1, nb_bdy
[9169]244               !
[6140]245               nblen = idx_bdy(ib)%nblen(igrd)
[9169]246               !
247               IF( ln_trc_obc(jn) ) THEN     !* Initialise from external data *!
[6140]248                  jl = n_trc_indobc(jn)
249                  slf_i(jl)    = sn_trcobc(jn)
250                  rf_trofac(jl) = rn_trofac(jn)
[9169]251                                                ALLOCATE( sf_trcobc(jl)%fnow(nblen,1,jpk)   , STAT=ierr2 )
252                  IF( sn_trcobc(jn)%ln_tint )   ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 )
[6140]253                  IF( ierr2 + ierr3 > 0 ) THEN
[7646]254                    CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer OBC data arrays' )   ;   RETURN
[6140]255                  ENDIF
256                  trcdta_bdy(jn,ib)%trc => sf_trcobc(jl)%fnow(:,1,:)
257                  trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl)
[9169]258               ELSE                          !* Initialise obc arrays from initial conditions *!
[6140]259                  ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) )
260                  DO ibd = 1, nblen
261                     DO ik = 1, jpkm1
262                        ii = idx_bdy(ib)%nbi(ibd,igrd)
263                        ij = idx_bdy(ib)%nbj(ibd,igrd)
[12377]264                        trcdta_bdy(jn,ib)%trc(ibd,ik) = tr(ii,ij,ik,jn,Kmm) * tmask(ii,ij,ik)
[6140]265                     END DO
266                  END DO
267                  trcdta_bdy(jn,ib)%rn_fac = 1._wp
[4058]268               ENDIF
[9169]269            END DO
270         END DO
271         !
[7646]272         CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_ini', 'Passive tracer OBC data', 'namtrc_bc' )
[11536]273         DO jn = 1, ntrc   ! define imap pointer, must be done after the call to fld_fill
274            DO ib = 1, nb_bdy
275               IF( ln_trc_obc(jn) ) THEN     !* Initialise from external data *!
276                  jl = n_trc_indobc(jn)
277                  sf_trcobc(jl)%imap => idx_bdy(ib)%nbmap(1:idx_bdy(ib)%nblen(igrd),igrd)
278               ENDIF
279            END DO
280         END DO
281         !
[4058]282      ENDIF
[7646]283
[4058]284      ! SURFACE Boundary conditions
285      IF( nb_trcsbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
286         ALLOCATE( sf_trcsbc(nb_trcsbc), rf_trsfac(nb_trcsbc), STAT=ierr1 )
287         IF( ierr1 > 0 ) THEN
[7646]288            CALL ctl_stop( 'trc_bc_ini: unable to allocate  sf_trcsbc structure' )   ;   RETURN
[4058]289         ENDIF
290         !
291         DO jn = 1, ntrc
292            IF( ln_trc_sbc(jn) ) THEN      ! update passive tracers arrays with input data read from file
293               jl = n_trc_indsbc(jn)
294               slf_i(jl)    = sn_trcsbc(jn)
295               rf_trsfac(jl) = rn_trsfac(jn)
296                                            ALLOCATE( sf_trcsbc(jl)%fnow(jpi,jpj,1)   , STAT=ierr2 )
297               IF( sn_trcsbc(jn)%ln_tint )  ALLOCATE( sf_trcsbc(jl)%fdta(jpi,jpj,1,2) , STAT=ierr3 )
298               IF( ierr2 + ierr3 > 0 ) THEN
[7646]299                 CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer SBC data arrays' )   ;   RETURN
[4058]300               ENDIF
301            ENDIF
302            !   
[9169]303         END DO
[4058]304         !                         ! fill sf_trcsbc with slf_i and control print
[7646]305         CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_ini', 'Passive tracer SBC data', 'namtrc_bc' )
[4058]306         !
307      ENDIF
308      !
309      ! COSTAL Boundary conditions
310      IF( nb_trccbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
311         ALLOCATE( sf_trccbc(nb_trccbc), rf_trcfac(nb_trccbc), STAT=ierr1 )
312         IF( ierr1 > 0 ) THEN
313            CALL ctl_stop( 'trc_bc_ini: unable to allocate  sf_trccbc structure' )   ;   RETURN
314         ENDIF
315         !
316         DO jn = 1, ntrc
317            IF( ln_trc_cbc(jn) ) THEN      ! update passive tracers arrays with input data read from file
318               jl = n_trc_indcbc(jn)
319               slf_i(jl)    = sn_trccbc(jn)
320               rf_trcfac(jl) = rn_trcfac(jn)
321                                            ALLOCATE( sf_trccbc(jl)%fnow(jpi,jpj,1)   , STAT=ierr2 )
322               IF( sn_trccbc(jn)%ln_tint )  ALLOCATE( sf_trccbc(jl)%fdta(jpi,jpj,1,2) , STAT=ierr3 )
323               IF( ierr2 + ierr3 > 0 ) THEN
324                 CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer CBC data arrays' )   ;   RETURN
325               ENDIF
326            ENDIF
327            !   
[9169]328         END DO
[4058]329         !                         ! fill sf_trccbc with slf_i and control print
[7646]330         CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_ini', 'Passive tracer CBC data', 'namtrc_bc' )
[4058]331         !
332      ENDIF
[6140]333      !
[4058]334      DEALLOCATE( slf_i )          ! deallocate local field structure
[6140]335      !
[7646]336   END SUBROUTINE trc_bc_ini
[4058]337
338
[12377]339   SUBROUTINE trc_bc(kt, Kmm, ptr, Krhs, jit)
[4058]340      !!----------------------------------------------------------------------
[7646]341      !!                   ***  ROUTINE trc_bc  ***
[4058]342      !!
[7646]343      !! ** Purpose :  Apply Boundary Conditions data to tracers
[4058]344      !!
[7646]345      !! ** Method  :  1) Read BC inputs and update data structures using fldread
346      !!               2) Apply Boundary Conditions to tracers
[4058]347      !!----------------------------------------------------------------------
348      USE fldread
[9124]349      !!     
[12377]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
[7646]354      !!
355      INTEGER  :: ji, jj, jk, jn, jl             ! Loop index
356      REAL(wp) :: zfact, zrnf
[4058]357      !!---------------------------------------------------------------------
358      !
[9124]359      IF( ln_timing )   CALL timing_start('trc_bc')
[4058]360
[6140]361      IF( kt == nit000 .AND. lwp) THEN
362         WRITE(numout,*)
[7646]363         WRITE(numout,*) 'trc_bc : Surface boundary conditions for passive tracers.'
[9169]364         WRITE(numout,*) '~~~~~~~ '
[4058]365      ENDIF
366
[7646]367      ! 1. Update Boundary conditions data
[9169]368      IF( PRESENT(jit) ) THEN 
369         !
[12377]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
[6140]371         IF( nb_trcobc > 0 ) THEN
372           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt
[12377]373           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kit=jit, pt_offset = 0.5_wp )
[6140]374         ENDIF
[9169]375         !
[6140]376         ! SURFACE boundary conditions
377         IF( nb_trcsbc > 0 ) THEN
378           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt
[9169]379           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit)
[6140]380         ENDIF
[9169]381         !
[6140]382         ! COASTAL boundary conditions
383         IF( nb_trccbc > 0 ) THEN
384           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt
[9169]385           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit)
[6140]386         ENDIF
[9169]387         !
[6140]388      ELSE
[9169]389         !
[12377]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
[6140]391         IF( nb_trcobc > 0 ) THEN
392           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt
[12377]393           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, pt_offset = 0.5_wp )
[6140]394         ENDIF
[9169]395         !
[6140]396         ! SURFACE boundary conditions
397         IF( nb_trcsbc > 0 ) THEN
398           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt
[9169]399           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcsbc )
[6140]400         ENDIF
[9169]401         !
[6140]402         ! COASTAL boundary conditions
403         IF( nb_trccbc > 0 ) THEN
404           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt
[9169]405           CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trccbc )
[6140]406         ENDIF
[9169]407         !
[4058]408      ENDIF
409
[7646]410      ! 2. Apply Boundary conditions data
411      !
412      DO jn = 1 , jptra
413         !
414         ! Remove river dilution for tracers with absent river load
[9169]415         IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN
[12377]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_rau0 / h_rnf(ji,jj)
419                  ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs)  + (ptr(ji,jj,jk,jn,Kmm) * zrnf)
[9169]420               END DO
[12377]421            END_2D
[7646]422         ENDIF
[9169]423         !
[7646]424         ! OPEN boundary conditions: trcbdy is called in trcnxt !
[9169]425         !
[7646]426         ! SURFACE boundary conditions
[9169]427         IF( ln_trc_sbc(jn) ) THEN
[7646]428            jl = n_trc_indsbc(jn)
[12377]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
[9169]434         ENDIF
435         !
[7646]436         ! COASTAL boundary conditions
[12377]437         IF( ( ln_rnf .OR. l_offline ) .AND. ln_trc_cbc(jn) ) THEN
438            IF( l_offline )   rn_rfact = 1._wp
[7646]439            jl = n_trc_indcbc(jn)
[12377]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
[7646]444               END DO
[12377]445            END_2D
[9169]446         ENDIF
[7646]447         !                                                       ! ===========
448      END DO                                                     ! tracer loop
449      !                                                          ! ===========
[9124]450      IF( ln_timing )   CALL timing_stop('trc_bc')
[4058]451      !
[7646]452   END SUBROUTINE trc_bc
[4058]453
454#else
455   !!----------------------------------------------------------------------
456   !!   Dummy module                              NO 3D passive tracer data
457   !!----------------------------------------------------------------------
458CONTAINS
[12377]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
[7646]463   END SUBROUTINE trc_bc_ini
[12377]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 
[7646]467   END SUBROUTINE trc_bc
[4058]468#endif
469
470   !!======================================================================
471END MODULE trcbc
Note: See TracBrowser for help on using the repository browser.