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 5572 for branches/UKMO/dev_r5107_hadgem3_cplseq/NEMOGCM/NEMO/TOP_SRC/trc.F90 – NEMO

Ignore:
Timestamp:
2015-07-09T12:14:37+02:00 (9 years ago)
Author:
davestorkey
Message:

Update UKMO/dev_r5107_hadgem3_cplseq branch to trunk revision 5518
(= branching point of NEMO 3.6_stable).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5107_hadgem3_cplseq/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r5477 r5572  
    3434   REAL(wp), PUBLIC                                                ::  areatot        !: total volume  
    3535   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 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: tracer concentration for now time step 
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: tracer concentration for next time step 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: tracer concentration for before time step 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  sbc_trc_b      !: Before sbc fluxes for tracers 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  sbc_trc        !: Now sbc fluxes for tracers 
     41 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  trc_i          !: prescribed tracer concentration in sea ice for SBC 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  trc_o          !: prescribed tracer concentration in ocean for SBC 
     44   INTEGER             , PUBLIC                                    ::  nn_ice_tr      !: handling of sea ice tracers 
    3945 
    4046   !! interpolated gradient 
     
    4450   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrui          !: hor. gradient at u-points at top    ocean level 
    4551   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrvi          !: hor. gradient at v-points at top    ocean level 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)             ::  qsr_mean        !: daily mean qsr 
    4653    
    4754   !! passive tracers  (input and output) 
     
    5461   INTEGER             , PUBLIC                                    ::  nn_rsttr       !: control of the time step ( 0 or 1 ) for pass. tr. 
    5562   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_in   !: suffix of pass. tracer restart name (input) 
     63   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_indir  !: restart input directory 
    5664   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output) 
     65   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_outdir  !: restart output directory 
    5766   REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step 
    5867   LOGICAL             , PUBLIC                                    ::  ln_top_euler  !: boolean term for euler integration  
     
    6170   LOGICAL             , PUBLIC                                    ::  ln_trcdmp_clo  !: internal damping flag on closed seas 
    6271   INTEGER             , PUBLIC                                    ::  nittrc000       !: first time step of passive tracers model 
     72   LOGICAL             , PUBLIC                                    ::  l_trcdm2dc     !: Diurnal cycle for TOP 
     73 
     74   !! Information for the ice module for tracers 
     75   !! ------------------------------------------ 
     76   TYPE TRC_I_NML                    !--- Ice tracer namelist structure 
     77         REAL(wp)         :: trc_ratio  ! ice-ocean trc ratio 
     78         REAL(wp)         :: trc_prescr ! prescribed ice trc cc 
     79         CHARACTER(len=2) :: ctrc_o     ! choice of ocean trc cc 
     80   END TYPE 
     81 
     82   REAL(wp), DIMENSION(jptra), PUBLIC         :: trc_ice_ratio, & ! ice-ocean tracer ratio 
     83                                                 trc_ice_prescr   ! prescribed ice trc cc 
     84   CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc 
    6385 
    6486   !! information for outputs 
     
    185207      ! 
    186208      ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       &   
     209         &      trc_i(jpi,jpj,jptra)  , trc_o(jpi,jpj,jptra)                          ,       & 
    187210         &      gtru (jpi,jpj,jptra)  , gtrv (jpi,jpj,jptra)                          ,       & 
    188211         &      gtrui(jpi,jpj,jptra)  , gtrvi(jpi,jpj,jptra)                          ,       & 
     212         &      sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra)                      ,       &   
    189213         &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       & 
    190214         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       &  
    191          &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)                             ,  STAT = trc_alloc  )   
     215         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)     , qsr_mean(jpi,jpj)     ,  STAT = trc_alloc  )   
    192216 
    193217      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays') 
Note: See TracChangeset for help on using the changeset viewer.