!/===========================================================================/
! Copyright (c) 2007, The University of Massachusetts Dartmouth 
! Produced at the School of Marine Science & Technology 
! Marine Ecosystem Dynamics Modeling group
! All rights reserved.
!
! FVCOM has been developed by the joint UMASSD-WHOI research team. For 
! details of authorship and attribution of credit please see the FVCOM
! technical manual or contact the MEDM group.
!
! 
! This file is part of FVCOM. For details, see http://fvcom.smast.umassd.edu 
! The full copyright notice is contained in the file COPYRIGHT located in the 
! root directory of the FVCOM code. This original header must be maintained
! in all distributed versions.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
! AND ANY EXPRESS OR  IMPLIED WARRANTIES, INCLUDING,  BUT NOT  LIMITED TO,
! THE IMPLIED WARRANTIES OF MERCHANTABILITY AND  FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED.  
!
!/---------------------------------------------------------------------------/
! CVS VERSION INFORMATION
! $Id$
! $Name$
! $Revision$
!/===========================================================================/

!==============================================================================|
!  MODULE CONTAINING SUBROUTINES USED TO SET UP MOMENTUM BALANCE OUTPUT        |
!==============================================================================|

MODULE MOD_BALANCE_2D
# if defined (BALANCE_2D)
   USE MOD_PREC
   USE CONTROL
   IMPLICIT NONE
   SAVE
   
   INTEGER, PARAMETER :: NUM_BALANCE_MAX = 200
   LOGICAL  :: OUT_BALANCE                 !!TRUE IF MOMENTUM BALANCE CHECHACTIVE
   INTEGER :: NUM_BALANCE,IOMOB
   
   INTEGER :: NO_CELL(NUM_BALANCE_MAX)     !!CELL NO FOR OUTPUT MOMENTUM BALANCE
   REAL(SP), ALLOCATABLE :: ADFXA(:)      
   REAL(SP), ALLOCATABLE :: ADFYA(:)

   REAL(SP), ALLOCATABLE :: ADVUA2(:)   !!ADVECTION TERM   
   REAL(SP), ALLOCATABLE :: ADVVA2(:) 
   
   REAL(SP), ALLOCATABLE :: ADFX2(:)    
   REAL(SP), ALLOCATABLE :: ADFY2(:)
   
   REAL(SP), ALLOCATABLE :: DRX2D2(:)   !!BAROCLINIC PRESURE GRADENT FORCE
   REAL(SP), ALLOCATABLE :: DRY2D2(:)
   
   REAL(SP), ALLOCATABLE :: CORX2(:)    !!CORIOLIS FORCE TERM
   REAL(SP), ALLOCATABLE :: CORY2(:)
      
   REAL(SP), ALLOCATABLE :: PSTX2(:)    !!BAROTROPIC PRESURE GRSDENT FORCE
   REAL(SP), ALLOCATABLE :: PSTY2(:)
   
   REAL(SP), ALLOCATABLE :: ADX2D2(:)   !!DIFFUSION TERM (GX,GY)
   REAL(SP), ALLOCATABLE :: ADY2D2(:)
   
   
   REAL(SP), ALLOCATABLE :: WUSURBF2(:)  !!STRESS TERM
   REAL(SP), ALLOCATABLE :: WVSURBF2(:)
   
   REAL(SP), ALLOCATABLE :: DUDT2(:)
   REAL(SP), ALLOCATABLE :: DVDT2(:)
   
   REAL(SP), ALLOCATABLE :: DIVX2D2(:)
   REAL(SP), ALLOCATABLE :: DIVY2D2(:)
   REAL(SP), ALLOCATABLE :: DEDT2(:)
   
   
   REAL(SP), ALLOCATABLE :: ADVUA2_AVE(:)
   REAL(SP), ALLOCATABLE :: ADVVA2_AVE(:)
   
   REAL(SP), ALLOCATABLE :: ADFX2_AVE(:)
   REAL(SP), ALLOCATABLE :: ADFY2_AVE(:)
   
   REAL(SP), ALLOCATABLE :: DRX2D2_AVE(:)
   REAL(SP), ALLOCATABLE :: DRY2D2_AVE(:)
   
   REAL(SP), ALLOCATABLE :: CORX2_AVE(:)
   REAL(SP), ALLOCATABLE :: CORY2_AVE(:)
   
   REAL(SP), ALLOCATABLE :: PSTX2_AVE(:)
   REAL(SP), ALLOCATABLE :: PSTY2_AVE(:)
      
   REAL(SP), ALLOCATABLE :: ADX2D2_AVE(:)
   REAL(SP), ALLOCATABLE :: ADY2D2_AVE(:)
   
   REAL(SP), ALLOCATABLE :: WUSURBF2_AVE(:)
   REAL(SP), ALLOCATABLE :: WVSURBF2_AVE(:)
   
   REAL(SP), ALLOCATABLE :: DUDT2_AVE(:)
   REAL(SP), ALLOCATABLE :: DVDT2_AVE(:)
   
   NAMELIST /NML_BALANCE_2D/   &
        & OUT_BALANCE,         & 
        & NUM_BALANCE,         & 
        & NO_CELL 

!===================================================================================|
   CONTAINS   !!INCLUDED SUBROUTINES FOLLOW
!===================================================================================|
    SUBROUTINE ALLOC_BALANCE_VARS
    USE LIMS

    ALLOCATE(ADFXA(0:NT))        ;ADFXA     = ZERO
    ALLOCATE(ADFYA(0:NT))        ;ADFYA     = ZERO
    
    ALLOCATE(ADVUA2(0:NT))       ;ADVUA2    = ZERO
    ALLOCATE(ADVVA2(0:NT))       ;ADVVA2    = ZERO
    ALLOCATE(ADFX2(0:NT))        ;ADFX2     = ZERO
    ALLOCATE(ADFY2(0:NT))        ;ADFY2     = ZERO
    ALLOCATE(DRX2D2(0:NT))       ;DRX2D2    = ZERO
    ALLOCATE(DRY2D2(0:NT))       ;DRY2D2    = ZERO
    ALLOCATE(CORX2(0:NT))        ;CORX2     = ZERO
    ALLOCATE(CORY2(0:NT))        ;CORY2     = ZERO
    ALLOCATE(PSTX2(0:NT))        ;PSTX2     = ZERO
    ALLOCATE(PSTY2(0:NT))        ;PSTY2     = ZERO
    ALLOCATE(ADX2D2(0:NT))       ;ADX2D2    = ZERO
    ALLOCATE(ADY2D2(0:NT))       ;ADY2D2    = ZERO
    ALLOCATE(WUSURBF2(0:NT))     ;WUSURBF2  = ZERO 
    ALLOCATE(WVSURBF2(0:NT))     ;WVSURBF2  = ZERO 
    ALLOCATE(DUDT2(0:NT))        ;DUDT2     = ZERO 
    ALLOCATE(DVDT2(0:NT))        ;DVDT2     = ZERO
     
    ALLOCATE(DIVX2D2(0:NT))      ;DIVX2D2   = ZERO 
    ALLOCATE(DIVY2D2(0:NT))      ;DIVY2D2   = ZERO 
    ALLOCATE(DEDT2(0:NT))        ;DEDT2     = ZERO  
   RETURN
   END SUBROUTINE ALLOC_BALANCE_VARS

   SUBROUTINE NAME_LIST_READ_BALANCE
   USE MOD_UTILS
   USE CONTROL

   IMPLICIT NONE
   integer :: ios, i
   Character(Len=120):: FNAME
   if(DBG_SET(dbg_sbr)) &
        & write(IPT,*) "Subroutine Begins: name_list_read_balance;"

    ios = 0

    FNAME = "./"//trim(casename)//"_run.nml"

    if(DBG_SET(dbg_io)) &
         & write(IPT,*) "Set_balance_param: File: ",trim(FNAME)

    CALL FOPEN(NMLUNIT,trim(FNAME),'cfr')

    !READ NAME LIST FILE

    ! Read 2D Balance Settings
    READ(UNIT=NMLUNIT, NML=NML_BALANCE_2D,IOSTAT=ios)
    if(ios .NE. 0 ) then
       if(DBG_SET(dbg_log)) write(UNIT=IPT,NML=NML_BALANCE_2D)
       Call Fatal_Error("Can Not Read NameList NML_BALANCE_2D from file: "//trim(FNAME))
    end if

    REWIND(NMLUNIT)

    if(DBG_SET(dbg_scl)) &
         & write(IPT,*) "Read_Name_List:"

    if(DBG_SET(dbg_scl)) &
         & write(UNIT=IPT,NML=NML_BALANCE_2D)


    IF(NUM_BALANCE > NUM_BALANCE_MAX)THEN
      CALL FATAL_ERROR("NUM_BALANCE > NUM_BALANCE_MAX=200",      &
                       "CHANGE THE VALUE OF NUM_BALANCE_MAX IN MOD_BALANCE_2D")
    END IF
      
    CLOSE(NMLUNIT)

!==============================================================================|
!            SCREEN REPORT OF SET MOMENTUM BALANCE OUT VARIABlES               !
!==============================================================================|
   IF(MSR) THEN  
     WRITE(IPT,*) '!                                                   !'     
     WRITE(IPT,*) '!------SPECIFY MOMENTUM BALANCE OUT VARIABlES-------!'     
     WRITE(IPT,*) '!                                                   !'     
     WRITE(IPT,*) '!  # OUT_BALANCE         :',OUT_BALANCE
     WRITE(IPT,*) '!  # NUM_BALANCE         :',NUM_BALANCE
     WRITE(IPT,*) '!  # NO_CELL             :',NO_CELL
   END IF

   CALL FOPEN(IOMOB, "balance.2d" ,"ofr")   

   RETURN
   END SUBROUTINE NAME_LIST_READ_BALANCE

!
!  out time series of momentum balance terms
!   
   SUBROUTINE OUT_TIMESERIES_BALANCE
   USE MOD_PREC
   USE ALL_VARS
#  if defined (MULTIPROCESSOR)
   USE MOD_PAR 
#  endif
   IMPLICIT NONE
   INTEGER I
   REAL(SP), ALLOCATABLE, DIMENSION(:)   :: ADVUA2TMP,  ADVVA2TMP,  ADFX2TMP, ADFY2TMP  
   REAL(SP), ALLOCATABLE, DIMENSION(:)   :: DRX2D2TMP,  DRY2D2TMP,  CORX2TMP, CORY2TMP  
   REAL(SP), ALLOCATABLE, DIMENSION(:)   :: PSTX2TMP,   PSTY2TMP,   ADX2D2TMP,ADY2D2TMP
   REAL(SP), ALLOCATABLE, DIMENSION(:)   :: WUSURBF2TMP,WVSURBF2TMP,DUDT2TMP, DVDT2TMP
   REAL(SP), ALLOCATABLE, DIMENSION(:)   :: DIVX2D2TMP,    DIVY2D2TMP,    DEDT2TMP
   IF(SERIAL)THEN
     WRITE(IOMOB,'(i6,150(19E13.5,2X))') IINT, &
       (ADVUA2(NO_CELL(I)),  ADVVA2(NO_CELL(I)),&
        ADFX2(NO_CELL(I)),   ADFY2(NO_CELL(I)),& 
        DRX2D2(NO_CELL(I)),  DRY2D2(NO_CELL(I)),&
	CORX2(NO_CELL(I)),   CORY2(NO_CELL(I)),&  
        PSTX2(NO_CELL(I)),   PSTY2(NO_CELL(I)),&
	ADX2D2(NO_CELL(I)),  ADY2D2(NO_CELL(I)),&
        WUSURBF2(NO_CELL(I)),WVSURBF2(NO_CELL(I)),&
	DUDT2(NO_CELL(I)),   DVDT2(NO_CELL(I)),&
	DIVX2D2(NO_CELL(I)),DIVY2D2(NO_CELL(I)),&
	DEDT2(NO_CELL(I)),I=1,NUM_BALANCE)
   ENDIF 
#  if defined (MULTIPROCESSOR)
   IF(PAR)THEN
    IF(MSR)THEN
     !!GATHER AND WRITE ELEMENT-BASED QUANTITIES (ADVUA2,ADVVA2,...)
      
     ALLOCATE(ADVUA2TMP(0:NGL))
     ALLOCATE(ADVVA2TMP(0:NGL))
     ALLOCATE(ADFX2TMP(0:NGL))
     ALLOCATE(ADFY2TMP(0:NGL))
     ALLOCATE(DRX2D2TMP(0:NGL))
     ALLOCATE(DRY2D2TMP(0:NGL))
     ALLOCATE(CORY2TMP(0:NGL))
     ALLOCATE(CORX2TMP(0:NGL))
     ALLOCATE(PSTY2TMP(0:NGL))
     ALLOCATE(PSTX2TMP(0:NGL))
     ALLOCATE(ADX2D2TMP(0:NGL))
     ALLOCATE(ADY2D2TMP(0:NGL))
     ALLOCATE(WUSURBF2TMP(0:NGL))
     ALLOCATE(WVSURBF2TMP(0:NGL))
     ALLOCATE(DUDT2TMP(0:NGL))
     ALLOCATE(DVDT2TMP(0:NGL))
     ALLOCATE(DIVX2D2TMP(0:NGL))
     ALLOCATE(DIVY2D2TMP(0:NGL))
     ALLOCATE(DEDT2TMP(0:NGL))
     END IF
!     CALL GATHER(LBOUND(ADVUA2,1),  UBOUND(ADVUA2,1),   N,NGL,1,MYID,NPROCS,EMAP,ADVUA2,  ADVUA2TMP)
!     CALL GATHER(LBOUND(ADVVA2,1),  UBOUND(ADVVA2,1),   N,NGL,1,MYID,NPROCS,EMAP,ADVVA2,  ADVVA2TMP)
!     CALL GATHER(LBOUND(ADFX2,1),   UBOUND(ADFX2,1),    N,NGL,1,MYID,NPROCS,EMAP,ADFX2,   ADFX2TMP)
!     CALL GATHER(LBOUND(ADFY2,1),   UBOUND(ADFY2,1),    N,NGL,1,MYID,NPROCS,EMAP,ADFY2,   ADFY2TMP)
!     CALL GATHER(LBOUND(DRX2D2,1),  UBOUND(DRX2D2,1),   N,NGL,1,MYID,NPROCS,EMAP,DRX2D2,  DRX2D2TMP)
!     CALL GATHER(LBOUND(DRY2D2,1),  UBOUND(DRY2D2,1),   N,NGL,1,MYID,NPROCS,EMAP,DRY2D2,  DRY2D2TMP)
!     CALL GATHER(LBOUND(CORX2,1),   UBOUND(CORX2,1),    N,NGL,1,MYID,NPROCS,EMAP,CORX2,    CORX2TMP)
!     CALL GATHER(LBOUND(CORY2,1),   UBOUND(CORY2,1),    N,NGL,1,MYID,NPROCS,EMAP,CORY2,    CORY2TMP)
!     CALL GATHER(LBOUND(PSTX2,1),   UBOUND(PSTX2,1),    N,NGL,1,MYID,NPROCS,EMAP,PSTX2,    PSTX2TMP)
!     CALL GATHER(LBOUND(PSTY2,1),   UBOUND(PSTY2,1),    N,NGL,1,MYID,NPROCS,EMAP,PSTY2,    PSTY2TMP)
!     CALL GATHER(LBOUND(ADX2D2,1),  UBOUND(ADX2D2,1),   N,NGL,1,MYID,NPROCS,EMAP,ADX2D2,   ADX2D2TMP)
!     CALL GATHER(LBOUND(ADY2D2,1),  UBOUND(ADY2D2,1),   N,NGL,1,MYID,NPROCS,EMAP,ADY2D2,   ADY2D2TMP)
!     CALL GATHER(LBOUND(WUSURBF2,1),UBOUND(WUSURBF2,1), N,NGL,1,MYID,NPROCS,EMAP,WUSURBF2, WUSURBF2TMP)
!     CALL GATHER(LBOUND(WVSURBF2,1),UBOUND(WVSURBF2,1), N,NGL,1,MYID,NPROCS,EMAP,WVSURBF2, WVSURBF2TMP)
!     CALL GATHER(LBOUND(DUDT2,1),   UBOUND(DUDT2,1),    N,NGL,1,MYID,NPROCS,EMAP,DUDT2,    DUDT2TMP)
!     CALL GATHER(LBOUND(DVDT2,1),   UBOUND(DVDT2,1),    N,NGL,1,MYID,NPROCS,EMAP,DVDT2,    DVDT2TMP)
!     CALL GATHER(LBOUND(DIVX2D2,1), UBOUND(DIVX2D2,1),  N,NGL,1,MYID,NPROCS,EMAP,DIVX2D2,  DIVX2D2TMP)
!     CALL GATHER(LBOUND(DIVY2D2,1), UBOUND(DIVY2D2,1),  N,NGL,1,MYID,NPROCS,EMAP,DIVY2D2,  DIVY2D2TMP)
!     CALL GATHER(LBOUND(DEDT2,1),   UBOUND(DEDT2,1),    N,NGL,1,MYID,NPROCS,EMAP,DEDT2,    DEDT2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,ADVUA2,  ADVUA2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,ADVVA2,  ADVVA2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,ADFX2,   ADFX2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,ADFY2,   ADFY2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,DRX2D2,  DRX2D2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,DRY2D2,  DRY2D2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,CORX2,    CORX2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,CORY2,    CORY2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,PSTX2,    PSTX2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,PSTY2,    PSTY2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,ADX2D2,   ADX2D2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,ADY2D2,   ADY2D2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,WUSURBF2, WUSURBF2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,WVSURBF2, WVSURBF2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,DUDT2,    DUDT2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,DVDT2,    DVDT2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,DIVX2D2,  DIVX2D2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,DIVY2D2,  DIVY2D2TMP)
     CALL ACOLLECT(MYID,MSRID,NPROCS,EMAP,DEDT2,    DEDT2TMP)
     IF(MSR)THEN
       WRITE(IOMOB,'(i6,150(19E13.5,2X))') IINT, &
        (ADVUA2TMP(NO_CELL(I)),  ADVVA2TMP(NO_CELL(I)),&
        ADFX2TMP(NO_CELL(I)),   ADFY2TMP(NO_CELL(I)),& 
        DRX2D2TMP(NO_CELL(I)),  DRY2D2TMP(NO_CELL(I)),&
	CORX2TMP(NO_CELL(I)),   CORY2TMP(NO_CELL(I)),&  
        PSTX2TMP(NO_CELL(I)),   PSTY2TMP(NO_CELL(I)),&
	ADX2D2TMP(NO_CELL(I)),  ADY2D2TMP(NO_CELL(I)),&
        WUSURBF2TMP(NO_CELL(I)),WVSURBF2TMP(NO_CELL(I)),&
	DUDT2TMP(NO_CELL(I)),   DVDT2TMP(NO_CELL(I)),&
	DIVX2D2TMP(NO_CELL(I)), DIVY2D2TMP(NO_CELL(I)),&
	DEDT2TMP(NO_CELL(I)),I=1,NUM_BALANCE)
     END IF
     IF(MSR)THEN
     DEALLOCATE(ADVUA2TMP,  ADVVA2TMP,  ADFX2TMP, ADFY2TMP)  
     DEALLOCATE(DRX2D2TMP,  DRY2D2TMP,  CORX2TMP, CORY2TMP)  
     DEALLOCATE(PSTX2TMP,   PSTY2TMP,   ADX2D2TMP,ADY2D2TMP)  
     DEALLOCATE(WUSURBF2TMP,WVSURBF2TMP,DUDT2TMP, DVDT2TMP)  
     DEALLOCATE(DIVX2D2TMP,DIVY2D2TMP,DEDT2TMP)
     END IF
   END IF
#  endif
   RETURN
 
  END SUBROUTINE OUT_TIMESERIES_BALANCE
!=======================================================================
!
!=======================================================================  
  SUBROUTINE NAME_LIST_INITIALIZE_BALANCE
  USE CONTROL
  
  IMPLICIT NONE

  !--Parameters in NameList NML_BALANCE_2D
  OUT_BALANCE = .FALSE.
  NUM_BALANCE = 0
  NO_CELL     = 1

  RETURN
  END SUBROUTINE NAME_LIST_INITIALIZE_BALANCE
!======================================================================
!
!======================================================================  
  
  SUBROUTINE NAME_LIST_PRINT_BALANCE
  USE CONTROL
  
  IMPLICIT NONE   

  write(UNIT=IPT,NML=NML_BALANCE_2D)

  RETURN
  END SUBROUTINE NAME_LIST_PRINT_BALANCE
!======================================================================
!
!======================================================================  
# endif   
END MODULE  MOD_BALANCE_2D