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 6332 – NEMO

Changeset 6332


Ignore:
Timestamp:
2016-02-19T08:20:00+01:00 (8 years ago)
Author:
deazer
Message:

Tested Initial run one day physics only in rose suite.

Location:
branches/UKMO/CO6_KD490/NEMOGCM/NEMO
Files:
4 added
31 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r6331 r6332  
    7171      REAL, POINTER, DIMENSION(:,:)   ::  ht_s  !: now snow thickness 
    7272#endif 
     73#if defined key_top 
     74      CHARACTER(LEN=20)                   :: cn_obc  !: type of boundary condition to apply 
     75      REAL(wp)                            :: rn_fac  !: multiplicative scaling factor 
     76      REAL(wp), POINTER, DIMENSION(:,:)   :: trc     !: now field of the tracer 
     77      LOGICAL                             :: dmp     !: obc damping term 
     78#endif 
     79 
    7380   END TYPE OBC_DATA 
    7481 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r6331 r6332  
    3737#endif 
    3838   USE sbcapr 
     39#if defined key_top 
     40   USE par_trc 
     41   USE trc, ONLY: trn 
     42#endif 
    3943 
    4044   IMPLICIT NONE 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

    r6331 r6332  
    161161 
    162162      z1_2 = 0.5_wp 
     163#if defined key_cs15 
     164      z1_2 = 0.0_wp 
     165#endif 
    163166 
    164167      ! ---------------------------------! 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r6331 r6332  
    102102 
    103103      REWIND(numnam_cfg) 
     104      REWIND(numnam_ref)   ! slwa 
    104105 
    105106      DO ib_bdy = 1, nb_bdy 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r6331 r6332  
    4444   USE in_out_manager  ! I/O manager 
    4545   USE diadimg         ! dimg direct access file format output 
     46   USE diatmb          ! Top,middle,bottom output 
     47   USE dia25h          ! 25h Mean output 
    4648   USE iom 
    4749   USE ioipsl 
    … …  
    379381      CALL wrk_dealloc( jpi , jpj      , z2d ) 
    380382      CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 
     383      ! 
     384      ! If we want tmb values  
     385 
     386      IF (ln_diatmb) THEN 
     387         CALL dia_tmb 
     388      ENDIF 
     389      IF (ln_dia25h) THEN 
     390         CALL dia_25h( kt ) 
     391      ENDIF 
    381392      ! 
    382393      IF( nn_timing == 1 )   CALL timing_stop('dia_wri') 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r6331 r6332  
    136136      USE ioipsl 
    137137      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               & 
    138          &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
     138         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstdate, ln_rstart , nn_rstctl,   & 
    139139         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   & 
    140140         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler 
    … …  
    174174         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir 
    175175         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart 
     176         WRITE(numout,*) '      datestamping of restarts        ln_rstdate  = ', ln_rstdate 
    176177         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler 
    177178         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r6331 r6332  
    3131   USE wrk_nemo        ! Memory allocation 
    3232   USE timing          ! Timing 
     33   USE iom    ! slwa 
    3334 
    3435   IMPLICIT NONE 
    … …  
    135136      INTEGER  ::   ios 
    136137      INTEGER  ::   isrow                    ! index for ORCA1 starting row 
     138#if defined key_bdy && defined key_cs15 
     139      INTEGER  ::   inum !slwa 
     140#endif 
    137141      INTEGER , POINTER, DIMENSION(:,:) ::  imsk 
    138142      REAL(wp), POINTER, DIMENSION(:,:) ::  zwf 
    … …  
    172176         CALL ctl_stop( ctmp1 ) 
    173177      ENDIF 
     178!slwa 
     179! read in mask for unstructured open boundaries 
     180#if defined key_bdy && defined key_cs15 
     181         CALL iom_open( 'mask_CS15.nc', inum ) 
     182         CALL iom_get ( inum, jpdom_data, 'bdy_msk', zwf(:,:) ) 
     183         CALL iom_close( inum ) 
     184#endif 
     185!slwa 
    174186 
    175187      ! 1. Ocean/land mask at t-point (computed from mbathy) 
    … …  
    182194            DO ji = 1, jpi 
    183195               IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp )   tmask(ji,jj,jk) = 1._wp 
     196#if defined key_bdy && defined key_cs15 
     197               tmask(ji,jj,jk) = tmask(ji,jj,jk) * zwf(ji,jj)  ! slwa 
     198#endif 
    184199            END DO   
    185200         END DO   

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r6331 r6332  
    4141   USE timing          ! Timing     
    4242   USE sbcapr          ! surface boundary condition: atmospheric pressure 
     43   USE diatmb          ! Top,middle,bottom output 
    4344   USE dynadv, ONLY: ln_dynadv_vec 
    4445#if defined key_agrif 
    … …  
    144145      INTEGER  ::   ji, jj, jk, jn        ! dummy loop indices 
    145146      INTEGER  ::   ikbu, ikbv, noffset      ! local integers 
     147      REAL(wp) ::   zmdi 
    146148      REAL(wp) ::   zraur, z1_2dt_b, z2dt_bf    ! local scalars 
    147149      REAL(wp) ::   zx1, zy1, zx2, zy2         !   -      - 
    … …  
    169171      CALL wrk_alloc( jpi, jpj, zhf ) 
    170172      ! 
     173      zmdi=1.e+20                               !  missing data indicator for masking 
    171174      !                                         !* Local constant initialization 
    172175      z1_12 = 1._wp / 12._wp  
    … …  
    926929      CALL wrk_dealloc( jpi, jpj, zhf ) 
    927930      ! 
     931      IF ( ln_diatmb ) THEN 
     932         CALL iom_put( "baro_u" , un_b*umask(:,:,1)+zmdi*(1-umask(:,:,1 ) ) )  ! Barotropic  U Velocity 
     933         CALL iom_put( "baro_v" , vn_b*vmask(:,:,1)+zmdi*(1-vmask(:,:,1 ) ) )  ! Barotropic  V Velocity 
     934      ENDIF 
    928935      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_ts') 
    929936      ! 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90

    r6331 r6332  
    1818   !!---------------------------------------------------------------------- 
    1919   USE par_oce        ! NEMO parameters 
     20   USE phycst         ! for rday 
    2021   USE dom_oce        ! NEMO domain 
    2122   USE in_out_manager ! NEMO IO routines 
    2223   USE lib_mpp        ! NEMO MPI library, lk_mpp in particular 
     24   USE ioipsl, ONLY : ju2ymds    ! for calendar  
    2325   USE netcdf         ! netcdf routines for IO 
    2426   USE icb_oce        ! define iceberg arrays 
    … …  
    6466                                                                                            ! start and count arrays 
    6567      LOGICAL                      ::   ll_found_restart 
    66       CHARACTER(len=256)           ::   cl_path 
    67       CHARACTER(len=256)           ::   cl_filename 
     68      CHARACTER(len=256)  :: cl_path  
     69      CHARACTER(len=256)  :: cl_filename  
    6870      CHARACTER(len=NF90_MAX_NAME) ::   cl_dname 
    6971      TYPE(iceberg)                ::   localberg ! NOT a pointer but an actual local variable 
    … …  
    233235      CHARACTER(len=256)     :: cl_path 
    234236      CHARACTER(len=256)     :: cl_filename 
     237      INTEGER             ::   iyear, imonth, iday  
     238      REAL (wp)           ::   zsec  
     239      CHARACTER(len=256)  :: cl_path  
     240      CHARACTER(len=256)  :: cl_filename  
     241      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    235242      TYPE(iceberg), POINTER :: this 
    236243      TYPE(point)  , POINTER :: pt 
    … …  
    240247      cl_path = TRIM(cn_ocerst_outdir) 
    241248      IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/' 
     249      IF ( ln_rstdate ) THEN  
     250         CALL ju2ymds( fjulday + rdttra(1) / rday, iyear, imonth, iday, zsec )             
     251         WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday  
     252      ELSE  
     253         IF( kt > 999999999 ) THEN   ;   WRITE(clkt, *       ) kt  
     254         ELSE                        ;   WRITE(clkt, '(i8.8)') kt  
     255         ENDIF  
     256      ENDIF  
    242257      IF( lk_mpp ) THEN 
    243          WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart_",I4.4,".nc")') TRIM(cexper), kt, narea-1 
     258         WRITE(cl_filename,'(A,"_icebergs_",A,"_restart_",I4.4,".nc")') TRIM(cexper), TRIM(ADJUSTL(clkt)), narea-1  
    244259      ELSE 
    245          WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart.nc")') TRIM(cexper), kt 
     260         WRITE(cl_filename,'(A,"_icebergs_",A,"_restart.nc")') TRIM(cexper), TRIM(ADJUSTL(clkt))  
    246261      ENDIF 
    247262      IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_path)//TRIM(cl_filename) 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r6331 r6332  
    3030   CHARACTER(lc) ::   cn_ocerst_outdir !: restart output directory 
    3131   LOGICAL       ::   ln_rstart        !: start from (F) rest or (T) a restart file 
     32   LOGICAL       ::   ln_rstdate       !: datestamping of restarts  
    3233   LOGICAL       ::   ln_rst_list      !: output restarts at list of times (T) or by frequency (F) 
    3334   INTEGER       ::   nn_no            !: job number 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r6331 r6332  
    2121   USE in_out_manager  ! I/O manager 
    2222   USE iom             ! I/O module 
     23   USE ioipsl, ONLY : ju2ymds    ! for calendar 
    2324   USE eosbn2          ! equation of state            (eos bn2 routine) 
    2425   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables 
    … …  
    5455      !!---------------------------------------------------------------------- 
    5556      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
     57      INTEGER             ::   iyear, imonth, iday  
     58      REAL (wp)           ::   zsec  
    5659      !! 
    5760      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    5861      CHARACTER(LEN=50)   ::   clname   ! ocean output restart file name 
    59       CHARACTER(lc)       ::   clpath   ! full path to ocean output restart file 
     62      CHARACTER(LEN=150)  ::   clpath   ! full path to ocean output restart file 
    6063      !!---------------------------------------------------------------------- 
    6164      ! 
    … …  
    8184      IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 
    8285         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN  
    83             ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    84             IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    85             ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst 
     86            IF ( ln_rstdate ) THEN  
     87              CALL ju2ymds( fjulday + rdttra(1) / rday, iyear, imonth, iday, zsec )             
     88              WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday  
     89            ELSE  
     90              ! beware of the format used to write kt (default is i8.8, that should be large enough...)  
     91              IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst  
     92              ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst  
     93              ENDIF  
    8694            ENDIF 
    8795            ! create the file 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r6331 r6332  
    12411241      IF(lwm) WRITE( numond, nameos ) 
    12421242      ! 
    1243       rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3] 
     1243      rau0        = 1020._wp                 !: volumic mass of reference     [kg/m3] 
     1244!     rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3] 
    12441245      rcp         = 3991.86795711963_wp      !: heat capacity     [J/K] 
    12451246      ! 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r6331 r6332  
    100100         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
    101101      ENDIF 
     102! slwa unless you use l_trdtra too, the above switches off trend calculations for l_trdtrc 
     103         l_trd = .FALSE. 
     104         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
     105!slwa 
    102106      ! 
    103107      IF( l_trd )  THEN 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r6331 r6332  
    4646   LOGICAL , PUBLIC ::   ln_qsr_ice   !: light penetration for ice-model LIM3 (clem) 
    4747   INTEGER , PUBLIC ::   nn_chldta    !: use Chlorophyll data (=1) or not (=0) 
     48   INTEGER , PUBLIC ::   nn_kd490dta  !: use kd490dta data (=1) or not (=0) 
    4849   REAL(wp), PUBLIC ::   rn_abs       !: fraction absorbed in the very near surface (RGB & 2 bands) 
    4950   REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands) 
    … …  
    5455   REAL(wp) ::   xsi1r                           !: inverse of rn_si1 
    5556   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read) 
     57   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_kd490 ! structure of input kd490 (file informations, fields read) 
    5658   INTEGER, PUBLIC ::   nksr              ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    5759   REAL(wp), DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption 
    … …  
    306308            ! 
    307309         ENDIF 
     310! slwa 
     311         IF( nn_kd490dta == 1 ) THEN                      !  use KD490 data read in   ! 
     312            !                                             ! ------------------------- ! 
     313               nksr = jpk - 1 
     314               ! 
     315               CALL fld_read( kt, 1, sf_kd490 )     ! Read kd490 data and provide it at the current time step 
     316               ! 
     317               zcoef  = ( 1. - rn_abs ) 
     318               ze0(:,:,1) = rn_abs  * qsr(:,:) 
     319               ze1(:,:,1) = zcoef * qsr(:,:) 
     320               zea(:,:,1) =         qsr(:,:) 
     321               ! 
     322               DO jk = 2, nksr+1 
     323!CDIR NOVERRCHK 
     324                  DO jj = 1, jpj 
     325!CDIR NOVERRCHK    
     326                     DO ji = 1, jpi 
     327                        zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r     ) 
     328                        zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * sf_kd490(1)%fnow(ji,jj,1) ) 
     329                        ze0(ji,jj,jk) = zc0 
     330                        ze1(ji,jj,jk) = zc1 
     331                        zea(ji,jj,jk) = ( zc0 + zc1 ) * tmask(ji,jj,jk) 
     332                     END DO 
     333                  END DO 
     334               END DO 
     335               ! clem: store attenuation coefficient of the first ocean level 
     336               IF ( ln_qsr_ice ) THEN 
     337                  DO jj = 1, jpj 
     338                     DO ji = 1, jpi 
     339                        zzc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r     ) 
     340                        zzc1 = zcoef  * EXP( - fse3t(ji,jj,1) * sf_kd490(1)%fnow(ji,jj,1) ) 
     341                        fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 ) * tmask(ji,jj,2)  
     342                     END DO 
     343                  END DO 
     344               ENDIF 
     345               ! 
     346               DO jk = 1, nksr                                        ! compute and add qsr trend to ta 
     347                  qsr_hc(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) ) 
     348               END DO 
     349               zea(:,:,nksr+1:jpk) = 0.e0     !  
     350               CALL iom_put( 'qsr3d', zea )   ! Shortwave Radiation 3D distribution 
     351               ! 
     352        ENDIF   ! use KD490 data 
     353!slwa 
    308354         ! 
    309355         !                                        Add to the general trend 
    … …  
    374420      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files 
    375421      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read 
    376       !! 
    377       NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  & 
    378          &                  nn_chldta, rn_abs, rn_si0, rn_si1 
     422      TYPE(FLD_N)        ::   sn_kd490 ! informations about the kd490 field to be read 
     423      !! 
     424      NAMELIST/namtra_qsr/  sn_chl, sn_kd490, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  & 
     425         &                  nn_chldta, rn_abs, rn_si0, rn_si1, nn_kd490dta 
    379426      !!---------------------------------------------------------------------- 
    380427 
    … …  
    409456         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0 
    410457         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1 = ', rn_si1 
     458         WRITE(numout,*) '      read in KD490 data                       nn_kd490dta  = ', nn_kd490dta 
    411459      ENDIF 
    412460 
    … …  
    422470         IF( ln_qsr_2bd  )   ioptio = ioptio + 1 
    423471         IF( ln_qsr_bio  )   ioptio = ioptio + 1 
     472         IF( nn_kd490dta == 1 )   ioptio = ioptio + 1 
    424473         ! 
    425474         IF( ioptio /= 1 ) & 
    … …  
    431480         IF( ln_qsr_2bd                      )   nqsr =  3 
    432481         IF( ln_qsr_bio                      )   nqsr =  4 
     482         IF( nn_kd490dta == 1                )   nqsr =  5 
    433483         ! 
    434484         IF(lwp) THEN                   ! Print the choice 
    … …  
    438488            IF( nqsr ==  3 )   WRITE(numout,*) '         2 bands light penetration' 
    439489            IF( nqsr ==  4 )   WRITE(numout,*) '         bio-model light penetration' 
     490            IF( nqsr ==  5 )   WRITE(numout,*) '         KD490 light penetration' 
    440491         ENDIF 
    441492         ! 
    … …  
    447498         xsi0r = 1.e0 / rn_si0 
    448499         xsi1r = 1.e0 / rn_si1 
     500         IF( nn_kd490dta == 1 ) THEN           !* KD490 data : set sf_kd490 structure 
     501            IF(lwp) WRITE(numout,*) 
     502            IF(lwp) WRITE(numout,*) '        KD490 read in a file' 
     503            ALLOCATE( sf_kd490(1), STAT=ierror ) 
     504            IF( ierror > 0 ) THEN 
     505               CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_kd490 structure' )   ;   RETURN 
     506            ENDIF 
     507            ALLOCATE( sf_kd490(1)%fnow(jpi,jpj,1)   ) 
     508            IF( sn_kd490%ln_tint )ALLOCATE( sf_kd490(1)%fdta(jpi,jpj,1,2) ) 
     509            !                                        ! fill sf_kd490 with sn_kd490 and control print 
     510            CALL fld_fill( sf_kd490, (/ sn_kd490 /), cn_dir, 'tra_qsr_init',   & 
     511               &                                         'Solar penetration function of read KD490', 'namtra_qsr' ) 
    449512         !                                ! ---------------------------------- ! 
    450          IF( ln_qsr_rgb ) THEN            !  Red-Green-Blue light penetration  ! 
     513         ELSEIF( ln_qsr_rgb ) THEN            !  Red-Green-Blue light penetration  ! 
    451514            !                             ! ---------------------------------- ! 
    452515            ! 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r6331 r6332  
    203203         DO jj = 2, jpjm1 
    204204            DO ji = fs_2, fs_jpim1   ! vector opt. 
     205#if defined key_tracer_budget 
     206!              ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)  )  * tmask(ji,jj,jk) 
     207               ptrd(ji,jj,jk) = -      pf (ji,jj,jk) * tmask(ji,jj,jk) 
     208#else 
    205209               ptrd(ji,jj,jk) = - (     pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                        & 
    206210                 &                  - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )   & 
    207211                 &              / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )  * tmask(ji,jj,jk) 
     212#endif 
    208213            END DO 
    209214         END DO 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r6331 r6332  
    8585   USE stopar 
    8686   USE stopts 
     87   USE diatmb          ! Top,middle,bottom output 
     88   USE dia25h          ! 25h mean output 
    8789 
    8890   IMPLICIT NONE 
    … …  
    475477      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
    476478      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
     479                            CALL dia_tmb_init  ! TMB outputs 
     480                            CALL dia_25h_init  ! 25h mean  outputs 
    477481      ! 
    478482   END SUBROUTINE nemo_init 
    … …  
    630634      USE ldftra_oce, ONLY: ldftra_oce_alloc 
    631635      USE trc_oce   , ONLY: trc_oce_alloc 
     636      USE diainsitutem, ONLY: insitu_tem_alloc 
    632637#if defined key_diadct  
    633638      USE diadct    , ONLY: diadct_alloc  
    … …  
    646651      ierr = ierr + ldftra_oce_alloc()          ! ocean lateral  physics : tracers 
    647652      ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics 
     653      ierr = ierr + insitu_tem_alloc() 
    648654      ! 
    649655      ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r6331 r6332  
    1818   USE trd_oce 
    1919   USE trdtrc 
     20   USE trcbc, only : trc_bc_read 
    2021 
    2122   IMPLICIT NONE 
    … …  
    5556 
    5657      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrmyt ) 
     58 
     59      CALL trc_bc_read  ( kt )       ! tracers: surface and lateral Boundary Conditions 
    5760 
    5861      IF( l_trdtrc ) THEN      ! Save the trends in the ixed layer 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90

    r6331 r6332  
    1919 
    2020   PUBLIC trc_wri_my_trc  
     21#if defined key_tracer_budget 
     22   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), SAVE :: trb_temp ! slwa 
     23#endif 
     24 
    2125 
    2226#  include "top_substitute.h90" 
    2327CONTAINS 
    2428 
     29#if defined key_tracer_budget 
     30   SUBROUTINE trc_wri_my_trc (kt, fl) ! slwa 
     31#else 
    2532   SUBROUTINE trc_wri_my_trc 
     33#endif 
    2634      !!--------------------------------------------------------------------- 
    2735      !!                     ***  ROUTINE trc_wri_trc  *** 
    … …  
    2937      !! ** Purpose :   output passive tracers fields  
    3038      !!--------------------------------------------------------------------- 
     39#if defined key_tracer_budget 
     40      INTEGER, INTENT( in ), OPTIONAL     :: fl  
     41      INTEGER, INTENT( in )               :: kt 
     42      REAL(wp), DIMENSION(jpi,jpj,jpk)    :: trpool !tracer pool temporary output 
     43#endif 
    3144      CHARACTER (len=20)   :: cltra 
    32       INTEGER              :: jn 
     45      INTEGER              :: jn,jk 
    3346      !!--------------------------------------------------------------------- 
    3447  
    3548      ! write the tracer concentrations in the file 
    3649      ! --------------------------------------- 
     50 
     51 
     52#if defined key_tracer_budget 
     53      IF( PRESENT(fl)) THEN 
     54! depth integrated 
     55! for strict budgetting write this out at end of timestep as an average between 'now' and 'after' at kt 
     56         DO jn = jp_myt0, jp_myt1  
     57            trpool(:,:,:) = 0.5 * ( trn(:,:,:,jn) * fse3t_a(:,:,:) +  & 
     58                                        trb_temp(:,:,:,jn) * fse3t(:,:,:) ) 
     59! 
     60            cltra = TRIM( ctrcnm(jn) )                  ! output of tracer density  
     61            CALL iom_put( cltra, trpool(:,:,:) / (0.5* (fse3t(:,:,:) + fse3t_a(:,:,:) ) ) ) 
     62! 
     63            cltra = TRIM( ctrcnm(jn) )//"_pool"     ! volume integrated output 
     64            DO jk = 1, jpk 
     65               trpool(:,:,jk) = trpool(:,:,jk) * e1t(:,:) * e2t(:,:) 
     66            END DO 
     67            CALL iom_put( cltra, trpool) 
     68 
     69!           cltra = TRIM( ctrcnm(jn) )//"_pool"     ! volume integrated output 
     70!           DO jk = 1, jpk 
     71!              trpool(:,:,jk) = 0.5 * ( trn(:,:,jk,jn) * fse3t_a(:,:,jk) +  &  
     72!                                       trb_temp(:,:,jk,jn) * fse3t(:,:,jk) ) * &  
     73!                                       e1t(:,:) * e2t(:,:) 
     74!           END DO 
     75!           CALL iom_put( cltra, trpool) 
     76!           cltra = TRIM( ctrcnm(jn) )                  ! output of tracer density  
     77!           CALL iom_put( cltra, trpool(:,:,:) / (0.5* (fse3t(:,:,:) + fse3t_a(:,:,:) ) ) ) 
     78         END DO 
     79         CALL iom_put( "DEPTH" , 0.5* (fse3t(:,:,:) + fse3t_a(:,:,:) ) )  !  equivalent 'depth' at same time as tracer pool output 
     80      ELSE 
     81 
     82         IF( kt == nittrc000 ) THEN 
     83           ALLOCATE(trb_temp(jpi,jpj,jpk,jptra))  ! slwa 
     84         ENDIF 
     85         trb_temp(:,:,:,:)=trn(:,:,:,:) ! slwa save for tracer budget (unfiltered trn) 
     86 
     87!        DO jn = jp_myt0, jp_myt1 
     88!           cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
     89!           CALL iom_put( cltra, trn(:,:,:,jn) )  
     90!        END DO 
     91! write out depths and areas in double precision for tracer budget calculations 
     92         CALL iom_put( "AREA" , e1t(:,:) * e2t(:,:)) 
     93!        CALL iom_put( "DEPTH" , fse3t(:,:,:) )  ! need depth at same time as tracer output 
     94 
     95      END IF 
     96#else 
    3797      DO jn = jp_myt0, jp_myt1 
    3898         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    3999         CALL iom_put( cltra, trn(:,:,:,jn) ) 
    40100      END DO 
     101#endif 
    41102      ! 
    42103   END SUBROUTINE trc_wri_my_trc 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r6331 r6332  
    5656      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    5757      !! 
    58       INTEGER            :: jn 
     58      INTEGER            :: jn, jk 
    5959      CHARACTER (len=22) :: charout 
    6060      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
    … …  
    105105        DO jn = 1, jptra 
    106106           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
     107#if defined key_tracer_budget 
     108           DO jk = 1, jpkm1 
     109             ztrtrd(:,:,jk,jn) = ztrtrd(:,:,jk,jn) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk)  ! slwa 
     110           END DO 
     111#endif 
    107112           CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 
    108113        END DO 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r6331 r6332  
    3333   USE trdtra 
    3434   USE tranxt 
     35   USE trcbdy          ! BDY open boundaries 
     36   USE bdy_par, only: lk_bdy 
     37   USE iom 
    3538# if defined key_agrif 
    3639   USE agrif_top_interp 
    … …  
    9396      CHARACTER (len=22) :: charout 
    9497      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrdt  
     98#if defined key_tracer_budget 
     99      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztrdt_m1 ! slwa 
     100#endif 
    95101      !!---------------------------------------------------------------------- 
    96102      ! 
    … …  
    101107         WRITE(numout,*) 'trc_nxt : time stepping on passive tracers' 
    102108      ENDIF 
     109#if defined key_tracer_budget 
     110      IF( kt == nittrc000 .AND. l_trdtrc ) THEN 
     111         ALLOCATE( ztrdt_m1(jpi,jpj,jpk,jptra) )  ! slwa 
     112         IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file 
     113            iom_varid( numrtr, 'atf_trend_'//TRIM(ctrcnm(1)), ldstop = .FALSE. ) > 0 ) THEN 
     114            IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc ATF tracer trend read in the restart file' 
     115            DO jn = 1, jptra 
     116               CALL iom_get( numrtr, jpdom_autoglo, 'atf_trend_'//TRIM(ctrcnm(jn)), ztrdt_m1(:,:,:,jn) )   ! before tracer trend for atf 
     117            END DO 
     118         ELSE           
     119           ztrdt_m1=0.0 
     120         ENDIF 
     121      ENDIF 
     122#endif 
    103123 
    104124#if defined key_agrif 
    … …  
    111131 
    112132 
    113 #if defined key_bdy 
    114 !!      CALL bdy_trc( kt )               ! BDY open boundaries 
    115 #endif 
     133      IF( lk_bdy )  CALL trc_bdy( kt )               ! BDY open boundaries 
    116134 
    117135 
    … …  
    149167               zfact = 1.e0 / r2dt(jk)   
    150168               ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact  
    151                CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 
     169!slwa          CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 
     170#if defined key_tracer_budget 
     171               ztrdt(:,:,jk,jn) = ztrdt(:,:,jk,jn) * e1t(:,:) * e2t(:,:) * e3t_n(:,:,jk)  ! slwa vvl 
     172               !ztrdt(:,:,jk,jn) = ztrdt(:,:,jk,jn) * e1t(:,:) * e2t(:,:) * e3t_0(:,:,jk)  ! slwa CHANGE for vvl 
     173#endif 
    152174            END DO 
     175#if defined key_tracer_budget 
     176! slwa budget code 
     177              CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt_m1(:,:,:,jn) ) 
     178#else 
     179              CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) ) 
     180#endif 
    153181         END DO 
     182#if defined key_tracer_budget 
     183        ztrdt_m1(:,:,:,:) = ztrdt(:,:,:,:)    ! need previous time step for budget slwa 
     184#endif 
    154185         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrdt )  
    155186      END IF 
     187 
     188#if defined key_tracer_budget 
     189      !                                           Write in the tracer restart file 
     190      !                                          ******************************* 
     191      IF( lrst_trc ) THEN 
     192         IF(lwp) WRITE(numout,*) 
     193         IF(lwp) WRITE(numout,*) 'trc : ATF trend at last time step for tracer budget written in tracer restart file ',   & 
     194            &                    'at it= ', kt,' date= ', ndastp 
     195         IF(lwp) WRITE(numout,*) '~~~~' 
     196         DO jn = 1, jptra 
     197            CALL iom_rstput( kt, nitrst, numrtw, 'atf_trend_'//TRIM(ctrcnm(jn)), ztrdt_m1(:,:,:,jn) ) 
     198         END DO 
     199      ENDIF 
     200#endif 
     201 
    156202      ! 
    157203      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r6331 r6332  
    1818   USE trdtra 
    1919   USE prtctl_trc          ! Print control for debbuging 
     20#if defined key_tracer_budget 
     21   USE iom 
     22#endif 
    2023 
    2124   IMPLICIT NONE 
    … …  
    110113      REAL(wp) :: zcoef, ztrcorn, ztrmasn   !    "         " 
    111114      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrdb, ztrtrdn   ! workspace arrays 
     115#if defined key_tracer_budget 
     116      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztrtrdb_m1 ! slwa  
     117#endif 
    112118      REAL(wp) :: zs2rdt 
    113119      LOGICAL ::   lldebug = .FALSE. 
    … …  
    116122  
    117123      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 
     124#if defined key_tracer_budget 
     125      IF( kt == nittrc000 .AND. l_trdtrc) THEN 
     126         ALLOCATE( ztrtrdb_m1(jpi,jpj,jpk,jptra) )  ! slwa 
     127         IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file 
     128            iom_varid( numrtr, 'rdb_trend_'//TRIM(ctrcnm(1)), ldstop = .FALSE. ) > 0 ) THEN 
     129            IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc RDB tracer trend read in the restart file' 
     130            DO jn = 1, jptra 
     131               CALL iom_get( numrtr, jpdom_autoglo, 'rdb_trend_'//TRIM(ctrcnm(jn)), ztrtrdb_m1(:,:,:,jn) )   ! before tracer trend for rdb 
     132            END DO 
     133         ELSE 
     134           ztrtrdb_m1=0.0 
     135         ENDIF 
     136      ENDIF 
     137#endif 
    118138       
    119139      IF( PRESENT( cpreserv )  ) THEN   !  total tracer concentration is preserved  
    … …  
    156176               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    157177               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
     178#if defined key_tracer_budget 
     179! slwa budget code 
     180               DO jk = 1, jpkm1 
     181                  ztrtrdb(:,:,jk) = ztrtrdb(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     182                  ztrtrdn(:,:,jk) = ztrtrdn(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     183               END DO 
     184               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb_m1(:,:,:,jn) ) 
     185               ztrtrdb_m1(:,:,:,jn)=ztrtrdb(:,:,:) 
     186#else 
    158187               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling 
     188#endif 
    159189               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling 
    160190              ! 
    … …  
    187217               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    188218               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
     219#if defined key_tracer_budget 
     220! slwa budget code 
     221               DO jk = 1, jpkm1 
     222                  ztrtrdb(:,:,jk) = ztrtrdb(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     223                  ztrtrdn(:,:,jk) = ztrtrdn(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     224               END DO 
     225               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb_m1(:,:,:,jn) ) 
     226               ztrtrdb_m1(:,:,:,jn)=ztrtrdb(:,:,:) 
     227#else 
    189228               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling 
     229#endif 
    190230               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling 
    191231              ! 
    … …  
    195235 
    196236      ENDIF 
     237 
     238#if defined key_tracer_budget 
     239      !                                           Write in the tracer restart file 
     240      !                                          ******************************* 
     241      IF( lrst_trc ) THEN 
     242         IF(lwp) WRITE(numout,*) 
     243         IF(lwp) WRITE(numout,*) 'trc : RDB trend at last time step for tracer budget written in tracer restart file ',   & 
     244            &                    'at it= ', kt,' date= ', ndastp 
     245         IF(lwp) WRITE(numout,*) '~~~~' 
     246         DO jn = 1, jptra 
     247            CALL iom_rstput( kt, nitrst, numrtw, 'rdb_trend_'//TRIM(ctrcnm(jn)), ztrtrdb_m1(:,:,:,jn) ) 
     248         END DO 
     249      ENDIF 
     250#endif 
    197251 
    198252      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r6331 r6332  
    113113           sbc_trc_b(:,:,:) = 0._wp 
    114114         ENDIF 
     115         sbc_trc(:,:,:) = 0._wp    !slwa initialise for vvl 
    115116      ELSE                                         ! Swap of forcing fields 
    116117         IF( ln_top_euler ) THEN 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r6331 r6332  
    2727   USE trcsbc          ! surface boundary condition          (trc_sbc routine) 
    2828   USE zpshde          ! partial step: hor. derivative       (zps_hde routine) 
     29   USE trcbdy          ! BDY open boundaries 
     30   USE bdy_par, only: lk_bdy 
    2931 
    3032#if defined key_agrif 
    … …  
    6870         IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
    6971         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only 
     72         IF( lk_bdy )           CALL trc_bdy_dmp( kstp )        ! BDY damping trends 
    7073                                CALL trc_adv( kstp )            ! horizontal & vertical advection  
    7174                                CALL trc_ldf( kstp )            ! lateral mixing 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r6331 r6332  
    1414   USE par_oce 
    1515   USE par_trc 
     16#if defined key_bdy 
     17   USE bdy_oce, only: nb_bdy, OBC_DATA 
     18#endif 
    1619    
    1720   IMPLICIT NONE 
    … …  
    9194       CHARACTER(len = 20)  :: clunit   !: unit 
    9295       LOGICAL              :: llinit   !: read in a file or not 
     96#if defined  key_my_trc 
     97       LOGICAL              :: llsbc   !: read in a file or not 
     98       LOGICAL              :: llcbc   !: read in a file or not 
     99       LOGICAL              :: llobc   !: read in a file or not 
     100#endif 
    93101       LOGICAL              :: llsave   !: save the tracer or not 
    94102   END TYPE PTRACER 
    … …  
    191199# endif 
    192200   ! 
     201#if defined key_bdy 
     202   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc_dflt          ! Default OBC condition for all tracers 
     203   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc               ! Choice of boundary condition for tracers 
     204   INTEGER,           PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  nn_trcdmp_bdy        !: =T Tracer damping 
     205   ! External data structure of BDY for TOP. Available elements: cn_obc, ll_trc, trcnow, dmp 
     206   TYPE(OBC_DATA),    PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET ::  trcdta_bdy           !: bdy external data (local process) 
     207#endif 
    193208 
    194209   !!---------------------------------------------------------------------- 
    … …  
    213228         &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       & 
    214229         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       &  
     230#if defined key_my_trc 
     231         &      ln_trc_sbc(jptra)     , ln_trc_cbc(jptra)     , ln_trc_obc(jptra)     ,       & 
     232#endif 
     233#if defined key_bdy 
     234         &      cn_trc_dflt(nb_bdy)   , cn_trc(nb_bdy)        , nn_trcdmp_bdy(nb_bdy) ,       & 
     235         &      trcdta_bdy(jptra,nb_bdy)                                              ,       & 
     236#endif 
    215237         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)     , qsr_mean(jpi,jpj)     ,  STAT = trc_alloc  )   
    216238 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    r6331 r6332  
    44   !! TOP :  module for passive tracer boundary conditions 
    55   !!===================================================================== 
     6   !! History :  3.5 !  2014-04  (M. Vichi, T. Lovato)  Original 
     7   !!            3.6 !  2015-03  (T . Lovato) Revision and BDY support 
    68   !!---------------------------------------------------------------------- 
    79#if  defined key_top  
    … …  
    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 
    … …  
    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) 
    3737   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trsfac   ! multiplicative factor for SBC tracer values 
    3838   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcsbc   ! structure of data input SBC (file informations, fields read) 
    3939   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trcfac   ! multiplicative factor for CBC tracer values 
    4040   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 
    6467      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 
     129#if defined key_bdy 
     130      DO ib = 1, nb_bdy 
     131#endif 
    141132      READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 ) 
    142133902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp ) 
    143134      IF(lwm) WRITE ( numont, namtrc_bc ) 
    144  
    145       ! print some information for each  
     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 
     186      ! Print summmary of Boundary Conditions 
    146187      IF( lwp ) THEN 
     188         WRITE(numout,*) ' ' 
     189         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with SURFACE BCs data:', nb_trcsbc 
     190         IF ( nb_trcsbc > 0 ) THEN 
     191            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. ' 
    147192         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) 
     193               IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn) 
     194            ENDDO 
     195            ENDIF 
     196         WRITE(numout,'(2a)') '   SURFACE BC data repository : ', TRIM(cn_dir_sbc) 
     197 
     198         WRITE(numout,*) ' ' 
     199         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with COASTAL BCs data:', nb_trccbc 
     200         IF ( nb_trccbc > 0 ) THEN 
     201            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. ' 
     202            DO jn = 1, ntrc 
     203               IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn) 
     204            ENDDO 
     205            ENDIF 
     206         WRITE(numout,'(2a)') '   COASTAL BC data repository : ', TRIM(cn_dir_cbc) 
     207 
     208         WRITE(numout,*) ' ' 
     209         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with OPEN BCs data:', nb_trcobc 
     210#if defined key_bdy 
     211         IF ( nb_trcobc > 0 ) THEN 
     212            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact.   OBC Settings' 
     213            DO jn = 1, ntrc 
     214               DO ib = 1, nb_bdy 
     215                 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) 
     216               ENDDO 
     217               !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) 
     218               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) 
     219            ENDDO 
     220            WRITE(numout,*) ' ' 
     221            DO ib = 1, nb_bdy 
     222                IF (nn_trcdmp_bdy(ib) .EQ. 0) WRITE(numout,9003) '   Boundary ',ib,' -> NO damping of tracers' 
     223                IF (nn_trcdmp_bdy(ib) .EQ. 1) WRITE(numout,9003) '   Boundary ',ib,' -> damping ONLY for tracers with external data provided' 
     224                IF (nn_trcdmp_bdy(ib) .EQ. 2) WRITE(numout,9003) '   Boundary ',ib,' -> damping of ALL tracers' 
     225                IF (nn_trcdmp_bdy(ib) .GT. 0) THEN 
     226                   WRITE(numout,9003) '     USE damping parameters from nambdy for boundary ', ib,' : ' 
     227                   WRITE(numout,'(a,f10.2,a)') '     - Inflow damping time scale  : ',rn_time_dmp(ib),' days' 
     228                   WRITE(numout,'(a,f10.2,a)') '     - Outflow damping time scale : ',rn_time_dmp_out(ib),' days' 
    162229            ENDIF 
    163230         END DO 
    164231      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       ! 
     232#endif 
     233         WRITE(numout,'(2a)') '   OPEN BC data repository : ', TRIM(cn_dir_obc) 
     234      ENDIF 
     2359001  FORMAT(2x,i5, 3x, a15, 3x, a5, 6x, e11.3, 4x, 10a13) 
     2369002  FORMAT(2x,i5, 3x, a41, 3x, 10a13) 
     2379003  FORMAT(a, i5, a) 
     238 
     239      ! 
     240#if defined key_bdy 
    170241      ! 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 ) 
     242      IF( nb_trcobc > 0 ) THEN  
     243         ALLOCATE ( sf_trcobc(nb_trcobc,nb_bdy), rf_trofac(nb_trcobc,nb_bdy), nbmap_ptr(nb_trcobc,nb_bdy), STAT=ierr1 ) 
    173244         IF( ierr1 > 0 ) THEN 
    174245            CALL ctl_stop( 'trc_bc_init: unable to allocate  sf_trcobc structure' )   ;   RETURN 
    175246         ENDIF 
    176          ! 
     247 
     248         igrd = 1                       ! Everything is at T-points here 
     249 
     250         DO ib = 1, nb_bdy 
    177251         DO jn = 1, ntrc 
    178             IF( ln_trc_obc(jn) ) THEN      ! update passive tracers arrays with input data read from file 
     252 
     253               nblen = idx_bdy(ib)%nblen(igrd) 
     254 
     255               IF ( ln_trc_obc(jn) ) THEN 
     256               ! Initialise from external data 
    179257               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 ) 
     258                  slf_i(jl)    = sn_trcobc(jn,ib) 
     259                  rf_trofac(jl,ib) = rn_trofac(jn) 
     260                                               ALLOCATE( sf_trcobc(jl,ib)%fnow(nblen,1,jpk)   , STAT=ierr2 ) 
     261                  IF( sn_trcobc(jn,ib)%ln_tint )  ALLOCATE( sf_trcobc(jl,ib)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 
    184262               IF( ierr2 + ierr3 > 0 ) THEN 
    185263                 CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' )   ;   RETURN 
    186264               ENDIF 
    187             ENDIF 
    188             !    
     265                  trcdta_bdy(jn,ib)%trc => sf_trcobc(jl,ib)%fnow(:,1,:) 
     266                  trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl,ib) 
     267                  ! create OBC mapping array 
     268                  nbmap_ptr(jl,ib)%ptr => idx_bdy(ib)%nbmap(:,igrd) 
     269                  nbmap_ptr(jl,ib)%ll_unstruc = ln_coords_file(igrd) 
     270               ELSE 
     271               ! Initialise obc arrays from initial conditions 
     272                  ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) ) 
     273                  DO ibd = 1, nblen 
     274                     DO ik = 1, jpkm1 
     275                        ii = idx_bdy(ib)%nbi(ibd,igrd) 
     276                        ij = idx_bdy(ib)%nbj(ibd,igrd) 
     277                        trcdta_bdy(jn,ib)%trc(ibd,ik) = trn(ii,ij,ik,jn) * tmask(ii,ij,ik) 
     278                     END DO 
     279                  END DO 
     280                  trcdta_bdy(jn,ib)%rn_fac = 1._wp 
     281            ENDIF 
    189282         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       ! 
     283            CALL fld_fill( sf_trcobc(:,ib), slf_i, cn_dir_obc, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 
     284         ENDDO 
     285 
     286      ENDIF 
     287#endif 
    195288      ! SURFACE Boundary conditions 
    196289      IF( nb_trcsbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero 
    … …  
    214307         ENDDO 
    215308         !                         ! 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' ) 
     309         CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' ) 
    217310         ! 
    218311      ENDIF 
    … …  
    239332         ENDDO 
    240333         !                         ! 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' ) 
     334         CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' ) 
    242335         ! 
    243336      ENDIF 
    … …  
    249342 
    250343 
    251    SUBROUTINE trc_bc_read(kt) 
     344   SUBROUTINE trc_bc_read(kt, jit) 
    252345      !!---------------------------------------------------------------------- 
    253346      !!                   ***  ROUTINE trc_bc_init  *** 
    … …  
    264357      !! * Arguments 
    265358      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    266  
     359      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
     360      INTEGER :: ib 
    267361      !!--------------------------------------------------------------------- 
    268362      ! 
    269363      IF( nn_timing == 1 )  CALL timing_start('trc_bc_read') 
    270364 
    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 
     365      IF( kt == nit000 .AND. lwp) THEN 
     366         WRITE(numout,*) 
     367         WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.' 
     368         WRITE(numout,*) '~~~~~~~~~~~ ' 
     369      ENDIF 
     370 
     371      IF ( PRESENT(jit) ) THEN  
     372 
     373         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
    278374      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 
     375           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
     376           DO ib = 1,nb_bdy 
     377             CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), map=nbmap_ptr(:,ib), kit=jit, kt_offset=+1) 
     378           ENDDO 
    282379      ENDIF 
    283380 
    284381      ! SURFACE boundary conditions        
    285382      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) 
     383           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
     384           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit) 
    288385      ENDIF 
    289386 
    290387      ! COASTAL boundary conditions        
    291388      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) 
     389           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
     390           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit) 
    294391      ENDIF    
     392 
     393      ELSE 
     394 
     395         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
     396         IF( nb_trcobc > 0 ) THEN 
     397           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
     398           DO ib = 1,nb_bdy 
     399             CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), map=nbmap_ptr(:,ib), kt_offset=+1) 
     400           ENDDO 
     401         ENDIF 
     402 
     403         ! SURFACE boundary conditions 
     404         IF( nb_trcsbc > 0 ) THEN 
     405           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
     406           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc) 
     407         ENDIF 
     408 
     409         ! COASTAL boundary conditions 
     410         IF( nb_trccbc > 0 ) THEN 
     411           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
     412           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc) 
     413         ENDIF 
     414 
     415      ENDIF 
     416 
    295417      ! 
    296418      IF( nn_timing == 1 )  CALL timing_stop('trc_bc_read') 
    … …  
    303425   !!---------------------------------------------------------------------- 
    304426CONTAINS 
     427 
     428   SUBROUTINE trc_bc_init( ntrc )        ! Empty routine 
     429      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
     430      WRITE(*,*) 'trc_bc_init: You should not have seen this print! error?', kt 
     431   END SUBROUTINE trc_bc_init 
     432 
    305433   SUBROUTINE trc_bc_read( kt )        ! Empty routine 
    306434      WRITE(*,*) 'trc_bc_read: You should not have seen this print! error?', kt 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r6331 r6332  
    99   !!            3.4   !  2010-11  (C. Ethe, G. Madec)  use of fldread + dynamical allocation  
    1010   !!            3.5   !  2013-08  (M. Vichi)  generalization for other BGC models 
     11   !!            3.6   !  2015-03  (T. Lovato) revision of code log info 
    1112   !!---------------------------------------------------------------------- 
    1213#if  defined key_top  
    … …  
    7273      IF( nn_timing == 1 )  CALL timing_start('trc_dta_init') 
    7374      ! 
     75      IF( lwp ) THEN 
     76         WRITE(numout,*) ' ' 
     77         WRITE(numout,*) '  trc_dta_init : Tracers Initial Conditions (IC)' 
     78         WRITE(numout,*) '  ~~~~~~~~~~~ ' 
     79      ENDIF 
     80      ! 
    7481      !  Initialisation 
    7582      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0   
    … …  
    7784      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 
    7885      IF( ierr0 > 0 ) THEN 
    79          CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' )   ;   RETURN 
     86         CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' )   ;   RETURN 
    8087      ENDIF 
    8188      nb_trcdta      = 0 
    … …  
    97104      REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data 
    98105      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 
    99 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in reference namelist', lwp ) 
     106901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in reference namelist', lwp ) 
    100107 
    101108      REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 
    102109      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 
    103 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in configuration namelist', lwp ) 
     110902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in configuration namelist', lwp ) 
    104111      IF(lwm) WRITE ( numont, namtrc_dta ) 
    105112 
    … …  
    109116               clndta = TRIM( sn_trcdta(jn)%clvar )  
    110117               clntrc = TRIM( ctrcnm   (jn)       )  
     118               if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra 
    111119               zfact  = rn_trfac(jn) 
    112120               IF( clndta /=  clntrc ) THEN  
    113                   CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :  ',   & 
    114                   &              'the variable name in the data file : '//clndta//   &  
    115                   &              '  must be the same than the name of the passive tracer : '//clntrc//' ') 
     121                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation    ',   & 
     122                  &              'Input name of data file : '//TRIM(clndta)//   & 
     123                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ') 
    116124               ENDIF 
    117                WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, &  
    118                &               ' multiplicative factor : ', zfact 
     125               WRITE(numout,*) ' ' 
     126               WRITE(numout,'(a, i3,3a,e11.3)') ' Read IC file for tracer number :', & 
     127               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact 
    119128            ENDIF 
    120129         END DO 
    … …  
    124133         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 
    125134         IF( ierr1 > 0 ) THEN 
    126             CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN 
     135            CALL ctl_stop( 'trc_dta_init: unable to allocate  sf_trcdta structure' )   ;   RETURN 
    127136         ENDIF 
    128137         ! 
    … …  
    135144               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
    136145               IF( ierr2 + ierr3 > 0 ) THEN 
    137                  CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' )   ;   RETURN 
     146                 CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' )   ;   RETURN 
    138147               ENDIF 
    139148            ENDIF 
    … …  
    141150         ENDDO 
    142151         !                         ! fill sf_trcdta with slf_i and control print 
    143          CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta', 'Passive tracer data', 'namtrc' ) 
     152         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' ) 
    144153         ! 
    145154      ENDIF 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r6331 r6332  
    3232   USE sbc_oce 
    3333   USE trcice          ! tracers in sea ice 
     34   USE trcbc,   only : trc_bc_init ! generalized Boundary Conditions 
    3435  
    3536   IMPLICIT NONE 
    … …  
    110111      ENDIF 
    111112 
     113      ! Initialisation of tracers Initial Conditions 
    112114      IF( ln_trcdta )      CALL trc_dta_init(jptra) 
    113  
    114115 
    115116      IF( ln_rsttr ) THEN 
    … …  
    140141            CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 
    141142        ENDIF 
     143! slwa temporary insert initialise tracer 
     144            trn(:,:,:,:)  = 0._wp 
     145            if(nproc.eq.39)then 
     146              DO jn = 1, jptra 
     147                  trn(:,:,:,jn) = 100._wp * tmask(:,:,:) 
     148              ENDDO 
     149            endif 
     150!!!! slwa temp 
    142151        ! 
    143152        trb(:,:,:,:) = trn(:,:,:,:) 
    144153        !  
    145154      ENDIF 
     155! Initialisation of tracers Boundary Conditions  - here so that you can use initial condition as boundary 
     156      IF( lk_my_trc )     CALL trc_bc_init(jptra) 
    146157  
    147158      tra(:,:,:,:) = 0._wp 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r6331 r6332  
    3434   PUBLIC trc_nam_run  ! called in trcini 
    3535   PUBLIC trc_nam      ! called in trcini 
     36   PUBLIC trc_nam_dia 
     37#if defined key_trdmxl_trc  || defined key_trdtrc 
     38   NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
     39      &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 
     40      &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
     41#endif 
    3642 
    3743   !! * Substitutions 
    … …  
    5763      !!--------------------------------------------------------------------- 
    5864      INTEGER  ::   jn                  ! dummy loop indice 
     65#if defined key_trdmxl_trc  || defined key_trdtrc 
     66      INTEGER :: ios 
     67#endif 
     68 
    5969      !                                        !   Parameters of the run  
    6070      IF( .NOT. lk_offline ) CALL trc_nam_run 
    … …  
    304314         ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  ) 
    305315         ln_trc_ini(jn) =       sn_tracer(jn)%llinit 
     316#if defined key_my_trc 
     317         ln_trc_sbc(jn) =       sn_tracer(jn)%llsbc 
     318         ln_trc_cbc(jn) =       sn_tracer(jn)%llcbc 
     319         ln_trc_obc(jn) =       sn_tracer(jn)%llobc 
     320#endif 
    306321         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    307322      END DO 
    … …  
    322337      INTEGER ::  ierr 
    323338#if defined key_trdmxl_trc  || defined key_trdtrc 
    324       NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
    325          &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 
    326          &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
     339!     NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
     340!        &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 
     341!        &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
    327342#endif 
    328343      NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 
    … …  
    330345      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    331346      !!--------------------------------------------------------------------- 
    332  
    333       IF(lwp) WRITE(numout,*)  
    334       IF(lwp) WRITE(numout,*) 'trc_nam_dia : read the passive tracer diagnostics options' 
    335       IF(lwp) WRITE(numout,*) '~~~~~~~' 
    336347 
    337348      IF(lwp) WRITE(numout,*) 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r6331 r6332  
    100100         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file 
    101101         IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer 
     102#if defined key_tracer_budget 
     103!slwa tracer budget 
     104         IF( lk_iomput ) CALL trc_wri (kt, 2)  
     105#endif 
    102106         ! 
    103107         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r6331 r6332  
    2020#endif 
    2121#if defined key_zdfgls 
    22    USE zdfgls, ONLY: en 
     22!  USE zdfgls, ONLY: en 
    2323#endif 
    2424   USE trabbl 

  • branches/UKMO/CO6_KD490/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r6331 r6332  
    3232CONTAINS 
    3333 
     34#if defined key_tracer_budget 
     35   SUBROUTINE trc_wri( kt , fl)  !slwa 
     36#else 
    3437   SUBROUTINE trc_wri( kt ) 
     38#endif 
    3539      !!--------------------------------------------------------------------- 
    3640      !!                     ***  ROUTINE trc_wri  *** 
    … …  
    3943      !!--------------------------------------------------------------------- 
    4044      INTEGER, INTENT( in )     :: kt 
     45#if defined key_tracer_budget 
     46      INTEGER, INTENT( in ), OPTIONAL     :: fl  ! slwa 
     47#endif 
    4148      ! 
    4249      INTEGER                   :: jn 
    … …  
    5966      IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
    6067      IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14 
     68#if defined key_tracer_budget 
     69      IF( .NOT.PRESENT(fl) .AND. lk_my_trc  )   CALL trc_wri_my_trc (kt)     ! MY_TRC  tracers   slwa 
     70      IF( PRESENT(fl) .AND. lk_my_trc  )   CALL trc_wri_my_trc (kt, fl)    ! MY_TRC  tracers for budget slwa 
     71#else 
    6172      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
     73#endif 
    6274      ! 
    6375      IF( nn_timing == 1 )  CALL timing_stop('trc_wri') 
Note: See TracChangeset for help on using the changeset viewer.