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 6140 for trunk/NEMOGCM/NEMO/TOP_SRC/trcbc.F90 – NEMO

Ignore:
Timestamp:
2015-12-21T12:35:23+01:00 (8 years ago)
Author:
timgraham
Message:

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    r5215 r6140  
    11MODULE trcbc 
    22   !!====================================================================== 
    3    !!                     ***  MODULE  trcdta  *** 
     3   !!                     ***  MODULE  trcbc  *** 
    44   !! TOP :  module for passive tracer boundary conditions 
    55   !!===================================================================== 
    6    !!---------------------------------------------------------------------- 
    7 #if  defined key_top  
     6   !! History :  3.5 !  2014-04  (M. Vichi, T. Lovato)  Original 
     7   !!            3.6 !  2015-03  (T . Lovato) Revision and BDY support 
     8   !!---------------------------------------------------------------------- 
     9#if defined key_top 
    810   !!---------------------------------------------------------------------- 
    911   !!   'key_top'                                                TOP model  
    1012   !!---------------------------------------------------------------------- 
    11    !!   trc_dta    : read and time interpolated passive tracer data 
     13   !!   trc_bc       : read and time interpolated tracer Boundary Conditions 
    1214   !!---------------------------------------------------------------------- 
    1315   USE par_trc       !  passive tracers parameters 
     
    1719   USE lib_mpp       !  MPP library 
    1820   USE fldread       !  read input fields 
     21#if defined key_bdy 
     22   USE bdy_oce, only: nb_bdy , idx_bdy, ln_coords_file, rn_time_dmp, rn_time_dmp_out 
     23#endif 
    1924 
    2025   IMPLICIT NONE 
     
    2429   PUBLIC   trc_bc_read    ! called in trcstp.F90 or within 
    2530 
    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 
     31   INTEGER  , SAVE, PUBLIC                             :: nb_trcobc    ! number of tracers with open BC 
     32   INTEGER  , SAVE, PUBLIC                             :: nb_trcsbc    ! number of tracers with surface BC 
     33   INTEGER  , SAVE, PUBLIC                             :: nb_trccbc    ! number of tracers with coastal BC 
    2934   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indobc ! index of tracer with OBC data 
    3035   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indsbc ! index of tracer with SBC data 
    3136   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indcbc ! index of tracer with CBC data 
    32    INTEGER  , SAVE, PUBLIC                             :: ntra_obc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 
    33    INTEGER  , SAVE, PUBLIC                             :: ntra_sbc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 
    34    INTEGER  , SAVE, PUBLIC                             :: ntra_cbc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 
    35    REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trofac   ! multiplicative factor for OBCtracer values 
    36    TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcobc   ! structure of data input OBC (file informations, fields read) 
    37    REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trsfac   ! multiplicative factor for SBC tracer values 
    38    TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcsbc   ! structure of data input SBC (file informations, fields read) 
    39    REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trcfac   ! multiplicative factor for CBC tracer values 
    40    TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trccbc   ! structure of data input CBC (file informations, fields read) 
    41  
    42    !! * Substitutions 
    43 #  include "domzgr_substitute.h90" 
    44    !!---------------------------------------------------------------------- 
    45    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    46    !! $Id$  
     37   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trsfac    ! multiplicative factor for SBC tracer values 
     38   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcsbc    ! structure of data input SBC (file informations, fields read) 
     39   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trcfac    ! multiplicative factor for CBC tracer values 
     40   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trccbc    ! structure of data input CBC (file informations, fields read) 
     41   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trofac    ! multiplicative factor for OBCtracer values 
     42   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET  :: sf_trcobc    ! structure of data input OBC (file informations, fields read) 
     43   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr   ! array of pointers to nbmap 
     44 
     45   !!---------------------------------------------------------------------- 
     46   !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
     47   !! $Id$ 
    4748   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4849   !!---------------------------------------------------------------------- 
    4950CONTAINS 
    5051 
    51    SUBROUTINE trc_bc_init(ntrc) 
     52   SUBROUTINE trc_bc_init( ntrc ) 
    5253      !!---------------------------------------------------------------------- 
    5354      !!                   ***  ROUTINE trc_bc_init  *** 
     
    6061      ! 
    6162      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
    62       INTEGER            :: jl, jn                         ! dummy loop indices 
     63      INTEGER            :: jl, jn , ib, ibd, ii, ij, ik   ! dummy loop indices 
    6364      INTEGER            :: ierr0, ierr1, ierr2, ierr3     ! temporary integers 
    64       INTEGER            ::  ios                           ! Local integer output status for namelist read 
     65      INTEGER            :: ios                            ! Local integer output status for namelist read 
     66      INTEGER            :: nblen, igrd                    ! support arrays for BDY 
    6567      CHARACTER(len=100) :: clndta, clntrc 
    6668      ! 
    67       CHARACTER(len=100) :: cn_dir 
     69      CHARACTER(len=100) :: cn_dir_sbc, cn_dir_cbc, cn_dir_obc 
     70 
    6871      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i  ! local array of namelist informations on the fields to read 
    6972      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc    ! open 
     
    7477      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trcfac    ! multiplicative factor for tracer values 
    7578      !! 
    76       NAMELIST/namtrc_bc/ cn_dir, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac  
     79      NAMELIST/namtrc_bc/ cn_dir_sbc, cn_dir_cbc, cn_dir_obc, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac 
     80#if defined key_bdy 
     81      NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy 
     82#endif 
    7783      !!---------------------------------------------------------------------- 
    7884      IF( nn_timing == 1 )  CALL timing_start('trc_bc_init') 
    7985      ! 
     86      IF( lwp ) THEN 
     87         WRITE(numout,*) ' ' 
     88         WRITE(numout,*) 'trc_bc_init : Tracers Boundary Conditions (BC)' 
     89         WRITE(numout,*) '~~~~~~~~~~~ ' 
     90      ENDIF 
    8091      !  Initialisation and local array allocation 
    8192      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0   
     
    107118      n_trc_indcbc(:) = 0 
    108119      ! 
    109       DO jn = 1, ntrc 
    110          IF( ln_trc_obc(jn) ) THEN 
    111              nb_trcobc       = nb_trcobc + 1  
    112              n_trc_indobc(jn) = nb_trcobc  
    113          ENDIF 
    114          IF( ln_trc_sbc(jn) ) THEN 
    115              nb_trcsbc       = nb_trcsbc + 1 
    116              n_trc_indsbc(jn) = nb_trcsbc 
    117          ENDIF 
    118          IF( ln_trc_cbc(jn) ) THEN 
    119              nb_trccbc       = nb_trccbc + 1 
    120              n_trc_indcbc(jn) = nb_trccbc 
    121          ENDIF 
    122       ENDDO 
    123       ntra_obc = MAX( 1, nb_trcobc )   ! To avoid compilation error with bounds checking 
    124       IF( lwp ) WRITE(numout,*) ' ' 
    125       IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with open boundary data :', nb_trcobc 
    126       IF( lwp ) WRITE(numout,*) ' ' 
    127       ntra_sbc = MAX( 1, nb_trcsbc )   ! To avoid compilation error with bounds checking 
    128       IF( lwp ) WRITE(numout,*) ' ' 
    129       IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with surface boundary data :', nb_trcsbc 
    130       IF( lwp ) WRITE(numout,*) ' ' 
    131       ntra_cbc = MAX( 1, nb_trccbc )   ! To avoid compilation error with bounds checking 
    132       IF( lwp ) WRITE(numout,*) ' ' 
    133       IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with coastal boundary data :', nb_trccbc 
    134       IF( lwp ) WRITE(numout,*) ' ' 
    135  
     120      ! Read Boundary Conditions Namelists 
    136121      REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 
    137122      READ  ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901) 
     
    143128      IF(lwm) WRITE ( numont, namtrc_bc ) 
    144129 
    145       ! print some information for each  
     130#if defined key_bdy 
     131      REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 
     132      READ  ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903) 
     133903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp ) 
     134 
     135      REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 
     136      READ  ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 ) 
     137904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp ) 
     138      IF(lwm) WRITE ( numont, namtrc_bdy ) 
     139      ! setup up preliminary informations for BDY structure 
     140      DO jn = 1, ntrc 
     141         DO ib = 1, nb_bdy 
     142            ! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml) 
     143            IF ( ln_trc_obc(jn) ) THEN 
     144               trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) ) 
     145            ELSE 
     146               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) .EQ. 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .true. 
     151            IF(nn_trcdmp_bdy(ib) .EQ. 2 ) trcdta_bdy(jn,ib)%dmp = .true. 
     152            IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) .NE. 0 )  & 
     153                & CALL ctl_stop( 'Use FRS OR relaxation' ) 
     154            IF (nn_trcdmp_bdy(ib) .LT. 0 .OR. nn_trcdmp_bdy(ib) .GT. 2)            & 
     155                & CALL ctl_stop( 'Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 
     156         ENDDO 
     157      ENDDO 
     158 
     159#else 
     160      ! Force all tracers OBC to false if bdy not used 
     161      ln_trc_obc = .false. 
     162#endif 
     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      ENDDO 
     175 
     176      ! Print summmary of Boundary Conditions 
    146177      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            ENDDO 
     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            ENDDO 
     195         ENDIF 
     196         WRITE(numout,'(2a)') '   COASTAL BC data repository : ', TRIM(cn_dir_cbc) 
     197 
     198         WRITE(numout,*) ' ' 
     199         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with OPEN BCs data:', nb_trcobc 
     200#if defined key_bdy 
     201         IF ( nb_trcobc > 0 ) THEN 
     202            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact.   OBC Settings' 
     203            DO jn = 1, ntrc 
     204               IF ( ln_trc_obc(jn) )  WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn)%clvar ), 'OBC', rn_trofac(jn), (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', (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 
     206            ENDDO 
     207            WRITE(numout,*) ' ' 
     208            DO ib = 1, nb_bdy 
     209                IF (nn_trcdmp_bdy(ib) .EQ. 0) WRITE(numout,9003) '   Boundary ',ib,' -> NO damping of tracers' 
     210                IF (nn_trcdmp_bdy(ib) .EQ. 1) WRITE(numout,9003) '   Boundary ',ib,' -> damping ONLY for tracers with external data provided' 
     211                IF (nn_trcdmp_bdy(ib) .EQ. 2) WRITE(numout,9003) '   Boundary ',ib,' -> damping of ALL tracers' 
     212                IF (nn_trcdmp_bdy(ib) .GT. 0) THEN 
     213                   WRITE(numout,9003) '     USE damping parameters from nambdy for boundary ', ib,' : ' 
     214                   WRITE(numout,'(a,f10.2,a)') '     - Inflow damping time scale  : ',rn_time_dmp(ib),' days' 
     215                   WRITE(numout,'(a,f10.2,a)') '     - Outflow damping time scale : ',rn_time_dmp_out(ib),' days' 
     216                ENDIF 
     217            ENDDO 
     218         ENDIF 
     219#endif 
     220         WRITE(numout,'(2a)') '   OPEN BC data repository : ', TRIM(cn_dir_obc) 
     221      ENDIF 
     2229001  FORMAT(2x,i5, 3x, a15, 3x, a5, 6x, e11.3, 4x, 10a13) 
     2239002  FORMAT(2x,i5, 3x, a41, 3x, 10a13) 
     2249003  FORMAT(a, i5, a) 
     225 
     226      ! 
     227#if defined key_bdy 
     228      ! OPEN Lateral boundary conditions 
     229      IF( nb_trcobc > 0 ) THEN  
     230         ALLOCATE ( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), nbmap_ptr(nb_trcobc), STAT=ierr1 ) 
     231         IF( ierr1 > 0 ) THEN 
     232            CALL ctl_stop( 'trc_bc_init: unable to allocate sf_trcobc structure' )   ;   RETURN 
     233         ENDIF 
     234 
     235         igrd = 1                       ! Everything is at T-points here 
     236 
    147237         DO jn = 1, ntrc 
    148             IF( ln_trc_obc(jn) )  THEN     
    149                clndta = TRIM( sn_trcobc(jn)%clvar )  
    150                IF(lwp) WRITE(numout,*) 'Preparing to read OBC data file for passive tracer number :', jn, ' name : ', clndta, &  
    151                &               ' multiplicative factor : ', rn_trofac(jn) 
    152             ENDIF 
    153             IF( ln_trc_sbc(jn) )  THEN     
    154                clndta = TRIM( sn_trcsbc(jn)%clvar )  
    155                IF(lwp) WRITE(numout,*) 'Preparing to read SBC data file for passive tracer number :', jn, ' name : ', clndta, &  
    156                &               ' multiplicative factor : ', rn_trsfac(jn) 
    157             ENDIF 
    158             IF( ln_trc_cbc(jn) )  THEN     
    159                clndta = TRIM( sn_trccbc(jn)%clvar )  
    160                IF(lwp) WRITE(numout,*) 'Preparing to read CBC data file for passive tracer number :', jn, ' name : ', clndta, &  
    161                &               ' multiplicative factor : ', rn_trcfac(jn) 
    162             ENDIF 
    163          END DO 
    164       ENDIF 
    165       ! 
    166       ! The following code is written this way to reduce memory usage and repeated for each boundary data 
    167       ! MAV: note that this is just a placeholder and the dimensions must be changed according to  
    168       !      what will be done with BDY. A new structure will probably need to be included 
    169       ! 
    170       ! OPEN Lateral boundary conditions 
    171       IF( nb_trcobc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero 
    172          ALLOCATE( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), STAT=ierr1 ) 
    173          IF( ierr1 > 0 ) THEN 
    174             CALL ctl_stop( 'trc_bc_init: unable to allocate  sf_trcobc structure' )   ;   RETURN 
    175          ENDIF 
    176          ! 
    177          DO jn = 1, ntrc 
    178             IF( ln_trc_obc(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    179                jl = n_trc_indobc(jn) 
    180                slf_i(jl)    = sn_trcobc(jn) 
    181                rf_trofac(jl) = rn_trofac(jn) 
    182                                             ALLOCATE( sf_trcobc(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 ) 
    183                IF( sn_trcobc(jn)%ln_tint )  ALLOCATE( sf_trcobc(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
    184                IF( ierr2 + ierr3 > 0 ) THEN 
    185                  CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' )   ;   RETURN 
     238            DO ib = 1, nb_bdy 
     239 
     240               nblen = idx_bdy(ib)%nblen(igrd) 
     241 
     242               IF ( ln_trc_obc(jn) ) THEN 
     243               ! Initialise from external data 
     244                  jl = n_trc_indobc(jn) 
     245                  slf_i(jl)    = sn_trcobc(jn) 
     246                  rf_trofac(jl) = rn_trofac(jn) 
     247                                               ALLOCATE( sf_trcobc(jl)%fnow(nblen,1,jpk)   , STAT=ierr2 ) 
     248                  IF( sn_trcobc(jn)%ln_tint )  ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 
     249                  IF( ierr2 + ierr3 > 0 ) THEN 
     250                    CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' )   ;   RETURN 
     251                  ENDIF 
     252                  trcdta_bdy(jn,ib)%trc => sf_trcobc(jl)%fnow(:,1,:) 
     253                  trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl) 
     254                  ! create OBC mapping array 
     255                  nbmap_ptr(jl)%ptr => idx_bdy(ib)%nbmap(:,igrd) 
     256                  nbmap_ptr(jl)%ll_unstruc = ln_coords_file(igrd) 
     257               ELSE 
     258               ! Initialise obc arrays from initial conditions 
     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) 
     264                        trcdta_bdy(jn,ib)%trc(ibd,ik) = trn(ii,ij,ik,jn) * tmask(ii,ij,ik) 
     265                     END DO 
     266                  END DO 
     267                  trcdta_bdy(jn,ib)%rn_fac = 1._wp 
    186268               ENDIF 
    187             ENDIF 
    188             !    
     269            ENDDO 
    189270         ENDDO 
    190          !                         ! fill sf_trcdta with slf_i and control print 
    191          CALL fld_fill( sf_trcobc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 
    192          ! 
    193       ENDIF 
    194       ! 
     271 
     272         CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 
     273      ENDIF 
     274#endif 
    195275      ! SURFACE Boundary conditions 
    196276      IF( nb_trcsbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero 
     
    214294         ENDDO 
    215295         !                         ! fill sf_trcsbc with slf_i and control print 
    216          CALL fld_fill( sf_trcsbc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' ) 
     296         CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' ) 
    217297         ! 
    218298      ENDIF 
     
    239319         ENDDO 
    240320         !                         ! fill sf_trccbc with slf_i and control print 
    241          CALL fld_fill( sf_trccbc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' ) 
     321         CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' ) 
    242322         ! 
    243323      ENDIF 
    244   
     324      ! 
    245325      DEALLOCATE( slf_i )          ! deallocate local field structure 
    246326      IF( nn_timing == 1 )  CALL timing_stop('trc_bc_init') 
    247  
     327      ! 
    248328   END SUBROUTINE trc_bc_init 
    249329 
    250330 
    251    SUBROUTINE trc_bc_read(kt) 
     331   SUBROUTINE trc_bc_read(kt, jit) 
    252332      !!---------------------------------------------------------------------- 
    253333      !!                   ***  ROUTINE trc_bc_init  *** 
     
    258338      !!               
    259339      !!---------------------------------------------------------------------- 
    260     
    261       ! NEMO 
    262340      USE fldread 
    263341       
    264342      !! * Arguments 
    265343      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    266  
     344      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
    267345      !!--------------------------------------------------------------------- 
    268346      ! 
    269347      IF( nn_timing == 1 )  CALL timing_start('trc_bc_read') 
    270348 
    271       IF( kt == nit000 ) THEN 
    272          IF(lwp) WRITE(numout,*) 
    273          IF(lwp) WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.' 
    274          IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    275       ENDIF 
    276  
    277       ! OPEN boundary conditions: DOES NOT WORK. Waiting for stable BDY 
    278       IF( nb_trcobc > 0 ) THEN 
    279         if (lwp) write(numout,'(a,i5,a,i5)') '   reading OBC data for ', nb_trcobc ,' variables at step ', kt 
    280         CALL fld_read(kt,1,sf_trcobc) 
    281         ! vertical interpolation on s-grid and partial step to be added 
    282       ENDIF 
    283  
    284       ! SURFACE boundary conditions        
    285       IF( nb_trcsbc > 0 ) THEN 
    286         if (lwp) write(numout,'(a,i5,a,i5)') '   reading SBC data for ', nb_trcsbc ,' variables at step ', kt 
    287         CALL fld_read(kt,1,sf_trcsbc) 
    288       ENDIF 
    289  
    290       ! COASTAL boundary conditions        
    291       IF( nb_trccbc > 0 ) THEN 
    292         if (lwp) write(numout,'(a,i5,a,i5)') '   reading CBC data for ', nb_trccbc ,' variables at step ', kt 
    293         CALL fld_read(kt,1,sf_trccbc) 
    294       ENDIF    
     349      IF( kt == nit000 .AND. lwp) THEN 
     350         WRITE(numout,*) 
     351         WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.' 
     352         WRITE(numout,*) '~~~~~~~~~~~ ' 
     353      ENDIF 
     354 
     355      IF ( PRESENT(jit) ) THEN  
     356 
     357         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
     358         IF( nb_trcobc > 0 ) THEN 
     359           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
     360           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kit=jit, kt_offset=+1) 
     361         ENDIF 
     362 
     363         ! SURFACE boundary conditions 
     364         IF( nb_trcsbc > 0 ) THEN 
     365           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
     366           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit) 
     367         ENDIF 
     368 
     369         ! COASTAL boundary conditions 
     370         IF( nb_trccbc > 0 ) THEN 
     371           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
     372           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit) 
     373         ENDIF 
     374 
     375      ELSE 
     376 
     377         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
     378         IF( nb_trcobc > 0 ) THEN 
     379           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
     380           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc, map=nbmap_ptr, kt_offset=+1) 
     381         ENDIF 
     382 
     383         ! SURFACE boundary conditions 
     384         IF( nb_trcsbc > 0 ) THEN 
     385           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
     386           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc) 
     387         ENDIF 
     388 
     389         ! COASTAL boundary conditions 
     390         IF( nb_trccbc > 0 ) THEN 
     391           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
     392           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc) 
     393         ENDIF 
     394 
     395      ENDIF 
     396 
    295397      ! 
    296398      IF( nn_timing == 1 )  CALL timing_stop('trc_bc_read') 
    297       !        
    298  
     399      ! 
    299400   END SUBROUTINE trc_bc_read 
     401 
    300402#else 
    301403   !!---------------------------------------------------------------------- 
     
    303405   !!---------------------------------------------------------------------- 
    304406CONTAINS 
     407 
     408   SUBROUTINE trc_bc_init( ntrc )        ! Empty routine 
     409      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
     410      WRITE(*,*) 'trc_bc_init: You should not have seen this print! error?', kt 
     411   END SUBROUTINE trc_bc_init 
     412 
    305413   SUBROUTINE trc_bc_read( kt )        ! Empty routine 
    306414      WRITE(*,*) 'trc_bc_read: You should not have seen this print! error?', kt 
Note: See TracChangeset for help on using the changeset viewer.