C $Header: /u/gcmpack/MITgcm/pkg/gmredi/gmredi_init_varia.F,v 1.5 2015/10/14 20:03:59 dfer Exp $
C $Name: $
#include "GMREDI_OPTIONS.h"
CBOP
C !ROUTINE: GMREDI_INIT_VARIA
C !INTERFACE:
SUBROUTINE GMREDI_INIT_VARIA( myThid )
C !DESCRIPTION: \bv
C *==========================================================*
C | SUBROUTINE GMREDI_INIT_VARIA
C | o Routine to initialize GM/Redi variables
C *==========================================================*
C \ev
C !USES:
IMPLICIT NONE
C === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "GMREDI.h"
#include "GMREDI_TAVE.h"
C !INPUT/OUTPUT PARAMETERS:
C === Routine arguments ===
C myThid :: my Thread Id number
INTEGER myThid
CEOP
#ifdef ALLOW_GMREDI
C !LOCAL VARIABLES:
C === Local variables ===
INTEGER i,j,k,bi,bj
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
C Initialize arrays in common blocks :
DO k=1,Nr
DO j=1-Oly,sNy+OLy
DO i=1-Olx,sNx+Olx
Kwx(i,j,k,bi,bj) = 0. _d 0
Kwy(i,j,k,bi,bj) = 0. _d 0
Kwz(i,j,k,bi,bj) = 0. _d 0
#ifdef GM_EXTRA_DIAGONAL
Kuz(i,j,k,bi,bj) = 0. _d 0
Kvz(i,j,k,bi,bj) = 0. _d 0
#endif
#ifdef GM_NON_UNITY_DIAGONAL
Kux(i,j,k,bi,bj) = 0. _d 0
Kvy(i,j,k,bi,bj) = 0. _d 0
#endif
#ifdef GM_BOLUS_ADVEC
GM_PsiX(i,j,k,bi,bj) = 0. _d 0
GM_PsiY(i,j,k,bi,bj) = 0. _d 0
#endif
#ifdef GM_VISBECK_VARIABLE_K
VisbeckK(i,j,bi,bj) = 0. _d 0
#endif
#ifdef GM_K3D
K3D(i,j,k,bi,bj) = 0. _d 0
#endif
ENDDO
ENDDO
ENDDO
#ifdef ALLOW_TIMEAVE
C Initialize averages to zero
CALL TIMEAVE_RESET(GM_Kwx_T,Nr, bi,bj,myThid)
CALL TIMEAVE_RESET(GM_Kwy_T,Nr, bi,bj,myThid)
CALL TIMEAVE_RESET(GM_Kwz_T,Nr, bi,bj,myThid)
GM_timeAve(bi,bj) = 0. _d 0
#ifdef GM_VISBECK_VARIABLE_K
CALL TIMEAVE_RESET(Visbeck_K_T, 1, bi,bj,myThid)
#endif
#ifdef GM_BOLUS_ADVEC
CALL TIMEAVE_RESET(GM_PsiXtave,Nr, bi,bj,myThid)
CALL TIMEAVE_RESET(GM_PsiYtave,Nr, bi,bj,myThid)
#endif
#endif /* ALLOW_TIMEAVE */
C- end bi,bj loops
ENDDO
ENDDO
C-- write GM scaling factors to file:
IF ( GM_iso1dFile .NE. ' ' ) THEN
CALL WRITE_GLVEC_RS( 'GM_isoFac1d', ' ', GM_isoFac1d,
I Nr, -1, myThid )
ENDIF
IF ( GM_bol1dFile .NE. ' ' ) THEN
CALL WRITE_GLVEC_RS( 'GM_bolFac1d', ' ', GM_bolFac1d,
I Nr, -1, myThid )
ENDIF
IF ( GM_iso2dFile .NE. ' ' ) THEN
CALL WRITE_FLD_XY_RS( 'GM_isoFac2d',' ',GM_isoFac2d,-1,myThid )
ENDIF
IF ( GM_bol2dFile .NE. ' ' ) THEN
CALL WRITE_FLD_XY_RS( 'GM_bolFac2d',' ',GM_bolFac2d,-1,myThid )
ENDIF
#endif /* ALLOW_GMREDI */
#ifdef GM_K3D
IF (.NOT.( startTime.EQ.baseTime .AND. nIter0.EQ.0
& .AND. pickupSuff.EQ.' ' )) THEN
IF (GM_useK3D) CALL GMREDI_READ_PICKUP( niter0, myThid )
ENDIF
#endif
#ifdef GM_K3D
C This is put here, but really should be in gmredi_init_fixed.F. The problem is that
C fCori, fCoriCos, etc are not initialized when gmredi_init_fixed.F is called. To be fixed.
C Computing beta = df/dy
IF ( selectCoriMap.EQ.1 ) THEN
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO j=1-Oly,sNy+Oly
DO i=1-Olx,sNx+Olx
gradf(i,j,bi,bj) = beta
ENDDO
ENDDO
ENDDO
ENDDO
ELSEIF ( selectCoriMap.EQ.2 ) THEN
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO j=1-Oly,sNy+Oly
DO i=1-Olx,sNx+Olx
gradf(i,j,bi,bj) = recip_rSphere*fCoriCos(i,j,bi,bj)
ENDDO
ENDDO
ENDDO
ENDDO
ELSE
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO j=1-Oly+1,sNy+Oly-1
DO i=1-Olx+1,sNx+Olx-1
gradf(i,j,bi,bj) = .5 _d 0*angleSinC(i,j,bi,bj)*(
& (fCori(i+1,j,bi,bj)-fCori(i ,j,bi,bj))*recip_dxC(i+1,j,bi,bj)
& +(fCori(i ,j,bi,bj)-fCori(i-1,j,bi,bj))*recip_dxC(i,j,bi,bj) )
& + .5 _d 0*angleCosC(i,j,bi,bj)*(
& (fCori(i,j+1,bi,bj)-fCori(i,j ,bi,bj))*recip_dyC(i,j+1,bi,bj)
& +(fCori(i,j ,bi,bj)-fCori(i,j-1,bi,bj))*recip_dyC(i,j,bi,bj) )
gradf(i,j,bi,bj)=max(1. _d -18, gradf(i,j,bi,bj) )
ENDDO
ENDDO
ENDDO
ENDDO
ENDIF
CALL EXCH_XY_RL( gradf, myThid)
#endif
RETURN
END