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 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trc.F90 – NEMO

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r4611 r6225  
    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 
     
    3437   REAL(wp), PUBLIC                                                ::  areatot        !: total volume  
    3538   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  cvol           !: volume correction -degrad option-  
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: traceur concentration for now time step 
    37    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: traceur concentration for next time step 
    38    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: traceur concentration for before time step 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: tracer concentration for now time step 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: tracer concentration for next time step 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: tracer concentration for before time step 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  sbc_trc_b      !: Before sbc fluxes for tracers 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  sbc_trc        !: Now sbc fluxes for tracers 
     44 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  trc_i          !: prescribed tracer concentration in sea ice for SBC 
     46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  trc_o          !: prescribed tracer concentration in ocean for SBC 
     47   INTEGER             , PUBLIC                                    ::  nn_ice_tr      !: handling of sea ice tracers 
    3948 
    4049   !! interpolated gradient 
     
    4251   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtru           !: hor. gradient at u-points at bottom ocean level 
    4352   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrv           !: hor. gradient at v-points at bottom ocean level 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrui          !: hor. gradient at u-points at top    ocean level 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrvi          !: hor. gradient at v-points at top    ocean level 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)             ::  qsr_mean        !: daily mean qsr 
    4456    
    4557   !! passive tracers  (input and output) 
     
    5264   INTEGER             , PUBLIC                                    ::  nn_rsttr       !: control of the time step ( 0 or 1 ) for pass. tr. 
    5365   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_in   !: suffix of pass. tracer restart name (input) 
     66   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_indir  !: restart input directory 
    5467   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output) 
    55    REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step 
     68   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_outdir  !: restart output directory 
     69   REAL(wp)            , PUBLIC                                    ::  rdttrc         !: passive tracer time step 
    5670   LOGICAL             , PUBLIC                                    ::  ln_top_euler  !: boolean term for euler integration  
    5771   LOGICAL             , PUBLIC                                    ::  ln_trcdta      !: Read inputs data from files 
     
    5973   LOGICAL             , PUBLIC                                    ::  ln_trcdmp_clo  !: internal damping flag on closed seas 
    6074   INTEGER             , PUBLIC                                    ::  nittrc000       !: first time step of passive tracers model 
     75   LOGICAL             , PUBLIC                                    ::  l_trcdm2dc     !: Diurnal cycle for TOP 
     76 
     77   !! Information for the ice module for tracers 
     78   !! ------------------------------------------ 
     79   TYPE TRC_I_NML                    !--- Ice tracer namelist structure 
     80         REAL(wp)         :: trc_ratio  ! ice-ocean trc ratio 
     81         REAL(wp)         :: trc_prescr ! prescribed ice trc cc 
     82         CHARACTER(len=2) :: ctrc_o     ! choice of ocean trc cc 
     83   END TYPE 
     84 
     85   REAL(wp), DIMENSION(jptra), PUBLIC         :: trc_ice_ratio, & ! ice-ocean tracer ratio 
     86                                                 trc_ice_prescr   ! prescribed ice trc cc 
     87   CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc 
    6188 
    6289   !! information for outputs 
     
    6794       CHARACTER(len = 20)  :: clunit   !: unit 
    6895       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 
    69101       LOGICAL              :: llsave   !: save the tracer or not 
    70102   END TYPE PTRACER 
     
    119151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical double diffusivity coeff. at w-point   [m/s] 
    120152# endif 
    121 #if defined key_ldfslp 
    122    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_tm    !: i-direction slope at u-, w-points 
    123    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpj_tm    !: j-direction slope at u-, w-points 
    124    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm     !: j-direction slope at u-, w-points 
    125    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vslp_tm     !: j-direction slope at u-, w-points 
    126 #endif 
    127153#if defined key_trabbl 
    128154   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm  !: u-, w-points 
     
    159185#endif 
    160186   ! 
    161 #if defined key_ldfslp 
    162    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_temp, wslpj_temp, uslp_temp, vslp_temp    !: hold current values  
    163 #endif 
    164    !  
    165187# if defined key_zdfddm 
    166188   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_temp      !: salinity vertical diffusivity coeff. at w-point   [m/s] 
    167189# endif 
    168190   ! 
     191#if defined key_bdy 
     192   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc_dflt          ! Default OBC condition for all tracers 
     193   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc               ! Choice of boundary condition for tracers 
     194   INTEGER,           PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  nn_trcdmp_bdy        !: =T Tracer damping 
     195   ! External data structure of BDY for TOP. Available elements: cn_obc, ll_trc, trcnow, dmp 
     196   TYPE(OBC_DATA),    PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET ::  trcdta_bdy           !: bdy external data (local process) 
     197#endif 
     198   ! 
    169199 
    170200   !!---------------------------------------------------------------------- 
    171201   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) 
    172    !! $Id$  
     202   !! $Id$ 
    173203   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    174204   !!---------------------------------------------------------------------- 
     
    183213      ! 
    184214      ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       &   
    185          &      gtru(jpi,jpj,jpk)     , gtrv(jpi,jpj,jpk)                             ,       & 
    186          &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       & 
     215         &      trc_i(jpi,jpj,jptra)  , trc_o(jpi,jpj,jptra)                          ,       & 
     216         &      gtru (jpi,jpj,jptra)  , gtrv (jpi,jpj,jptra)                          ,       & 
     217         &      gtrui(jpi,jpj,jptra)  , gtrvi(jpi,jpj,jptra)                          ,       & 
     218         &      sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra)                      ,       &   
     219         &      cvol(jpi,jpj,jpk)     , trai(jptra)                                   ,       & 
    187220         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       &  
    188          &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)                             ,  STAT = trc_alloc  )   
     221         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)     , qsr_mean(jpi,jpj)     ,       & 
     222#if defined key_my_trc 
     223         &      ln_trc_sbc(jptra)     , ln_trc_cbc(jptra)     , ln_trc_obc(jptra)     ,       & 
     224#endif 
     225#if defined key_bdy 
     226         &      cn_trc_dflt(nb_bdy)   , cn_trc(nb_bdy)        , nn_trcdmp_bdy(nb_bdy) ,       & 
     227         &      trcdta_bdy(jptra,nb_bdy)                                              ,       & 
     228#endif 
     229         &      STAT = trc_alloc  ) 
    189230 
    190231      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays') 
Note: See TracChangeset for help on using the changeset viewer.