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 10156 for branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/trcbc.F90 – NEMO

Ignore:
Timestamp:
2018-09-25T13:10:14+02:00 (6 years ago)
Author:
dford
Message:

Apply patch fabm_patch_e3284ca_889163b.diff from Jim Clark.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    r8058 r10156  
    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) 
     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 
    4144 
    4245   !! * Substitutions 
    4346#  include "domzgr_substitute.h90" 
    4447   !!---------------------------------------------------------------------- 
    45    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     48   !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
    4649   !! $Id$ 
    4750   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    6063      ! 
    6164      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
    62       INTEGER            :: jl, jn                         ! dummy loop indices 
     65      INTEGER            :: jl, jn , ib, ibd, ii, ij, ik   ! dummy loop indices 
    6366      INTEGER            :: ierr0, ierr1, ierr2, ierr3     ! temporary integers 
    64       INTEGER            ::  ios                           ! Local integer output status for namelist read 
     67      INTEGER            :: ios                            ! Local integer output status for namelist read 
     68      INTEGER            :: nblen, igrd                    ! support arrays for BDY 
    6569      CHARACTER(len=100) :: clndta, clntrc 
    6670      ! 
    67       CHARACTER(len=100) :: cn_dir 
     71      CHARACTER(len=100) :: cn_dir_sbc, cn_dir_cbc, cn_dir_obc 
     72 
    6873      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i  ! local array of namelist informations on the fields to read 
    69       TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc    ! open 
     74      TYPE(FLD_N), DIMENSION(jpmaxtrc,2) :: sn_trcobc  ! open 
     75      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc2   ! to read in multiple (2) open bdy 
    7076      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcsbc    ! surface 
    7177      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trccbc    ! coastal 
     
    7480      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trcfac    ! multiplicative factor for tracer values 
    7581      !! 
    76       NAMELIST/namtrc_bc/ cn_dir, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac  
     82      NAMELIST/namtrc_bc/ cn_dir_sbc, cn_dir_cbc, cn_dir_obc, sn_trcobc2, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac 
     83#if defined key_bdy 
     84      NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy 
     85#endif 
    7786      !!---------------------------------------------------------------------- 
    7887      IF( nn_timing == 1 )  CALL timing_start('trc_bc_init') 
    7988      ! 
     89      IF( lwp ) THEN 
     90         WRITE(numout,*) ' ' 
     91         WRITE(numout,*) 'trc_bc_init : Tracers Boundary Conditions (BC)' 
     92         WRITE(numout,*) '~~~~~~~~~~~ ' 
     93      ENDIF 
    8094      !  Initialisation and local array allocation 
    8195      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0   
     
    107121      n_trc_indcbc(:) = 0 
    108122      ! 
    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  
     123      ! Read Boundary Conditions Namelists 
    136124      REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 
    137125      READ  ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901) 
     
    139127 
    140128      REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 
    141       READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 ) 
    142 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp ) 
    143       IF(lwm) WRITE ( numont, namtrc_bc ) 
    144  
    145       ! print some information for each  
     129#if defined key_bdy 
     130      DO ib = 1, nb_bdy 
     131#endif 
     132        READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 ) 
     133902     IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp ) 
     134        IF(lwm) WRITE ( numont, namtrc_bc ) 
     135#if defined key_bdy 
     136        sn_trcobc(:,ib)=sn_trcobc2(:) 
     137      ENDDO 
     138#endif 
     139 
     140#if defined key_bdy 
     141      REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 
     142      READ  ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903) 
     143903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp ) 
     144 
     145      REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 
     146      READ  ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 ) 
     147904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp ) 
     148      IF(lwm) WRITE ( numont, namtrc_bdy ) 
     149      ! setup up preliminary informations for BDY structure 
     150      DO jn = 1, ntrc 
     151         DO ib = 1, nb_bdy 
     152            ! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml) 
     153            IF ( ln_trc_obc(jn) ) THEN 
     154               trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) ) 
     155            ELSE 
     156               trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) ) 
     157            ENDIF 
     158            ! set damping use in BDY data structure 
     159            trcdta_bdy(jn,ib)%dmp = .false. 
     160            IF(nn_trcdmp_bdy(ib) .EQ. 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .true. 
     161            IF(nn_trcdmp_bdy(ib) .EQ. 2 ) trcdta_bdy(jn,ib)%dmp = .true. 
     162            IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) .NE. 0 )  & 
     163                & CALL ctl_stop( 'Use FRS OR relaxation' ) 
     164            IF (nn_trcdmp_bdy(ib) .LT. 0 .OR. nn_trcdmp_bdy(ib) .GT. 2)            & 
     165                & CALL ctl_stop( 'Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 
     166         ENDDO 
     167      ENDDO 
     168 
     169#else 
     170      ! Force all tracers OBC to false if bdy not used 
     171      ln_trc_obc = .false. 
     172#endif 
     173      ! compose BC data indexes 
     174      DO jn = 1, ntrc 
     175         IF( ln_trc_obc(jn) ) THEN 
     176             nb_trcobc       = nb_trcobc + 1  ; n_trc_indobc(jn) = nb_trcobc 
     177         ENDIF 
     178         IF( ln_trc_sbc(jn) ) THEN 
     179             nb_trcsbc       = nb_trcsbc + 1  ; n_trc_indsbc(jn) = nb_trcsbc 
     180         ENDIF 
     181         IF( ln_trc_cbc(jn) ) THEN 
     182             nb_trccbc       = nb_trccbc + 1  ; n_trc_indcbc(jn) = nb_trccbc 
     183         ENDIF 
     184      ENDDO 
     185      ntra_obc = MAX( 1, nb_trcobc )   ! To avoid compilation error with bounds checking 
     186      IF( lwp ) WRITE(numout,*) ' ' 
     187      IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with open boundary data :', nb_trcobc 
     188      IF( lwp ) WRITE(numout,*) ' ' 
     189      ntra_sbc = MAX( 1, nb_trcsbc )   ! To avoid compilation error with bounds checking 
     190      IF( lwp ) WRITE(numout,*) ' ' 
     191      IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with surface boundary data :', nb_trcsbc 
     192      IF( lwp ) WRITE(numout,*) ' ' 
     193      ntra_cbc = MAX( 1, nb_trccbc )   ! To avoid compilation error with bounds checking 
     194      IF( lwp ) WRITE(numout,*) ' ' 
     195      IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with coastal boundary data :', nb_trccbc 
     196      IF( lwp ) WRITE(numout,*) ' ' 
     197 
     198      ! Print summmary of Boundary Conditions 
    146199      IF( lwp ) THEN 
    147          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       ! 
     200         WRITE(numout,*) ' ' 
     201         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with SURFACE BCs data:', nb_trcsbc 
     202         IF ( nb_trcsbc > 0 ) THEN 
     203            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. ' 
     204            DO jn = 1, ntrc 
     205               IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn) 
     206            ENDDO 
     207         ENDIF 
     208         WRITE(numout,'(2a)') '   SURFACE BC data repository : ', TRIM(cn_dir_sbc) 
     209 
     210         WRITE(numout,*) ' ' 
     211         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with COASTAL BCs data:', nb_trccbc 
     212         IF ( nb_trccbc > 0 ) THEN 
     213            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. ' 
     214            DO jn = 1, ntrc 
     215               IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn) 
     216            ENDDO 
     217         ENDIF 
     218         WRITE(numout,'(2a)') '   COASTAL BC data repository : ', TRIM(cn_dir_cbc) 
     219 
     220         WRITE(numout,*) ' ' 
     221         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with OPEN BCs data:', nb_trcobc 
     222#if defined key_bdy 
     223         IF ( nb_trcobc > 0 ) THEN 
     224            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact.   OBC Settings' 
     225            DO jn = 1, ntrc 
     226               DO ib = 1, nb_bdy 
     227                 IF ( ln_trc_obc(jn) )  WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn,ib)%clvar ), 'OBC', rn_trofac(jn), (trcdta_bdy(jn,ib)%cn_obc) 
     228               ENDDO 
     229               !IF ( ln_trc_obc(jn) )  WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn,ib)%clvar ), 'OBC', rn_trofac(jn), (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 
     230               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) 
     231            ENDDO 
     232            WRITE(numout,*) ' ' 
     233            DO ib = 1, nb_bdy 
     234                IF (nn_trcdmp_bdy(ib) .EQ. 0) WRITE(numout,9003) '   Boundary ',ib,' -> NO damping of tracers' 
     235                IF (nn_trcdmp_bdy(ib) .EQ. 1) WRITE(numout,9003) '   Boundary ',ib,' -> damping ONLY for tracers with external data provided' 
     236                IF (nn_trcdmp_bdy(ib) .EQ. 2) WRITE(numout,9003) '   Boundary ',ib,' -> damping of ALL tracers' 
     237                IF (nn_trcdmp_bdy(ib) .GT. 0) THEN 
     238                   WRITE(numout,9003) '     USE damping parameters from nambdy for boundary ', ib,' : ' 
     239                   WRITE(numout,'(a,f10.2,a)') '     - Inflow damping time scale  : ',rn_time_dmp(ib),' days' 
     240                   WRITE(numout,'(a,f10.2,a)') '     - Outflow damping time scale : ',rn_time_dmp_out(ib),' days' 
     241                ENDIF 
     242            ENDDO 
     243         ENDIF 
     244#endif 
     245         WRITE(numout,'(2a)') '   OPEN BC data repository : ', TRIM(cn_dir_obc) 
     246      ENDIF 
     2479001  FORMAT(2x,i5, 3x, a15, 3x, a5, 6x, e11.3, 4x, 10a13) 
     2489002  FORMAT(2x,i5, 3x, a41, 3x, 10a13) 
     2499003  FORMAT(a, i5, a) 
     250 
     251      ! 
     252#if defined key_bdy 
    170253      ! 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 ) 
     254      IF( nb_trcobc > 0 ) THEN  
     255         ALLOCATE ( sf_trcobc(nb_trcobc,nb_bdy), rf_trofac(nb_trcobc,nb_bdy), nbmap_ptr(nb_trcobc,nb_bdy), STAT=ierr1 ) 
    173256         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 
     257            CALL ctl_stop( 'trc_bc_init: unable to allocate sf_trcobc structure' )   ;   RETURN 
     258         ENDIF 
     259 
     260         igrd = 1                       ! Everything is at T-points here 
     261 
     262         DO ib = 1, nb_bdy 
     263            DO jn = 1, ntrc 
     264 
     265               nblen = idx_bdy(ib)%nblen(igrd) 
     266 
     267               IF ( ln_trc_obc(jn) ) THEN 
     268               ! Initialise from external data 
     269                  jl = n_trc_indobc(jn) 
     270                  slf_i(jl)    = sn_trcobc(jn,ib) 
     271                  rf_trofac(jl,ib) = rn_trofac(jn) 
     272                                               ALLOCATE( sf_trcobc(jl,ib)%fnow(nblen,1,jpk)   , STAT=ierr2 ) 
     273                  IF( sn_trcobc(jn,ib)%ln_tint )  ALLOCATE( sf_trcobc(jl,ib)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 
     274                  IF( ierr2 + ierr3 > 0 ) THEN 
     275                    CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' )   ;   RETURN 
     276                  ENDIF 
     277                  trcdta_bdy(jn,ib)%trc => sf_trcobc(jl,ib)%fnow(:,1,:) 
     278                  trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl,ib) 
     279                  ! create OBC mapping array 
     280                  nbmap_ptr(jl,ib)%ptr => idx_bdy(ib)%nbmap(:,igrd) 
     281                  nbmap_ptr(jl,ib)%ll_unstruc = ln_coords_file(igrd) 
     282               ELSE 
     283               ! Initialise obc arrays from initial conditions 
     284                  ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) ) 
     285                  DO ibd = 1, nblen 
     286                     DO ik = 1, jpkm1 
     287                        ii = idx_bdy(ib)%nbi(ibd,igrd) 
     288                        ij = idx_bdy(ib)%nbj(ibd,igrd) 
     289                        trcdta_bdy(jn,ib)%trc(ibd,ik) = trn(ii,ij,ik,jn) * tmask(ii,ij,ik) 
     290                     END DO 
     291                  END DO 
     292                  trcdta_bdy(jn,ib)%rn_fac = 1._wp 
    186293               ENDIF 
    187             ENDIF 
    188             !    
     294            ENDDO 
     295            CALL fld_fill( sf_trcobc(:,ib), slf_i, cn_dir_obc, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 
    189296         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       ! 
     297 
     298      ENDIF 
     299#endif 
    195300      ! SURFACE Boundary conditions 
    196301      IF( nb_trcsbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero 
     
    214319         ENDDO 
    215320         !                         ! 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' ) 
     321         CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' ) 
    217322         ! 
    218323      ENDIF 
     
    239344         ENDDO 
    240345         !                         ! 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' ) 
     346         CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' ) 
    242347         ! 
    243348      ENDIF 
     
    249354 
    250355 
    251    SUBROUTINE trc_bc_read(kt) 
     356   SUBROUTINE trc_bc_read(kt, jit) 
    252357      !!---------------------------------------------------------------------- 
    253358      !!                   ***  ROUTINE trc_bc_init  *** 
     
    264369      !! * Arguments 
    265370      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    266  
     371      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
     372      INTEGER :: ib 
    267373      !!--------------------------------------------------------------------- 
    268374      ! 
    269375      IF( nn_timing == 1 )  CALL timing_start('trc_bc_read') 
    270376 
    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) 
     377      IF( kt == nit000 .AND. lwp) THEN 
     378         WRITE(numout,*) 
     379         WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.' 
     380         WRITE(numout,*) '~~~~~~~~~~~ ' 
     381      ENDIF 
     382 
     383      IF ( PRESENT(jit) ) THEN  
     384 
     385#ifdef key_bdy 
     386         ! OPEN boundary conditions (use time_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           DO ib = 1,nb_bdy 
     390             CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), map=nbmap_ptr(:,ib), kit=jit, kt_offset=+1) 
     391           ENDDO 
     392         ENDIF 
     393#endif 
     394 
     395         ! SURFACE boundary conditions 
     396         IF( nb_trcsbc > 0 ) THEN 
     397           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
     398           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit) 
     399         ENDIF 
     400 
     401         ! COASTAL boundary conditions 
     402         IF( nb_trccbc > 0 ) THEN 
     403           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
     404           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit) 
     405         ENDIF 
     406 
     407      ELSE 
     408 
     409#ifdef key_bdy 
     410         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
     411         IF( nb_trcobc > 0 ) THEN 
     412           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
     413           DO ib = 1,nb_bdy 
     414             CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), map=nbmap_ptr(:,ib), kt_offset=+1) 
     415           ENDDO 
     416         ENDIF 
     417#endif 
     418 
     419         ! SURFACE boundary conditions 
     420         IF( nb_trcsbc > 0 ) THEN 
     421           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
     422           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc) 
     423         ENDIF 
     424 
     425         ! COASTAL boundary conditions 
     426         IF( nb_trccbc > 0 ) THEN 
     427           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
     428           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc) 
     429         ENDIF 
     430 
    288431      ENDIF 
    289432 
     
    303446   !!---------------------------------------------------------------------- 
    304447CONTAINS 
     448 
     449   SUBROUTINE trc_bc_init( ntrc )        ! Empty routine 
     450      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
     451      WRITE(*,*) 'trc_bc_init: You should not have seen this print! error?', kt 
     452   END SUBROUTINE trc_bc_init 
     453 
    305454   SUBROUTINE trc_bc_read( kt )        ! Empty routine 
    306455      WRITE(*,*) 'trc_bc_read: You should not have seen this print! error?', kt 
Note: See TracChangeset for help on using the changeset viewer.