C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_init_fixed.F,v 1.15 2015/09/16 16:50:49 jahn Exp $
C $Name:  $

#include "PTRACERS_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: PTRACERS_INIT_FIXED

C     !INTERFACE:
      SUBROUTINE PTRACERS_INIT_FIXED( myThid )

C     !DESCRIPTION:
C     Initialize PTRACERS constant

C     !USES:
#include "PTRACERS_MOD.h"
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "PTRACERS_SIZE.h"
#include "PTRACERS_PARAMS.h"
#include "GAD.h"

C     !INPUT PARAMETERS:
      INTEGER myThid
CEOP

#ifdef ALLOW_PTRACERS
C     !FUNCTIONS
      INTEGER  GAD_ADVSCHEME_GET
      EXTERNAL 

C     !LOCAL VARIABLES:
C     iTracer     :: tracer index
C     errCount    :: error counter
C     tracMinSize :: overlap minimum size for ptracers advection
C     msgBuf      :: Informational/error message buffer
      INTEGER iTracer
      INTEGER errCount
      INTEGER tracMinSize, minSize
      LOGICAL updateMinSize
      CHARACTER*(MAX_LEN_MBUF) msgBuf

      _BEGIN_MASTER( myThid )
      errCount = 0

C     Initialise internal parameter in common block:
      DO iTracer = 1, PTRACERS_num
        PTRACERS_MultiDimAdv(iTracer)  = multiDimAdvection
        PTRACERS_SOM_Advection(iTracer)= .FALSE.
        PTRACERS_AdamsBashGtr(iTracer) = .FALSE.
        PTRACERS_AdamsBash_Tr(iTracer) = .FALSE.
      ENDDO

C--   Loop over tracers
      tracMinSize = 0
      DO iTracer = 1, PTRACERS_numInUse

C-    Check for valid advection-scheme number
        IF ( PTRACERS_advScheme(iTracer).NE.0 ) THEN
         minSize = GAD_ADVSCHEME_GET( PTRACERS_advScheme(iTracer) )
         IF ( minSize.LT.0 ) THEN
          WRITE(msgBuf,'(2A,I6)') 'PTRACERS_INIT_FIXED: ',
     &    'invalid Adv. Scheme number=', PTRACERS_advScheme(iTracer)
          CALL PRINT_ERROR( msgBuf, myThid )
          WRITE(msgBuf,'(2A,I6)') 'PTRACERS_INIT_FIXED: ',
     &    'for tracer #', iTracer
          CALL PRINT_ERROR( msgBuf, myThid )
          errCount = errCount + 1
         ENDIF
        ELSE
         minSize = 1
        ENDIF
C     Overlap minimum size consistent with ptracers advection
        tracMinSize = MAX( tracMinSize, minSize )

        IF (
     &       PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND .OR.
     &       PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD .OR.
     &       PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH .OR.
     &       PTRACERS_advScheme(iTracer).EQ.0
     &     ) PTRACERS_MultiDimAdv(iTracer) = .FALSE.
        useMultiDimAdvec = useMultiDimAdvec
     &                .OR. PTRACERS_MultiDimAdv(iTracer)
        PTRACERS_AdamsBashGtr(iTracer) =
     &       PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND .OR.
     &       PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD .OR.
     &       PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH
        IF ( .NOT.PTRACERS_doAB_onGpTr ) THEN
         PTRACERS_AdamsBash_Tr(iTracer) = PTRACERS_AdamsBashGtr(iTracer)
         PTRACERS_AdamsBashGtr(iTracer) = .FALSE.
        ENDIF

        PTRACERS_SOM_Advection(iTracer) =
     &    PTRACERS_advScheme(iTracer).GE.ENUM_SOM_PRATHER
     &    .AND. PTRACERS_advScheme(iTracer).LE.ENUM_SOM_LIMITER
#ifndef PTRACERS_ALLOW_DYN_STATE
        IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
          WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
     &   'trying to use 2nd.Order-Moment Advection without'
          CALL PRINT_ERROR( msgBuf, myThid )
          WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
     &   'dynamical internal state data structures compiled'
          CALL PRINT_ERROR( msgBuf, myThid )
          WRITE(msgBuf,'(2A)') 'PTRACERS_INIT_FIXED: ',
     &   'Re-compile with:  #define PTRACERS_ALLOW_DYN_STATE'
          CALL PRINT_ERROR( msgBuf, myThid )
          errCount = errCount + 1
        ENDIF
#endif /* ndef PTRACERS_ALLOW_DYN_STATE */

C--   end of Tracer loop
      ENDDO

C--   Update Overlap minimum size according to tracer advection
      updateMinSize = GAD_OlMinSize(1).LT.tracMinSize
      GAD_OlMinSize(1) = MAX( GAD_OlMinSize(1), tracMinSize )
C-    Constraint on size of the overlap (after updating "useMultiDimAdvec"):
      IF ( useCubedSphereExchange .AND. useMultiDimAdvec ) THEN
C-    multi-dim-advection on CS-grid requires to double the size of OLx,OLy
        updateMinSize = updateMinSize .OR. ( GAD_OlMinSize(3).LT.2 )
        GAD_OlMinSize(3) = MAX( GAD_OlMinSize(3), 2 )
      ENDIF
      IF ( updateMinSize ) THEN
        WRITE(msgBuf,'(2A,9I3)') 'PTRACERS_INIT_FIXED: ',
     &      'updated GAD_OlMinSize=', GAD_OlMinSize
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                    SQUEEZE_RIGHT, myThid )
      ENDIF

#ifdef PTRACERS_ALLOW_DYN_STATE
      CALL PTRACERS_INIT_FIXED_DYNAMIC( PtrISt,
     &                                  PTRACERS_numInUse,
     &                                  PTRACERS_SOM_Advection,
     &                                  sNx, sNy, Nr, OLx, OLy,
     &                                  nSx, nSy, nSOM,
     &                                  myThid )
#endif

C--   Stop if any error was found:
      IF ( errCount .GE. 1 ) THEN
        WRITE(msgBuf,'(A,I3,A)')
     &  'S/R PTRACERS_INIT_FIXED: detected', errCount,' fatal error(s)'
        CALL PRINT_ERROR( msgBuf, myThid )
        CALL ALL_PROC_DIE( 0 )
        STOP 'ABNORMAL END: S/R PTRACERS_INIT_FIXED'
      ENDIF

      _END_MASTER( myThid )
      _BARRIER

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

#ifdef ALLOW_MNC
      IF (useMNC) THEN
C       Initialize the MNC variable types for PTRACERS
        CALL PTRACERS_MNC_INIT( myThid )
      ENDIF
#endif

#ifdef ALLOW_DIAGNOSTICS
      IF ( useDiagnostics ) THEN
        CALL PTRACERS_DIAGNOSTICS_INIT( myThid )
      ENDIF
#endif

#endif /* ALLOW_PTRACERS */

      RETURN
      END