source: branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90 @ 6201

MODULE trcsms_idtra
   !!======================================================================
   !!                      ***  MODULE trcsms_idtra  ***
   !! TOP : TRI main model
   !!======================================================================
   !! History :    -   !  1999-10  (JC. Dutay)  original code
   !!             1.0  !  2004-03 (C. Ethe) free form + modularity
   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation
   !!----------------------------------------------------------------------
#if defined key_idtra
   !!----------------------------------------------------------------------
   !!   'key_idtra'                                               TRI tracers
   !!----------------------------------------------------------------------
   !!   trc_sms_idtra     :  compute and add TRI suface forcing to TRI trends
   !!   trc_idtra_cst :  sets constants for TRI surface forcing computation
   !!----------------------------------------------------------------------
   USE oce_trc      ! Ocean variables
   USE par_trc      ! TOP parameters
   USE trc          ! TOP variables
   USE trd_oce
   USE trdtrc
   USE iom

   IMPLICIT NONE
   PRIVATE

   PUBLIC   trc_sms_idtra        ! called in ???
   PUBLIC   trc_sms_idtra_alloc  ! called in ???
   !
   INTEGER , PUBLIC    ::   nyear_res      ! restoring time constant (year)
   INTEGER , PUBLIC    ::   numnatm
   REAL(wp), PUBLIC    ::   FDEC
   !
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_idtra  ! flux at surface
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_idtra ! cumulative flux 
   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   inv_idtra  ! vertic. inventory

   !                          ! coefficients for conversion
   REAL(wp) ::  WTEMP


   !! * Substitutions
#  include "top_substitute.h90"
   !!----------------------------------------------------------------------
   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
   !! $Id$
   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
   !!----------------------------------------------------------------------

CONTAINS

   SUBROUTINE trc_sms_idtra( kt )
      !!----------------------------------------------------------------------
      !!                     ***  ROUTINE trc_sms_idtra  ***
      !!
      !! ** Purpose :   Compute the surface boundary contition on TRI 11
      !!             passive tracer associated with air-mer fluxes and add it
      !!             to the general trend of tracers equations.
      !!
      !! ** Method  : - get the atmospheric partial pressure - given in pico -
      !!              - computation of solubility ( in 1.e-12 mol/l then in 1.e-9 mol/m3)
      !!              - computation of transfert speed ( given in cm/hour ----> cm/s )
      !!              - the input function is given by :
      !!                speed * ( concentration at equilibrium - concentration at surface )
      !!              - the input function is in pico-mol/m3/s and the
      !!                TRI concentration in pico-mol/m3
      !!               
      !! *** For Idealized Tracers              
      !!              - no need for any temporal references, 
      !!              nor any atmospheric concentration, nor air -sea fluxes
      !!              - Here we fixe surface concentration to 1.0 Tracer-Unit/m3
      !!              - Then we add a decay (radioactive-like) to this tracer concentration 
      !!              - the Half life deccay is chosen by the user, depending of the experiment. 
      !!              
      !!----------------------------------------------------------------------
      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
      !!
      INTEGER ::   ji, jj, jn, jl, jk



      !!----------------------------------------------------------------------
      IF (kt == nittrc000) THEN
         IF(lwp) WRITE(numout,*) '   trcsms_idtra :'
         IF(lwp) WRITE(numout,*) '   ~~~~~~~~~~~~~~~~~'
         IF(lwp) WRITE(numout,*) '   - idtra decay factor : ', FDEC
# if defined key_debug_medusa
      CALL flush(numout)
# endif
      ENDIF

         !
      inv_idtra(:,:,:) = 0.0                                        !! init the inventory
      DO jl = 1, jp_idtra
         jn = jp_idtra0 + jl - 1

         DO jj = 1, jpj
            DO ji = 1, jpi
         !! First, a crude version. will be much inproved later.
             qtr_idtra(ji,jj,jl)  = (1. - trb(ji,jj,1,jn)) * tmask(ji,jj,1) *   & 
                                  fse3t(ji,jj,1) / rdt             !! Air-sea Flux
           ENDDO
         ENDDO
         tra(:,:,1,jn)      = tra(:,:,1,jn) + ( qtr_idtra(:,:,jl) *  &
                            tmask(:,:,1) / fse3t(:,:,1) )
         qint_idtra(:,:,jl) = qint_idtra(:,:,jl) +                   &           
                              qtr_idtra(:,:,jl) * rdt              !! Cumulative Air-sea Flux


         DO jk =1,jpk
            inv_idtra(:,:,jl) = inv_idtra(:,:,jl) +                  &
                     (trn(:,:,jk,jn) * fse3t(:,:,jk) * tmask(:,:,jk))  !! vertical inventory
         ENDDO
!
!DECAY of OUR IDEALIZED TRACER
! ---------------------------------------

         DO  jk =1,jpk
            DO jj=1,jpj
              DO  ji =1,jpi
               !  IF (trn(ji,jj,jk,jn) > 0.0) THEN
                    WTEMP = trn(ji,jj,jk,jn) * (1. - FDEC )
                    tra(ji,jj,jk,jn) = (tra(ji,jj,jk,jn) - WTEMP/rdt ) * &
                                     tmask(ji,jj,jk)
               !  ENDIF 
              ENDDO 
            ENDDO
         ENDDO

      ENDDO
    !! jn loop
!

        !
      IF( lrst_trc ) THEN
         IF(lwp) WRITE(numout,*)
         IF(lwp) WRITE(numout,*) 'trc_sms_idtra : cumulated input function fields written in ocean restart file ',   &
            &                    'at it= ', kt,' date= ', ndastp
         IF(lwp) WRITE(numout,*) '~~~~'
         DO jn = jp_idtra0, jp_idtra1
            CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA', qint_idtra(:,:,jn) )
         END DO
      ENDIF
      !
      IF( lk_iomput ) THEN
         CALL iom_put( "qtrIDTRA"  , qtr_idtra (:,:,1) )
         CALL iom_put( "qintIDTRA" , qint_idtra(:,:,1) )
         CALL iom_put( "invIDTRA" , inv_idtra(:,:,1) )
      ELSE
         IF( ln_diatrc ) THEN
            trc2d(:,:,jp_idtra0_2d    ) = qtr_idtra (:,:,1)
            trc2d(:,:,jp_idtra0_2d + 1) = qint_idtra(:,:,1)
            trc2d(:,:,jp_idtra0_2d + 2) = inv_idtra(:,:,1)
         END IF
      END IF
      !
      IF( l_trdtrc ) THEN
          DO jn = jp_idtra0, jp_idtra1
            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
          END DO
      END IF
      !
      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_idtra')
      !
# if defined key_debug_medusa
         IF(lwp) WRITE(numout,*) '   IDTRA DONE trc_sms_idtra -- '
      CALL flush(numout)
# endif
      !
   END SUBROUTINE trc_sms_idtra

   INTEGER FUNCTION trc_sms_idtra_alloc()
      !!----------------------------------------------------------------------
      !!                     ***  ROUTINE trc_sms_idtra_alloc  ***
      !!----------------------------------------------------------------------
      ALLOCATE( qtr_idtra (jpi,jpj,jp_idtra) ,     &
         &      inv_idtra(jpi,jpj,jp_idtra)  ,     &
         &      qint_idtra(jpi,jpj,jp_idtra) , STAT=trc_sms_idtra_alloc )
         !
      IF( trc_sms_idtra_alloc /= 0 ) CALL ctl_warn('trc_sms_idtra_alloc : failed to allocate arrays.')
      !
   END FUNCTION trc_sms_idtra_alloc

#else
   !!----------------------------------------------------------------------
   !!   Dummy module                                         No TRI tracers
   !!----------------------------------------------------------------------
CONTAINS
   SUBROUTINE trc_sms_idtra( kt )       ! Empty routine
      WRITE(*,*) 'trc_sms_idtra: You should not have seen this print! error?', kt
   END SUBROUTINE trc_sms_idtra
#endif

   !!======================================================================
END MODULE trcsms_idtra