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/branches/2019/dev_r11943_MERGE_2019/src/TOP – NEMO

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/trcbc.F90 @ 12340

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

Branch 2019/dev_r11943_MERGE_2019. This commit introduces basic do loop macro
substitution to the 2019 option 1, merge branch. These changes have been SETTE
tested. The only addition is the do_loop_substitute.h90 file in the OCE directory but
the macros defined therein are used throughout the code to replace identifiable, 2D-
and 3D- nested loop opening and closing statements with single-line alternatives. Code
indents are also adjusted accordingly.

The following explanation is taken from comments in the new header file:

This header file contains preprocessor definitions and macros used in the do-loop
substitutions introduced between version 4.0 and 4.2. The primary aim of these macros
is to assist in future applications of tiling to improve performance. This is expected
to be achieved by alternative versions of these macros in selected locations. The
initial introduction of these macros simply replaces all identifiable nested 2D- and
3D-loops with single line statements (and adjusts indenting accordingly). Do loops
are identifiable if they comform to either:

DO jk = ....

DO jj = .... DO jj = ...

DO ji = .... DO ji = ...
. OR .
. .

END DO END DO

END DO END DO

END DO

and white-space variants thereof.

Additionally, only loops with recognised jj and ji loops limits are treated; these are:
Lower limits of 1, 2 or fs_2
Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj)

The macro naming convention takes the form: DO_2D_BT_LR where:

B is the Bottom offset from the PE's inner domain;
T is the Top offset from the PE's inner domain;
L is the Left offset from the PE's inner domain;
R is the Right offset from the PE's inner domain

So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace:

DO jj = 2, jpj

DO ji = 1, jpim1
.
.

END DO

END DO

with:

DO_2D_01_10
.
.
END_2D

similar conventions apply to the 3D loops macros. jk loop limits are retained
through macro arguments and are not restricted. This includes the possibility of
strides for which an extra set of DO_3DS macros are defined.

In the example definition below the inner PE domain is defined by start indices of
(kIs, kJs) and end indices of (kIe, KJe)

#define DO_2D_00_00 DO jj = kJs, kJe ; DO ji = kIs, kIe
#define END_2D END DO ; END DO

TO DO:

Only conventional nested loops have been identified and replaced by this step. There are constructs such as:

DO jk = 2, jpkm1

z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk)

END DO

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