model/src/ini_cori.F

C $Header: /u/u3/gcmpack/MITgcm/model/src/ini_cori.F,v 1.15 2002/12/02 16:04:22 adcroft Exp $
C $Name:  $

#include "CPP_OPTIONS.h"

CBOP
C     !ROUTINE: INI_CORI
C     !INTERFACE:
      SUBROUTINE INI_CORI( myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE INI_CORI                                       
C     | o Initialise coriolis term.                               
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     myThid -  Number of this instance of INI_CORI
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     bi,bj  - Loop counters
C     I,J,K
C     facGrid - Factor for grid to meter conversion
      INTEGER bi, bj
      INTEGER  I,  J, K
      _RL facGrid
CEOP

C--   Initialise coriolis parameter
      IF     ( useConstantF ) THEN
C      o Constant F case
       DO bj = myByLo(myThid), myByHi(myThid)
        DO bi = myBxLo(myThid), myBxHi(myThid)
         DO K=1,Nr
          DO J=1-Oly,sNy+Oly
           DO I=1-Olx,sNx+Olx
            fCori(i,j,bi,bj)=f0
            fCoriG(i,j,bi,bj)=f0
            fCoriCos(i,j,bi,bj)=0.
           ENDDO
          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ELSEIF ( useBetaPlaneF ) THEN
C      o Beta plane case
       facGrid = 1. _d 0
       IF ( usingSphericalPolarGrid ) facGrid = deg2rad*rSphere
       DO bj = myByLo(myThid), myByHi(myThid)
        DO bi = myBxLo(myThid), myBxHi(myThid)
         DO K=1,Nr
          DO J=1-Oly,sNy+Oly
           DO I=1-Olx,sNx+Olx
            fCori(i,j,bi,bj)=f0+beta*_yC(i,j,bi,bj)*facGrid
            fCoriG(i,j,bi,bj)=f0+beta*yG(i,j,bi,bj)*facGrid
            fCoriCos(i,j,bi,bj)=0.
           ENDDO
          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ELSEIF ( useSphereF ) THEN
C      o Spherical case
C        Note in this case we assume yC is in degrees.
       DO bj = myByLo(myThid), myByHi(myThid)
        DO bi = myBxLo(myThid), myBxHi(myThid)
         DO K=1,Nr
          DO J=1-Oly,sNy+Oly
           DO I=1-Olx,sNx+Olx
            fCori(i,j,bi,bj)=
     &       2. _d 0*omega*sin(_yC(i,j,bi,bj)*deg2rad)
            fCoriG(i,j,bi,bj)=
     &       2. _d 0*omega*sin(yG(i,j,bi,bj)*deg2rad)
            fCoriCos(i,j,bi,bj)=
     &       2. _d 0*omega*cos(_yC(i,j,bi,bj)*deg2rad)
           ENDDO
          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ELSE
C      o Special custom form
       DO bj = myByLo(myThid), myByHi(myThid)
        DO bi = myBxLo(myThid), myBxHi(myThid)
         DO K=1,Nr
          DO J=1-Oly,sNy+Oly
           DO I=1-Olx,sNx+Olx
            fCori(i,j,bi,bj)=0.
            fCoriG(i,j,bi,bj)=0.
            fCoriCos(i,j,bi,bj)=0.
           ENDDO
          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ENDIF
C
c     _EXCH_XY_R4(fCori,myThid)
c     CALL EXCH_Z_XY_RS(fCoriG,myThid)
c     _EXCH_XY_R4(fCoriCos,myThid)

#ifdef ALLOW_MONITOR
      CALL MON_PRINTSTATS_RS(1,fCori,'fCori',myThid)
      CALL MON_PRINTSTATS_RS(1,fCoriG,'fCoriG',myThid)
      CALL MON_PRINTSTATS_RS(1,fCoriCos,'fCoriCos',myThid)
#endif

      RETURN
      END
1	edhill	1.16	C $Header: /u/u3/gcmpack/MITgcm/model/src/ini_cori.F,v 1.15 2002/12/02 16:04:22 adcroft Exp $
2	adcroft	1.10	C $Name: $
3	cnh	1.1
4	cnh	1.6	#include "CPP_OPTIONS.h"
5	cnh	1.1
6	cnh	1.12	CBOP
7			C !ROUTINE: INI_CORI
8			C !INTERFACE:
9	cnh	1.1	SUBROUTINE INI_CORI( myThid )
10	cnh	1.12	C !DESCRIPTION: \bv
11			C ==========================================================
12			C \| SUBROUTINE INI_CORI
13			C \| o Initialise coriolis term.
14			C ==========================================================
15			C \ev
16
17			C !USES:
18	adcroft	1.7	IMPLICIT NONE
19	cnh	1.12	C == Global variables ==
20	cnh	1.1	#include "SIZE.h"
21			#include "EEPARAMS.h"
22			#include "PARAMS.h"
23			#include "GRID.h"
24			#include "DYNVARS.h"
25
26	cnh	1.12	C !INPUT/OUTPUT PARAMETERS:
27	cnh	1.1	C == Routine arguments ==
28			C myThid - Number of this instance of INI_CORI
29			INTEGER myThid
30
31	cnh	1.12	C !LOCAL VARIABLES:
32	cnh	1.1	C == Local variables ==
33			C bi,bj - Loop counters
34			C I,J,K
35			C facGrid - Factor for grid to meter conversion
36			INTEGER bi, bj
37			INTEGER I, J, K
38			_RL facGrid
39	cnh	1.12	CEOP
40	cnh	1.1
41	cnh	1.3	C-- Initialise coriolis parameter
42			IF ( useConstantF ) THEN
43			C o Constant F case
44			DO bj = myByLo(myThid), myByHi(myThid)
45			DO bi = myBxLo(myThid), myBxHi(myThid)
46	cnh	1.4	DO K=1,Nr
47	adcroft	1.10	DO J=1-Oly,sNy+Oly
48			DO I=1-Olx,sNx+Olx
49	cnh	1.3	fCori(i,j,bi,bj)=f0
50	adcroft	1.10	fCoriG(i,j,bi,bj)=f0
51	adcroft	1.14	fCoriCos(i,j,bi,bj)=0.
52	cnh	1.3	ENDDO
53	cnh	1.1	ENDDO
54			ENDDO
55			ENDDO
56			ENDDO
57	cnh	1.3	ELSEIF ( useBetaPlaneF ) THEN
58			C o Beta plane case
59			facGrid = 1. _d 0
60			IF ( usingSphericalPolarGrid ) facGrid = deg2rad*rSphere
61			DO bj = myByLo(myThid), myByHi(myThid)
62			DO bi = myBxLo(myThid), myBxHi(myThid)
63	cnh	1.4	DO K=1,Nr
64	adcroft	1.10	DO J=1-Oly,sNy+Oly
65			DO I=1-Olx,sNx+Olx
66	cnh	1.3	fCori(i,j,bi,bj)=f0+beta_yC(i,j,bi,bj)facGrid
67	adcroft	1.10	fCoriG(i,j,bi,bj)=f0+betayG(i,j,bi,bj)facGrid
68	adcroft	1.14	fCoriCos(i,j,bi,bj)=0.
69	cnh	1.3	ENDDO
70			ENDDO
71			ENDDO
72			ENDDO
73			ENDDO
74			ELSEIF ( useSphereF ) THEN
75			C o Spherical case
76			C Note in this case we assume yC is in degrees.
77			DO bj = myByLo(myThid), myByHi(myThid)
78			DO bi = myBxLo(myThid), myBxHi(myThid)
79	cnh	1.4	DO K=1,Nr
80	adcroft	1.10	DO J=1-Oly,sNy+Oly
81			DO I=1-Olx,sNx+Olx
82	cnh	1.5	fCori(i,j,bi,bj)=
83			& 2. _d 0omegasin(_yC(i,j,bi,bj)*deg2rad)
84	adcroft	1.10	fCoriG(i,j,bi,bj)=
85			& 2. _d 0omegasin(yG(i,j,bi,bj)*deg2rad)
86	adcroft	1.14	fCoriCos(i,j,bi,bj)=
87			& 2. _d 0omegacos(_yC(i,j,bi,bj)*deg2rad)
88	cnh	1.3	ENDDO
89			ENDDO
90			ENDDO
91			ENDDO
92			ENDDO
93			ELSE
94			C o Special custom form
95			DO bj = myByLo(myThid), myByHi(myThid)
96			DO bi = myBxLo(myThid), myBxHi(myThid)
97	cnh	1.4	DO K=1,Nr
98	adcroft	1.10	DO J=1-Oly,sNy+Oly
99			DO I=1-Olx,sNx+Olx
100	cnh	1.3	fCori(i,j,bi,bj)=0.
101	adcroft	1.10	fCoriG(i,j,bi,bj)=0.
102	adcroft	1.14	fCoriCos(i,j,bi,bj)=0.
103	cnh	1.3	ENDDO
104			ENDDO
105			ENDDO
106			ENDDO
107			ENDDO
108			ENDIF
109	cnh	1.1	C
110	adcroft	1.10	c _EXCH_XY_R4(fCori,myThid)
111			c CALL EXCH_Z_XY_RS(fCoriG,myThid)
112	adcroft	1.15	c _EXCH_XY_R4(fCoriCos,myThid)
113	adcroft	1.11
114	edhill	1.16	#ifdef ALLOW_MONITOR
115	adcroft	1.11	CALL MON_PRINTSTATS_RS(1,fCori,'fCori',myThid)
116			CALL MON_PRINTSTATS_RS(1,fCoriG,'fCoriG',myThid)
117	adcroft	1.15	CALL MON_PRINTSTATS_RS(1,fCoriCos,'fCoriCos',myThid)
118	heimbach	1.13	#endif
119	cnh	1.1
120			RETURN
121			END