/[MITgcm]/MITgcm/model/src/ini_cori.F
ViewVC logotype

Diff of /MITgcm/model/src/ini_cori.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

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