source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/TOP/trcbc.F90 @ 11954

Last change on this file since 11954 was 11671, checked in by acc, 17 months ago

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Final, non-substantive changes to complete this branch. These changes remove all REWIND statements on the old namelist fortran units (now character variables for internal files). These changes have been left until last since they are easily repeated via a script and it may be preferable to use the previous revision for merge purposes and reapply these last changes separately. This branch has been fully SETTE tested.

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