source: NEMO/branches/UKMO/dev_r10037_GPU/src/ICE/scice.F90 @ 12806

MODULE scice
   !!======================================================================
   !!                      ***  MODULE  oce  ***
   !! Ocean        :  dynamics and active tracers defined in memory 
   !!======================================================================
   !! History :  1.0  !  2002-11  (G. Madec)  F90: Free form and module
   !!            3.1  !  2009-02  (G. Madec, M. Leclair)  pure z*
   !coordinate
   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add ts, gtsu,
   !gtsv 4D arrays
   !!            3.7  !  2014-01  (G. Madec) suppression of curl and
   !before hdiv from in-core memory
   !!----------------------------------------------------------------------
   USE par_oce        ! ocean parameters
   USE lib_mpp        ! MPP library
#if defined key_si3
   USE ice, ONLY : jpl, nlay_i, nlay_s
#endif
   IMPLICIT NONE
   PRIVATE

   PUBLIC scice_alloc ! routine called by nemo_init in nemogcm.F90

#if defined key_si3
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:,:,:) :: scr1i, scr2i, scr3i, scr4i, scr5i, scr6i  ! scratch arrays SI3
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:,:)   :: scr1ai, scr2ai
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:)     :: scr1D1i, scr1D2i, scr1D3i, scr1D4i, &
                                                            scr1D5i, scr1D6i, scr1D7i, scr1D8i, &
                                                            scr1D9i, scr1D10i, scr1D11i, scr1D12i, &
                                                            scr1D13i
   INTEGER,  PUBLIC, ALLOCATABLE,       DIMENSION(:)     :: iscr1D1i

   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   ztiold      ! Old temperature in the ice
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   ztsold      ! Old temperature in the snow
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   ztib        ! Temporary temperature in the ice to check the convergence
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   ztsb        ! Temporary temperature in the snow to check the convergence
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   ztcond_i    ! Ice thermal conductivity
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   zradtr_i    ! Radiation transmitted through the ice
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   zradab_i    ! Radiation absorbed in the ice
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   zkappa_i    ! Kappa factor in the ice
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   zeta_i      ! Eta factor in the ice
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   zradtr_s    ! Radiation transmited through the snow
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   zradab_s    ! Radiation absorbed in the snow
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   zkappa_s    ! Kappa factor in the snow
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   zeta_s      ! Eta factor in the snow
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   zindterm    ! 'Ind'ependent term
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   zindtbis    ! Temporary 'ind'ependent term
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :)     ::   zdiagbis    ! Temporary 'dia'gonal term
   REAL(wp), PUBLIC, ALLOCATABLE,       DIMENSION(:, :, :)  ::   ztrid       ! Tridiagonal system terms
#endif

CONTAINS

   INTEGER FUNCTION scice_alloc()
      !!----------------------------------------------------------------------
      !!                   ***  FUNCTION oce_alloc  ***
      !!----------------------------------------------------------------------
      INTEGER :: ierr(2)
      !!----------------------------------------------------------------------
      !
      ierr(:) = 0
#if defined key_si3
      ALLOCATE(scr1i(jpi,jpj, jpl), scr2i(jpi,jpj, jpl), scr1D1i(jpij), scr1D2i(jpij), &
               scr1D3i(jpij), scr1D4i(jpij),  scr1D5i(jpij), scr1D6i(jpij),            &
               scr1D7i(jpij), scr1D8i(jpij),  scr1D9i(jpij), scr1D10i(jpij),           &
               scr1D11i(jpij), scr1D12i(jpij), scr1D13i(jpij), iscr1D1i(jpij),         &
               scr1ai(jpij,jpl), scr2ai(jpij,jpl), scr3i(jpi,jpj, jpl),                &
               scr4i(jpi,jpj, jpl), scr5i(jpi,jpj, jpl), scr6i(jpi,jpj, jpl), STAT=ierr(1))
      ALLOCATE(ztiold(jpij,nlay_i), ztsold(jpij,nlay_s), ztib(jpij,nlay_i), ztsb(jpij,nlay_s), &
               ztcond_i(jpij,0:nlay_i), zradtr_i(jpij,0:nlay_i), zradab_i(jpij,0:nlay_i), &
               zkappa_i(jpij,0:nlay_i), zeta_i(jpij,0:nlay_i), zradtr_s(jpij,0:nlay_s),   &
               zradab_s(jpij,0:nlay_s), zkappa_s(jpij,0:nlay_s), zeta_s(jpij,0:nlay_s),   &
               zindterm(jpij,nlay_i+3), zindtbis(jpij,nlay_i+3), zdiagbis(jpij,nlay_i+3), &
               ztrid(jpij,nlay_i+3,3),  STAT=ierr(2))
#endif
      ! 
      scice_alloc = MAXVAL( ierr )
      IF( lk_mpp    )   CALL mpp_sum( scice_alloc )
      IF( scice_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sice_alloc: unable to allocate scratch ice arrays' )
#if defined key_si3
      scr1i(:, :, :) = 0.
      scr2i(:,:, :)  = 0.
      scr3i(:, :, :) = 0.
      scr4i(:,:, :)  = 0.
      scr1D1i(:)     = 0.
      scr1D2i(:)     = 0.
      scr1D3i(:)     = 0.
      scr1D4i(:)     = 0.
      scr1D5i(:)     = 0.
      scr1D6i(:)     = 0.
      scr1D7i(:)     = 0.
      scr1D8i(:)     = 0.
      scr1D9i(:)     = 0.
      scr1D10i(:)    = 0.
      scr1D11i(:)    = 0.
      scr1D12i(:)    = 0.
      scr1D13i(:)    = 0.
      iscr1D1i(:)    = 0
      scr1ai(:, :)   = 0.
      scr2ai(:, :)   = 0.
#endif 
      !
   END FUNCTION scice_alloc

   !!======================================================================
END MODULE scice