model/src/ini_cori.F

C $Header: /u/gcmpack/MITgcm/model/src/ini_cori.F,v 1.24 2006/08/27 23:27:25 jmc Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_OPTIONS.h"

CBOP
C     !ROUTINE: INI_CORI

C     !INTERFACE:
      SUBROUTINE INI_CORI( myThid )
C     !DESCRIPTION:
C     Initialise coriolis term.

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#ifndef ALLOW_AUTODIFF_TAMC
# include "EESUPPORT.h"
#endif
#include "PARAMS.h"
#include "GRID.h"
#ifdef ALLOW_MNC
#include "MNC_PARAMS.h"
#endif
#ifdef ALLOW_MONITOR
#include "MONITOR.h"
#endif

C     !INPUT/OUTPUT PARAMETERS:
      INTEGER myThid
CEOP

C     !LOCAL VARIABLES:
C     bi,bj   :: Tile Indices counters
C     i, j    :: Loop counters
C     facGrid :: Factor for grid to meter conversion
      INTEGER bi,bj
      INTEGER i, j
      _RL facGrid

C     Initialise coriolis parameter
      IF     ( useConstantF ) THEN
C       Constant F case
        DO bj = myByLo(myThid), myByHi(myThid)
          DO bi = myBxLo(myThid), myBxHi(myThid)
            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. _d 0
              ENDDO
            ENDDO
          ENDDO
        ENDDO
      ELSEIF ( useBetaPlaneF ) THEN
C       Beta plane case
        facGrid = 1. _d 0
        IF ( usingSphericalPolarGrid
     &     .OR. usingCurvilinearGrid ) facGrid = deg2rad*rSphere
        DO bj = myByLo(myThid), myByHi(myThid)
          DO bi = myBxLo(myThid), myBxHi(myThid)
            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. _d 0
              ENDDO
            ENDDO
          ENDDO
        ENDDO
      ELSEIF ( useSphereF ) THEN
C       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 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
c       CALL WRITE_FLD_XY_RL('fCoriC',' ',fCori ,  0,myThid)
c       CALL WRITE_FLD_XY_RL('fCoriG',' ',fCoriG , 0,myThid)
c       CALL WRITE_FLD_XY_RL('fCorCs',' ',fCoriCos,0,myThid)
      ELSE
C       Special custom form
        DO bj = myByLo(myThid), myByHi(myThid)
          DO bi = myBxLo(myThid), myBxHi(myThid)
            DO j=1-Oly,sNy+Oly
              DO i=1-Olx,sNx+Olx
                fCori(i,j,bi,bj)  = 0. _d 0
                fCoriG(i,j,bi,bj) = 0. _d 0
                fCoriCos(i,j,bi,bj)=0. _d 0
              ENDDO
            ENDDO
          ENDDO
        ENDDO
        CALL READ_REC_XY_RS( 'fCoriC.bin', fCori,   1, 0, myThid )
        CALL READ_REC_XY_RS( 'fCoriG.bin', fCoriG,  1, 0, myThid )
        CALL READ_REC_XY_RS( 'fCorCs.bin', fCoriCos,1, 0, myThid )
        IF ( useCubedSphereExchange ) THEN
C-       deal with the 2 missing corners (for fCoriG):
         DO bj = myByLo(myThid), myByHi(myThid)
          DO bi = myBxLo(myThid), myBxHi(myThid)
C-  Notes: this will only works with 6 tiles (1 per face) and
C    with 2 polar faces + 4 equatorials:
           IF (bi.LE.3 .OR. bi.GE.5) THEN
             fCoriG(sNx+1,1,bi,bj) = fCoriG(1,1,bi,bj)
           ELSE
             fCoriG(sNx+1,1,bi,bj) = -fCoriG(1,1,bi,bj)
           ENDIF
           IF (bi.GE.3) THEN
             fCoriG(1,sNy+1,bi,bj) = fCoriG(1,1,bi,bj)
             fCoriG(sNx+1,sNy+1,bi,bj) = fCoriG(sNx+1,1,bi,bj)
           ELSE
             fCoriG(1,sNy+1,bi,bj) = -fCoriG(1,1,bi,bj)
             fCoriG(sNx+1,sNy+1,bi,bj) = -fCoriG(sNx+1,1,bi,bj)
           ENDIF
          ENDDO
         ENDDO
        ENDIF

        CALL EXCH_XY_RS( fCori, myThid )
        CALL EXCH_XY_RS( fCoriCos, myThid )
c       CALL EXCH_Z_XY_RS( fCoriG, myThid )
        CALL EXCH_Z_3D_RS( fCoriG, 1, myThid )
      ENDIF

#ifndef ALLOW_AUTODIFF_TAMC
#ifdef ALLOW_MONITOR
#ifdef ALLOW_USE_MPI
      IF ( .NOT.useSingleCPUIO .OR. mpiMyId.EQ.0 ) THEN
#endif /* ALLOW_USE_MPI */
        _BEGIN_MASTER(myThid)
C--   only the master thread is allowed to switch On/Off mon_write_stdout
C     & mon_write_mnc (since it's the only thread that uses those flags):

        IF (monitor_stdio) THEN
          mon_write_stdout = .TRUE.
        ELSE
          mon_write_stdout = .FALSE.
        ENDIF
        mon_write_mnc = .FALSE.
#ifdef ALLOW_MNC
        IF (useMNC .AND. monitor_mnc) THEN
          DO i = 1,MAX_LEN_MBUF
            mon_fname(i:i) = ' '
          ENDDO
          mon_fname(1:12) = 'monitor_grid'
          CALL MNC_CW_SET_UDIM(mon_fname, 1, myThid)
          mon_write_mnc = .TRUE.
        ENDIF
#endif /*  ALLOW_MNC  */

        _END_MASTER(myThid)
#ifdef ALLOW_USE_MPI
      ENDIF
#endif /* ALLOW_USE_MPI */

      CALL MON_PRINTSTATS_RS(1,fCori,'fCori',myThid)
      CALL MON_PRINTSTATS_RS(1,fCoriG,'fCoriG',myThid)
      CALL MON_PRINTSTATS_RS(1,fCoriCos,'fCoriCos',myThid)

#ifdef ALLOW_USE_MPI
      IF ( .NOT.useSingleCPUIO .OR. mpiMyId.EQ.0 ) THEN
#endif /* ALLOW_USE_MPI */
        _BEGIN_MASTER(myThid)

        mon_write_stdout = .FALSE.
        mon_write_mnc    = .FALSE.

        _END_MASTER(myThid)
#ifdef ALLOW_USE_MPI
      ENDIF
#endif /* ALLOW_USE_MPI */
#endif /* ALLOW_MONITOR */
#endif /* ALLOW_AUTODIFF_TAMC */

      RETURN
      END
1	C $Header: /u/gcmpack/MITgcm/model/src/ini_cori.F,v 1.24 2006/08/27 23:27:25 jmc Exp $
2	C $Name: $
3
4	#include "PACKAGES_CONFIG.h"
5	#include "CPP_OPTIONS.h"
6
7	CBOP
8	C !ROUTINE: INI_CORI
9
10	C !INTERFACE:
11	SUBROUTINE INI_CORI( myThid )
12	C !DESCRIPTION:
13	C Initialise coriolis term.
14
15	C !USES:
16	IMPLICIT NONE
17	#include "SIZE.h"
18	#include "EEPARAMS.h"
19	#ifndef ALLOW_AUTODIFF_TAMC
20	# include "EESUPPORT.h"
21	#endif
22	#include "PARAMS.h"
23	#include "GRID.h"
24	#ifdef ALLOW_MNC
25	#include "MNC_PARAMS.h"
26	#endif
27	#ifdef ALLOW_MONITOR
28	#include "MONITOR.h"
29	#endif
30
31	C !INPUT/OUTPUT PARAMETERS:
32	INTEGER myThid
33	CEOP
34
35	C !LOCAL VARIABLES:
36	C bi,bj :: Tile Indices counters
37	C i, j :: Loop counters
38	C facGrid :: Factor for grid to meter conversion
39	INTEGER bi,bj
40	INTEGER i, j
41	_RL facGrid
42
43	C Initialise coriolis parameter
44	IF ( useConstantF ) THEN
45	C Constant F case
46	DO bj = myByLo(myThid), myByHi(myThid)
47	DO bi = myBxLo(myThid), myBxHi(myThid)
48	DO j=1-Oly,sNy+Oly
49	DO i=1-Olx,sNx+Olx
50	fCori(i,j,bi,bj) = f0
51	fCoriG(i,j,bi,bj) = f0
52	fCoriCos(i,j,bi,bj)=0. _d 0
53	ENDDO
54	ENDDO
55	ENDDO
56	ENDDO
57	ELSEIF ( useBetaPlaneF ) THEN
58	C Beta plane case
59	facGrid = 1. _d 0
60	IF ( usingSphericalPolarGrid
61	& .OR. usingCurvilinearGrid ) facGrid = deg2rad*rSphere
62	DO bj = myByLo(myThid), myByHi(myThid)
63	DO bi = myBxLo(myThid), myBxHi(myThid)
64	DO j=1-Oly,sNy+Oly
65	DO i=1-Olx,sNx+Olx
66	fCori(i,j,bi,bj) = f0+beta_yC(i,j,bi,bj)facGrid
67	fCoriG(i,j,bi,bj) = f0+beta* yG(i,j,bi,bj)*facGrid
68	fCoriCos(i,j,bi,bj)=0. _d 0
69	ENDDO
70	ENDDO
71	ENDDO
72	ENDDO
73	ELSEIF ( useSphereF ) THEN
74	C Spherical case
75	C Note in this case we assume yC is in degrees.
76	DO bj = myByLo(myThid), myByHi(myThid)
77	DO bi = myBxLo(myThid), myBxHi(myThid)
78	DO j=1-Oly,sNy+Oly
79	DO i=1-Olx,sNx+Olx
80	fCori(i,j,bi,bj) =
81	& 2. _d 0omegasin(_yC(i,j,bi,bj)*deg2rad)
82	fCoriG(i,j,bi,bj) =
83	& 2. _d 0omegasin(yG(i,j,bi,bj)*deg2rad)
84	fCoriCos(i,j,bi,bj)=
85	& 2. _d 0omegacos(_yC(i,j,bi,bj)*deg2rad)
86	ENDDO
87	ENDDO
88	ENDDO
89	ENDDO
90	c CALL WRITE_FLD_XY_RL('fCoriC',' ',fCori , 0,myThid)
91	c CALL WRITE_FLD_XY_RL('fCoriG',' ',fCoriG , 0,myThid)
92	c CALL WRITE_FLD_XY_RL('fCorCs',' ',fCoriCos,0,myThid)
93	ELSE
94	C Special custom form
95	DO bj = myByLo(myThid), myByHi(myThid)
96	DO bi = myBxLo(myThid), myBxHi(myThid)
97	DO j=1-Oly,sNy+Oly
98	DO i=1-Olx,sNx+Olx
99	fCori(i,j,bi,bj) = 0. _d 0
100	fCoriG(i,j,bi,bj) = 0. _d 0
101	fCoriCos(i,j,bi,bj)=0. _d 0
102	ENDDO
103	ENDDO
104	ENDDO
105	ENDDO
106	CALL READ_REC_XY_RS( 'fCoriC.bin', fCori, 1, 0, myThid )
107	CALL READ_REC_XY_RS( 'fCoriG.bin', fCoriG, 1, 0, myThid )
108	CALL READ_REC_XY_RS( 'fCorCs.bin', fCoriCos,1, 0, myThid )
109	IF ( useCubedSphereExchange ) THEN
110	C- deal with the 2 missing corners (for fCoriG):
111	DO bj = myByLo(myThid), myByHi(myThid)
112	DO bi = myBxLo(myThid), myBxHi(myThid)
113	C- Notes: this will only works with 6 tiles (1 per face) and
114	C with 2 polar faces + 4 equatorials:
115	IF (bi.LE.3 .OR. bi.GE.5) THEN
116	fCoriG(sNx+1,1,bi,bj) = fCoriG(1,1,bi,bj)
117	ELSE
118	fCoriG(sNx+1,1,bi,bj) = -fCoriG(1,1,bi,bj)
119	ENDIF
120	IF (bi.GE.3) THEN
121	fCoriG(1,sNy+1,bi,bj) = fCoriG(1,1,bi,bj)
122	fCoriG(sNx+1,sNy+1,bi,bj) = fCoriG(sNx+1,1,bi,bj)
123	ELSE
124	fCoriG(1,sNy+1,bi,bj) = -fCoriG(1,1,bi,bj)
125	fCoriG(sNx+1,sNy+1,bi,bj) = -fCoriG(sNx+1,1,bi,bj)
126	ENDIF
127	ENDDO
128	ENDDO
129	ENDIF
130
131	CALL EXCH_XY_RS( fCori, myThid )
132	CALL EXCH_XY_RS( fCoriCos, myThid )
133	c CALL EXCH_Z_XY_RS( fCoriG, myThid )
134	CALL EXCH_Z_3D_RS( fCoriG, 1, myThid )
135	ENDIF
136
137	#ifndef ALLOW_AUTODIFF_TAMC
138	#ifdef ALLOW_MONITOR
139	#ifdef ALLOW_USE_MPI
140	IF ( .NOT.useSingleCPUIO .OR. mpiMyId.EQ.0 ) THEN
141	#endif /* ALLOW_USE_MPI */
142	_BEGIN_MASTER(myThid)
143	C-- only the master thread is allowed to switch On/Off mon_write_stdout
144	C & mon_write_mnc (since it's the only thread that uses those flags):
145
146	IF (monitor_stdio) THEN
147	mon_write_stdout = .TRUE.
148	ELSE
149	mon_write_stdout = .FALSE.
150	ENDIF
151	mon_write_mnc = .FALSE.
152	#ifdef ALLOW_MNC
153	IF (useMNC .AND. monitor_mnc) THEN
154	DO i = 1,MAX_LEN_MBUF
155	mon_fname(i:i) = ' '
156	ENDDO
157	mon_fname(1:12) = 'monitor_grid'
158	CALL MNC_CW_SET_UDIM(mon_fname, 1, myThid)
159	mon_write_mnc = .TRUE.
160	ENDIF
161	#endif /* ALLOW_MNC */
162
163	_END_MASTER(myThid)
164	#ifdef ALLOW_USE_MPI
165	ENDIF
166	#endif /* ALLOW_USE_MPI */
167
168	CALL MON_PRINTSTATS_RS(1,fCori,'fCori',myThid)
169	CALL MON_PRINTSTATS_RS(1,fCoriG,'fCoriG',myThid)
170	CALL MON_PRINTSTATS_RS(1,fCoriCos,'fCoriCos',myThid)
171
172	#ifdef ALLOW_USE_MPI
173	IF ( .NOT.useSingleCPUIO .OR. mpiMyId.EQ.0 ) THEN
174	#endif /* ALLOW_USE_MPI */
175	_BEGIN_MASTER(myThid)
176
177	mon_write_stdout = .FALSE.
178	mon_write_mnc = .FALSE.
179
180	_END_MASTER(myThid)
181	#ifdef ALLOW_USE_MPI
182	ENDIF
183	#endif /* ALLOW_USE_MPI */
184	#endif /* ALLOW_MONITOR */
185	#endif /* ALLOW_AUTODIFF_TAMC */
186
187	RETURN
188	END