#include "CPP_OPTIONS.h"

      SUBROUTINE SRDIAGS_F77_INIT( myThid )

C     == Global declarations ==
      USE SRDIAGS
      IMPLICIT NONE

#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "SRDIAG.h"

C     == Routine arguments ==
      INTEGER myThid

C     == Local variables ==
      CHARACTER*512 srFnamePref
      REAL*8        ap
      TYPE(SRDIAG_SPEC), POINTER :: diagVar
      INTEGER I, J
      INTEGER iG, jG, bi, bj

      CALL SRDIAG_INIT( myThid )

C     Sub-region 1, 4 hourly averaged diagnostic field
C     Sub-region 2, 12 hourly averaged open boundary fields for rerun
      DO I=1, 2
       WRITE( srFnamePref, '(A,I4.4,A,I6.6)' )
     & 'srdiag.',I,'.',myProcId
       IF ( I .EQ. 1 ) THEN
        ap = 3600. _d 0 * 4. _d 0
        ap = 3600. _d 0 * 24. _d 0 * 2. _d 0
       ENDIF
       IF ( I .EQ. 2 ) THEN
        ap = 3600. _d 0 * 12. _d 0
        ap = 3600. _d 0 * 24. _d 0 * 5. _d 0
       ENDIF
       IF ( I.EQ.1) THEN
        CALL SRDIAG_CREATE( dv1, ap, srFnamePref, myThid )
       ENDIF
       IF ( I.EQ.2) THEN
        CALL SRDIAG_CREATE( dv2, ap, srFnamePref, myThid )
       ENDIF
      ENDDO
C
C     Add regions 
C     sr 1
      diagVar => dv1
      DO bj=myByLo(myThid),myByHi(myThid)
       DO bi=myBxLo(myThid),myBxHi(myThid)
C--     "Global" index (place holder)
        jG = myYGlobalLo + (bj-1)*sNy
        iG = myXGlobalLo + (bi-1)*sNx
C--     North Atlantic
        CALL SRDIAG_ADD_REGION( 
     I                          iG,  jG,  1,
     I                         sNx, sNy, Nr,
     I                          65,  18,  1,
     I                          26,  20, 10,
     U                              diagVar, 
     I                         myThid )
        CALL SRDIAG_ADD_REGION( 
     I                          iG,  jG,  1,
     I                         sNx, sNy, Nr,
     I                           1,  18,  1,
     I                           6,  20, 10,
     U                              diagVar, 
     I                         myThid )
C--     Hawaii
        CALL SRDIAG_ADD_REGION( 
     I                          iG,  jG,  1,
     I                         sNx, sNy, Nr,
     I                          46,  20,  1,
     I                           6,   6, 10,
     U                              diagVar, 
     I                         myThid )
C--     Kuroishio
        CALL SRDIAG_ADD_REGION( 
     I                          iG,  jG,  1,
     I                         sNx, sNy, Nr,
     I                          32,  22,  1,
     I                          10,   6, 10,
     U                              diagVar, 
     I                         myThid )
C--     Drake passage
        CALL SRDIAG_ADD_REGION( 
     I                          iG,  jG,  1,
     I                         sNx, sNy, Nr,
     I                          60,   3,  1,
     I                          23,   7, 10,
     U                              diagVar, 
     I                         myThid )
C--     North Atlantic
C8        CALL SRDIAG_ADD_REGION(
C8     I                          iG,  jG,  1,
C8     I                         sNx, sNy, Nr,
C8     I                        2080, 890,  1,
C8     I                         801, 771, 17,
C8     U                              diagVar,
C8     I                         myThid )
C8        CALL SRDIAG_ADD_REGION(
C8     I                          iG,  jG,  1,
C8     I                         sNx, sNy, Nr,
C8     I                           1, 890,  1,
C8     I                         140, 771, 17,
C8     U                              diagVar,
C8     I                         myThid )
C--     Hawaii
C8        CALL SRDIAG_ADD_REGION(
C8     I                          iG,  jG,  1,
C8     I                         sNx, sNy, Nr,
C8     I                        1540,1140,  1,
C8     I                         161, 171, 17,
C8     U                              diagVar,
C8     I                         myThid )
C--     Kuroishio
C8        CALL SRDIAG_ADD_REGION(
C8     I                          iG,  jG,  1,
C8     I                         sNx, sNy, Nr,
C8     I                        1000,1250,  1,
C8     I                         401, 251, 17,
C8     U                              diagVar,
C8     I                         myThid )
C--     Drake passage
C8        CALL SRDIAG_ADD_REGION(
C8     I                          iG,  jG,  1,
C8     I                         sNx, sNy, Nr,
C8     I                        1900, 300,  1,
C8     I                         701, 251, 17,
C8     U                              diagVar,
C8     I                         myThid )
       ENDDO
      ENDDO
C     sr 2
      diagVar => dv2
C     full depth slice every ten cells
      DO bj=myByLo(myThid),myByHi(myThid)
       DO bi=myBxLo(myThid),myBxHi(myThid)
C--     "Global" index (place holder)
        jG = myYGlobalLo + (bj-1)*sNy
        iG = myXGlobalLo + (bi-1)*sNx
C--     constant I lines
        DO I=iG,iG+sNx-1
         IF ( INT(I/10)*10 .EQ. I ) THEN
           CALL SRDIAG_ADD_REGION( 
     I                          iG,        jG,  1,
     I                         sNx,       sNy, Nr,
     I                           I,        jG,  1,
     I                           1,       sNy, Nr,
     U                              diagVar, 
     I                         myThid )
         ENDIF
        ENDDO
C--     constant J lines
        DO J=jG,jG+sNy-1
         IF ( INT(J/10)*10 .EQ. J ) THEN
           CALL SRDIAG_ADD_REGION( 
     I                          iG,        jG,  1,
     I                         sNx,       sNy, Nr,
     I                          iG,         J,  1,
     I                          sNx,        1, Nr,
     U                              diagVar, 
     I                         myThid )
         ENDIF
        ENDDO
       ENDDO
      ENDDO

      RETURN
      END

      SUBROUTINE SRDIAGS_F77_ADDCODES( myThid )

C     == Global declarations ==
      USE SRDIAGS
      IMPLICIT NONE

#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "PARAMS.h"
#include "SRDIAG.h"

C     == Routine arguments ==
      INTEGER myThid

C     == Local variables ==
      CHARACTER*512 fCode
      INTEGER bi, bj, iG, jG
      TYPE(SRDIAG_SPEC), POINTER :: diagVar
      INTEGER I

      DO I=1, 2
       IF ( I.EQ. 1 ) THEN
        diagVar => dv1
       ENDIF
       IF ( I.EQ. 2 ) THEN
        diagVar => dv2
       ENDIF
       DO bj=myByLo(myThid),myByHi(myThid)
        DO bi=myBxLo(myThid),myBxHi(myThid)

         WRITE( fCode, '(A,I4.4,A,I4.4)' ) 'ETAN:',bi,':',bj
         jG = myYGlobalLo + (bj-1)*sNy
         iG = myXGlobalLo + (bi-1)*sNx
         CALL SRDIAG_ADD_FCODE(fCode, (/iG-1, jG-1, 0/),
     I                         'XYZ',diagVar, deltatClock, myThid )

         WRITE( fCode, '(A,I4.4,A,I4.4)' ) 'UVEL:',bi,':',bj
         jG = myYGlobalLo + (bj-1)*sNy
         iG = myXGlobalLo + (bi-1)*sNx
         CALL SRDIAG_ADD_FCODE(fCode, (/iG-1, jG-1, 0/),
     I                         'XYZ',diagVar, deltatClock, myThid )

         WRITE( fCode, '(A,I4.4,A,I4.4)' ) 'VVEL:',bi,':',bj
         jG = myYGlobalLo + (bj-1)*sNy
         iG = myXGlobalLo + (bi-1)*sNx
         CALL SRDIAG_ADD_FCODE(fCode, (/iG-1, jG-1, 0/),
     I                         'XYZ',diagVar, deltatClock, myThid )

         WRITE( fCode, '(A,I4.4,A,I4.4)' ) 'WVEL:',bi,':',bj
         jG = myYGlobalLo + (bj-1)*sNy
         iG = myXGlobalLo + (bi-1)*sNx
         CALL SRDIAG_ADD_FCODE(fCode, (/iG-1, jG-1, 0/),
     I                         'XYZ',diagVar, deltatClock, myThid )

         WRITE( fCode, '(A,I4.4,A,I4.4)' ) 'SALTanom:',bi,':',bj
         jG = myYGlobalLo + (bj-1)*sNy
         iG = myXGlobalLo + (bi-1)*sNx
         CALL SRDIAG_ADD_FCODE(fCode, (/iG-1, jG-1, 0/),
     I                         'XYZ',diagVar, deltatClock, myThid )

         WRITE( fCode, '(A,I4.4,A,I4.4)' ) 'SALT:',bi,':',bj
         jG = myYGlobalLo + (bj-1)*sNy
         iG = myXGlobalLo + (bi-1)*sNx
         CALL SRDIAG_ADD_FCODE(fCode, (/iG-1, jG-1, 0/),
     I                         'XYZ',diagVar, deltatClock, myThid )

         WRITE( fCode, '(A,I4.4,A,I4.4)' ) 'THETA:',bi,':',bj
         jG = myYGlobalLo + (bj-1)*sNy
         iG = myXGlobalLo + (bi-1)*sNx
         CALL SRDIAG_ADD_FCODE(fCode, (/iG-1, jG-1, 0/),
     I                         'XYZ',diagVar, deltatClock, myThid )

         WRITE( fCode, '(A,I4.4,A,I4.4)' ) 'WVELMASS:',bi,':',bj
         jG = myYGlobalLo + (bj-1)*sNy
         iG = myXGlobalLo + (bi-1)*sNx
         CALL SRDIAG_ADD_FCODE(fCode, (/iG-1, jG-1, 0/),
     I                         'XYZ',diagVar, deltatClock, myThid )

         WRITE( fCode, '(A,I4.4,A,I4.4)' ) 'RHOAnoma:',bi,':',bj
         jG = myYGlobalLo + (bj-1)*sNy
         iG = myXGlobalLo + (bi-1)*sNx
         CALL SRDIAG_ADD_FCODE(fCode, (/iG-1, jG-1, 0/),
     I                         'XYZ',diagVar, deltatClock, myThid )

        ENDDO
       ENDDO
      ENDDO

      RETURN
      END

!         CALL SRDIAGS_F77_FILL( charDiag,
!    I          inpFld, iFldParms, biArg, bjArg,
!    I          myThid)

      SUBROUTINE SRDIAGS_F77_FILL( fName, 
     I            inpFld, iFldParms, biArg, bjArg,
     I            myThid )

C     == Global declarations ==
      USE SRDIAGS
      IMPLICIT NONE

#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "DYNVARS.h"
#include "SRDIAG.h"

C     == Routine arguments ==
      CHARACTER*8 fName
      _RL     inpFld(*)
      INTEGER iFldParms(8)
      INTEGER biArg
      INTEGER bjArg
      INTEGER myThid

C     == Local variables ==
      REAL*8, POINTER ::   srBuf(  :,:,:,:,:)
      REAL*8, POINTER ::   srTemp( :,:,:)
      REAL*8, POINTER ::   tempBuf(:,:,:,:,:)
      INTEGER iLo, iHi, jLo, jHi, srK, biLo, biHi, bjLo, bjHi
      INTEGER kLev, mynR, mynTx, mynTy
      INTEGER iLoInp, iHiInp, jLoInp, jHiInp, srKLo, srKHi
      INTEGER I,J,K,bi,bj,iB

      CHARACTER*512 fCode
      TYPE(SRDIAG_SPEC), POINTER :: diagVar

!     PRINT *, 'SRDIAGS_FILE fName ', fName
!     PRINT *, ' iLo, iHi, jLo, jHi', 
!    &  iFldParms(1), iFldParms(2), iFldParms(3), iFldParms(4)
!     PRINT *, ' nR, kLev          ', iFldParms(5), iFldParms(8)
!     PRINT *, ' nTx, nTy          ', iFldParms(6), iFldParms(7)
!     PRINT *, ' biArg, bjArg      ', biArg, bjArg

C     Figure out dimensions of buffer to use
C     Horiz extents
      iLo = 1
      iHi = sNx
      jLo = 1
      jHi = sNy
      iLoInp = iFldParms(1)
      iHiInp = iFldParms(2)
      jLoInp = iFldParms(3)
      jHiInp = iFldParms(4)
C     Vertical
      kLev = iFldParms(8)
      mynR = iFldParms(5)
      IF ( kLev .EQ. 0 ) THEN
C      All levels have been given
       srKLo = 1
       srKHi = mynR
      ENDIF
      IF ( kLev .GT. 0 ) THEN
C      A specific level has been given
       srKLo = kLev
       srKHi = kLev
      ENDIF
      mynTx = iFldParms(6)
      mynTy = iFldParms(7)
C     The lines below do not work for multi-threaded decomposition
C     For multi-threaded decomp. biLo would not be 1, with the
C     values from myBiLo etc...
      IF ( mynTx .GT. 1 .OR. mynTy .GT. 1 ) THEN
C      We have multiple tiles passed in.
       biLo=1
       biHi=mynTx
       bjLo=1
       bjHi=mynTy
      ELSE
C      We have one tile passed in.
       biLo=biArg
       biHi=biArg
       bjLo=bjArg
       bjHi=bjArg
      ENDIF
     
      ALLOCATE( srBuf(iLo:iHi,jLo:jHi,srKLo:srKHi,biLo:biHi,bjLo:bjHi) )
!     ALLOCATE( srTemp(iLo:iHi,jLo:jHi,srKLo:srKHi)                    )

!     Unravel inpFld
      ALLOCATE( 
     & tempBuf(iLoInp:iHiInp,jLoInp:jHiInp,
     &         srKLo:srKHi,biLo:biHi,bjLo:bjHi) 
     &)
      iB = 0
      DO bj=bjLo,bjHi
       DO bi=biLo,biHi
        DO K=srKLo,srKHi
         DO J=jLoInp,jHiInp
          DO I=iLoInp,iHiInp
           iB = iB+1
           tempBuf(I,J,K,bi,bj)=inpFld(iB)
          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ENDDO
!     IF ( fName .EQ. 'ETAN' ) THEN
!      PRINT *, ' bjLo, bjHi, biLo, biHi ', bjLo, bjHi, biLo, biHi
!      PRINT *, ' srKlo, srKHi ', srKLo, srKHi
!     ENDIF

!     Extract the part we are interested in
!     ALLOCATE( srTemp(iLo:iHi,jLo:jHi,srKLo:srKHi)                    )
      srBuf = 
     & tempBuf(iLo:iHi,jLo:jHi,srKLo:srKHi,biLo:biHi,bjLo:bjHi)
      DEALLOCATE(tempBuf)

!     Push output to srdiags buffers
      ALLOCATE( srTemp(iLo:iHi,jLo:jHi,srKLo:srKHi)                    )
      DO bj=bjLo,bjHi
       DO bi=biLo,biHi
        srTemp = srBuf(:,:,:,bi,bj)
!       IF ( fName .EQ. 'ETAN' ) THEN
         diagVar => dv1
         WRITE( fCode, '(A,A,I4.4,A,I4.4)' ) TRIM(fName),':',bi,':',bj
         CALL SRDIAG_FILL( srTemp, 1.d0, fCode, diagVar, myThid )
         diagVar => dv2
         WRITE( fCode, '(A,A,I4.4,A,I4.4)' ) TRIM(fName),':',bi,':',bj
         CALL SRDIAG_FILL( srTemp, 1.d0, fCode, diagVar, myThid )
!       ENDIF
       ENDDO
      ENDDO

      DEALLOCATE(srTemp )
      DEALLOCATE(srBuf  )


      RETURN
      END

      SUBROUTINE SRDIAGS_F77_SAVEFIELDS( myTime, myIter, myThid )

C     == Global declarations ==
      USE SRDIAGS
      IMPLICIT NONE

#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "PARAMS.h"
#include "DYNVARS.h"
#include "SRDIAG.h"
      LOGICAL  DIFFERENT_MULTIPLE
      EXTERNAL DIFFERENT_MULTIPLE

C     == Routine arguments ==
      INTEGER myThid
      _RL     myTime
      INTEGER myIter

C     == Local variables ==
      CHARACTER*512 fCode
      REAL*8 tmpFldXYZ(1:sNx,1:sNy,Nr)
      REAL*8 tmpFldXY(1:sNx,1:sNy,1)
      INTEGER bi, bj, iG, jG
      TYPE(SRDIAG_SPEC), POINTER :: diagVar
      INTEGER I

!     DO I=1, 2
!      IF ( I .EQ. 1 ) THEN
!       diagVar => dv1
!      ENDIF
!      IF ( I .EQ. 2 ) THEN
!       diagVar => dv2
!      ENDIF
!      DO bj=myByLo(myThid),myByHi(myThid)
!       DO bi=myBxLo(myThid),myBxHi(myThid)
!        WRITE( fCode, '(A,I4.4,A,I4.4)' ) 'U:',bi,':',bj
!        tmpFldXYZ = uVel(1:sNx,1:sNy,:,bi,bj)
!        CALL SRDIAG_FILL( tmpFldXYZ, 1.d0, fCode, diagVar, myThid )
!       ENDDO
!      ENDDO
!      DO bj=myByLo(myThid),myByHi(myThid)
!       DO bi=myBxLo(myThid),myBxHi(myThid)
!        WRITE( fCode, '(A,I4.4,A,I4.4)' ) 'etan:',bi,':',bj
!        tmpFldXY(:,:,1) = etan(1:sNx,1:sNy,bi,bj)
!        CALL SRDIAG_FILL( tmpFldXY, 1.d0, fCode, diagVar, myThid )
!       ENDDO
!      ENDDO
!     ENDDO

C     Write to disk if need be
      diagVar => dv1
      IF ( DIFFERENT_MULTIPLE( diagVar%aPeriod, myTime, deltaTClock ) ) THEN
       CALL SRDIAG_STORE( diagVar, myTime, myThid )
      ENDIF

      diagVar => dv2
      IF ( DIFFERENT_MULTIPLE( diagVar%aPeriod, myTime, deltaTClock ) ) THEN
       CALL SRDIAG_STORE( diagVar, myTime, myThid )
      ENDIF

C     STOP

      RETURN
      END

      SUBROUTINE SRDIAGS_F77_OUTPUT( myThid )

C     == Global declarations ==
      USE SRDIAGS
      IMPLICIT NONE

#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "SRDIAG.h"

C     == Routine arguments ==
      INTEGER myThid

C     == Local variables ==
      INTEGER I
      REAL*8 curTime
      TYPE(SRDIAG_SPEC), POINTER :: diagVar

      curTime = 0.
      DO I=1, 2
       IF ( I .EQ. 1 ) THEN
        diagVar => dv1
       ENDIF
       IF ( I .EQ. 2 ) THEN
        diagVar => dv2
       ENDIF
       CALL SRDIAG_STORE( diagVar, curTime, myThid )
      ENDDO

      RETURN
      END