/[MITgcm]/MITgcm/pkg/exf/exf_set_obcs.F
ViewVC logotype

Diff of /MITgcm/pkg/exf/exf_set_obcs.F

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

revision 1.16 by jmc, Tue Sep 1 19:37:46 2009 UTC revision 1.17 by jmc, Fri Sep 2 18:22:50 2011 UTC
# Line 7  C--  File exf_set_obcs.F: Line 7  C--  File exf_set_obcs.F:
7  C--   Contents  C--   Contents
8  C--   o EXF_SET_OBCS_XZ  C--   o EXF_SET_OBCS_XZ
9  C--   o EXF_SET_OBCS_YZ  C--   o EXF_SET_OBCS_YZ
10  C--   o EXF_SET_OBCS_X  C--   o EXF_SET_OBCS_X   <- no longer maintained ; use SET_OBCS_XZ with nNz=1
11  C--   o EXF_SET_OBCS_Y  C--   o EXF_SET_OBCS_Y   <- no longer maintained ; use SET_OBCS_YZ with nNz=1
12    
13  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
14    
15        SUBROUTINE EXF_SET_OBCS_XZ (        SUBROUTINE EXF_SET_OBCS_XZ (
16       U       obcs_fld_xz, obcs_xz_0, obcs_xz_1,       U       obcs_fld_xz, obcs_xz_0, obcs_xz_1,
17       I       obcs_file, obcsmask,       I       obcs_file, obcsmask, nNz,
18       I       fac, first, changed, useYearlyFields, obcs_period,       I       fac, first, changed, useYearlyFields, obcs_period,
19       I       count0, count1, year0, year1,       I       count0, count1, year0, year1,
20       I       myTime, myIter, myThid )       I       myTime, myIter, myThid )
21    
22  c     ==================================================================  C     ==================================================================
23  c     SUBROUTINE EXF_SET_OBCS_XZ  C     SUBROUTINE EXF_SET_OBCS_XZ
24  c     ==================================================================  C     ==================================================================
25  c  C
26  c     o set open boundary conditions  C     o set open boundary conditions
27  c  C
28  c     started: heimbach@mit.edu 01-May-2001  C     started: heimbach@mit.edu 01-May-2001
29  c     mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002  C     mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
30    
31  c     ==================================================================  C     ==================================================================
32  c     SUBROUTINE EXF_SET_OBCS_XZ  C     SUBROUTINE EXF_SET_OBCS_XZ
33  c     ==================================================================  C     ==================================================================
34    
35        IMPLICIT NONE        IMPLICIT NONE
36    
37  c     == global variables ==  C     == global variables ==
   
38  #include "EEPARAMS.h"  #include "EEPARAMS.h"
39  #include "SIZE.h"  #include "SIZE.h"
40  #include "GRID.h"  #include "GRID.h"
41  #include "EXF_PARAM.h"  #include "EXF_PARAM.h"
42  #include "EXF_CONSTANTS.h"  #include "EXF_CONSTANTS.h"
43    
44  c     == routine arguments ==  C     == routine arguments ==
45    C     nNz   :: number of levels to process
46        _RL obcs_fld_xz(1-OLx:sNx+OLx,Nr,nSx,nSy)        INTEGER nNz
47        _RL obcs_xz_0(1-OLx:sNx+OLx,Nr,nSx,nSy)        _RL obcs_fld_xz(1-OLx:sNx+OLx,nNz,nSx,nSy)
48        _RL obcs_xz_1(1-OLx:sNx+OLx,Nr,nSx,nSy)        _RL obcs_xz_0(1-OLx:sNx+OLx,nNz,nSx,nSy)
49          _RL obcs_xz_1(1-OLx:sNx+OLx,nNz,nSx,nSy)
50    
51        CHARACTER*(128) obcs_file        CHARACTER*(128) obcs_file
52        CHARACTER*1 obcsmask        CHARACTER*1 obcsmask
# Line 61  c     == routine arguments == Line 61  c     == routine arguments ==
61    
62  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
63    
64  c     == local variables ==  C     == local variables ==
65    
66        CHARACTER*(128) obcs_file0, obcs_file1        CHARACTER*(128) obcs_file0, obcs_file1
67        INTEGER bi, bj        INTEGER bi, bj
68        INTEGER i, k        INTEGER i, k
69    
70  c     == end of interface ==  C     == end of interface ==
71    
72        IF ( obcs_file .NE. ' ' ) THEN        IF ( obcs_file .NE. ' ' ) THEN
73    
# Line 79  c     == end of interface == Line 79  c     == end of interface ==
79       O         obcs_file0,       O         obcs_file0,
80       I         myTime, myIter, myThid )       I         myTime, myIter, myThid )
81    
82              CALL READ_REC_XZ_RL( obcs_file0, exf_iprec_obcs, Nr,              _BARRIER
83                CALL READ_REC_XZ_RL( obcs_file0, exf_iprec_obcs, nNz,
84       &                           obcs_xz_1, count0, myIter, myThid )       &                           obcs_xz_1, count0, myIter, myThid )
85                _BARRIER
86           ENDIF           ENDIF
87    
88           IF (( first ) .OR. ( changed )) THEN           IF ( first .OR. changed ) THEN
89              CALL exf_swapffields_xz( obcs_xz_0, obcs_xz_1, myThid )              CALL exf_swapffields_xz( obcs_xz_0, obcs_xz_1, nNz,myThid )
90    
91              CALL exf_GetYearlyFieldName(              CALL exf_GetYearlyFieldName(
92       I         useYearlyFields, twoDigitYear, obcs_period, year1,       I         useYearlyFields, twoDigitYear, obcs_period, year1,
# Line 92  c     == end of interface == Line 94  c     == end of interface ==
94       O         obcs_file1,       O         obcs_file1,
95       I         myTime, myIter, myThid )       I         myTime, myIter, myThid )
96    
97              CALL READ_REC_XZ_RL( obcs_file1, exf_iprec_obcs, Nr,              _BARRIER
98                CALL READ_REC_XZ_RL( obcs_file1, exf_iprec_obcs, nNz,
99       &                           obcs_xz_1, count1, myIter, myThid )       &                           obcs_xz_1, count1, myIter, myThid )
100                _BARRIER
101           ENDIF           ENDIF
102    
103           DO bj = myByLo(myThid),myByHi(myThid)           DO bj = myByLo(myThid),myByHi(myThid)
104              DO bi = myBxLo(myThid),myBxHi(myThid)              DO bi = myBxLo(myThid),myBxHi(myThid)
105                 DO k = 1,Nr                 DO k = 1,nNz
106                    DO i = 1,sNx                    DO i = 1,sNx
107                       obcs_fld_xz(i,k,bi,bj) =                       obcs_fld_xz(i,k,bi,bj) =
108       &                    fac * obcs_xz_0(i,k,bi,bj) +       &                    fac * obcs_xz_0(i,k,bi,bj) +
# Line 119  C---+----1----+----2----+----3----+----4 Line 123  C---+----1----+----2----+----3----+----4
123    
124        SUBROUTINE EXF_SET_OBCS_YZ (        SUBROUTINE EXF_SET_OBCS_YZ (
125       U       obcs_fld_yz, obcs_yz_0, obcs_yz_1,       U       obcs_fld_yz, obcs_yz_0, obcs_yz_1,
126       I       obcs_file, obcsmask,       I       obcs_file, obcsmask, nNz,
127       I       fac, first, changed, useYearlyFields, obcs_period,       I       fac, first, changed, useYearlyFields, obcs_period,
128       I       count0, count1, year0, year1,       I       count0, count1, year0, year1,
129       I       myTime, myIter, myThid)       I       myTime, myIter, myThid)
130    
131  c     ==================================================================  C     ==================================================================
132  c     SUBROUTINE EXF_SET_OBCS_YZ  C     SUBROUTINE EXF_SET_OBCS_YZ
133  c     ==================================================================  C     ==================================================================
134  c  C
135  c     o set open boundary conditions  C     o set open boundary conditions
136  c  C
137  c     started: heimbach@mit.edu 01-May-2001  C     started: heimbach@mit.edu 01-May-2001
138    
139  c     ==================================================================  C     ==================================================================
140  c     SUBROUTINE EXF_SET_OBCS_YZ  C     SUBROUTINE EXF_SET_OBCS_YZ
141  c     ==================================================================  C     ==================================================================
142    
143        IMPLICIT NONE        IMPLICIT NONE
144    
145  c     == global variables ==  C     == global variables ==
   
146  #include "EEPARAMS.h"  #include "EEPARAMS.h"
147  #include "SIZE.h"  #include "SIZE.h"
148  #include "GRID.h"  #include "GRID.h"
149  #include "EXF_PARAM.h"  #include "EXF_PARAM.h"
150  #include "EXF_CONSTANTS.h"  #include "EXF_CONSTANTS.h"
151    
152  c     == routine arguments ==  C     == routine arguments ==
153    C     nNz   :: number of levels to process
154        _RL obcs_fld_yz(1-OLy:sNy+OLy,Nr,nSx,nSy)        INTEGER nNz
155        _RL obcs_yz_0(1-OLy:sNy+OLy,Nr,nSx,nSy)        _RL obcs_fld_yz(1-OLy:sNy+OLy,nNz,nSx,nSy)
156        _RL obcs_yz_1(1-OLy:sNy+OLy,Nr,nSx,nSy)        _RL obcs_yz_0(1-OLy:sNy+OLy,nNz,nSx,nSy)
157          _RL obcs_yz_1(1-OLy:sNy+OLy,nNz,nSx,nSy)
158        CHARACTER*(MAX_LEN_FNAM) obcs_file        CHARACTER*(MAX_LEN_FNAM) obcs_file
159        CHARACTER*1 obcsmask        CHARACTER*1 obcsmask
160        LOGICAL first, changed        LOGICAL first, changed
# Line 164  c     == routine arguments == Line 168  c     == routine arguments ==
168    
169  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
170    
171  c     == local variables ==  C     == local variables ==
172    
173        CHARACTER*(128) obcs_file0, obcs_file1        CHARACTER*(128) obcs_file0, obcs_file1
174        INTEGER bi, bj        INTEGER bi, bj
175        INTEGER j, k        INTEGER j, k
176    
177  c     == end of interface ==  C     == end of interface ==
178    
179        IF ( obcs_file .NE. ' ' ) THEN        IF ( obcs_file .NE. ' ' ) THEN
180    
# Line 182  c     == end of interface == Line 186  c     == end of interface ==
186       O         obcs_file0,       O         obcs_file0,
187       I         myTime, myIter, myThid )       I         myTime, myIter, myThid )
188    
189              CALL READ_REC_YZ_RL( obcs_file0, exf_iprec_obcs, Nr,              _BARRIER
190                CALL READ_REC_YZ_RL( obcs_file0, exf_iprec_obcs, nNz,
191       &                           obcs_yz_1, count0, myIter, myThid )       &                           obcs_yz_1, count0, myIter, myThid )
192                _BARRIER
193           ENDIF           ENDIF
194    
195           IF (( first ) .OR. ( changed )) THEN           IF ( first .OR. changed ) THEN
196              CALL exf_swapffields_yz( obcs_yz_0, obcs_yz_1, myThid )              CALL exf_swapffields_yz( obcs_yz_0, obcs_yz_1, nNz,myThid )
197    
198              CALL exf_GetYearlyFieldName(              CALL exf_GetYearlyFieldName(
199       I         useYearlyFields, twoDigitYear, obcs_period, year1,       I         useYearlyFields, twoDigitYear, obcs_period, year1,
# Line 195  c     == end of interface == Line 201  c     == end of interface ==
201       O         obcs_file1,       O         obcs_file1,
202       I         myTime, myIter, myThid )       I         myTime, myIter, myThid )
203    
204              CALL READ_REC_YZ_RL( obcs_file1, exf_iprec_obcs, Nr,              _BARRIER
205                CALL READ_REC_YZ_RL( obcs_file1, exf_iprec_obcs, nNz,
206       &                           obcs_yz_1, count1, myIter, myThid )       &                           obcs_yz_1, count1, myIter, myThid )
207                _BARRIER
208           ENDIF           ENDIF
209    
210           DO bj = myByLo(myThid),myByHi(myThid)           DO bj = myByLo(myThid),myByHi(myThid)
211              DO bi = myBxLo(myThid),myBxHi(myThid)              DO bi = myBxLo(myThid),myBxHi(myThid)
212                 DO k = 1,Nr                 DO k = 1,nNz
213                    DO j = 1,sNy                    DO j = 1,sNy
214                       obcs_fld_yz(j,k,bi,bj) =                       obcs_fld_yz(j,k,bi,bj) =
215       &                    fac             *obcs_yz_0(j,k,bi,bj) +       &                    fac             *obcs_yz_0(j,k,bi,bj) +
# Line 227  C---+----1----+----2----+----3----+----4 Line 235  C---+----1----+----2----+----3----+----4
235       I       count0, count1, year0, year1,       I       count0, count1, year0, year1,
236       I       myTime, myIter, myThid )       I       myTime, myIter, myThid )
237    
238  c     ==================================================================  C     ==================================================================
239  c     SUBROUTINE EXF_SET_OBCS_X  C     SUBROUTINE EXF_SET_OBCS_X
240  c     ==================================================================  C     ==================================================================
241  c  C
242  c     o set open boundary conditions  C     o set open boundary conditions
243  c       same as EXF_SET_OBCS_XZ but for Nr=1  C       same as EXF_SET_OBCS_XZ but for Nr=1
244  c  C
245  c     ==================================================================  C     ==================================================================
246  c     SUBROUTINE EXF_SET_OBCS_X  C     SUBROUTINE EXF_SET_OBCS_X
247  c     ==================================================================  C     ==================================================================
248    
249        IMPLICIT NONE        IMPLICIT NONE
250    
251  c     == global variables ==  C     == global variables ==
252    
253  #include "EEPARAMS.h"  #include "EEPARAMS.h"
254  #include "SIZE.h"  #include "SIZE.h"
# Line 248  c     == global variables == Line 256  c     == global variables ==
256  #include "EXF_PARAM.h"  #include "EXF_PARAM.h"
257  #include "EXF_CONSTANTS.h"  #include "EXF_CONSTANTS.h"
258    
259  c     == routine arguments ==  C     == routine arguments ==
260    
261        _RL obcs_fld_x(1-OLx:sNx+OLx,nSx,nSy)        _RL obcs_fld_x(1-OLx:sNx+OLx,nSx,nSy)
262        _RL obcs_x_0(1-OLx:sNx+OLx,nSx,nSy)        _RL obcs_x_0(1-OLx:sNx+OLx,nSx,nSy)
# Line 267  c     == routine arguments == Line 275  c     == routine arguments ==
275    
276  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
277    
278  c     == local variables ==  C     == local variables ==
279    
280        CHARACTER*(128) obcs_file0, obcs_file1        CHARACTER*(128) obcs_file0, obcs_file1
281        INTEGER bi, bj, i        INTEGER bi, bj, i
282    
283  c     == end of interface ==  C     == end of interface ==
284    
285          STOP 'S/R EXF_SET_OBCS_X no longer maintained'
286    
287        IF ( obcs_file .NE. ' ' ) THEN        IF ( obcs_file .NE. ' ' ) THEN
288    
# Line 289  c     == end of interface == Line 299  c     == end of interface ==
299           ENDIF           ENDIF
300    
301           IF (( first ) .OR. ( changed )) THEN           IF (( first ) .OR. ( changed )) THEN
302              CALL exf_swapffields_x( obcs_x_0, obcs_x_1, myThid )              CALL exf_swapffields_xz( obcs_x_0, obcs_x_1, 1,myThid )
303    
304              CALL exf_GetYearlyFieldName(              CALL exf_GetYearlyFieldName(
305       I         useYearlyFields, twoDigitYear, obcs_period, year1,       I         useYearlyFields, twoDigitYear, obcs_period, year1,
# Line 327  C---+----1----+----2----+----3----+----4 Line 337  C---+----1----+----2----+----3----+----4
337       I       count0, count1, year0, year1,       I       count0, count1, year0, year1,
338       I       myTime, myIter, myThid )       I       myTime, myIter, myThid )
339    
340  c     ==================================================================  C     ==================================================================
341  c     SUBROUTINE EXF_SET_OBCS_Y  C     SUBROUTINE EXF_SET_OBCS_Y
342  c     ==================================================================  C     ==================================================================
343  c  C
344  c     o set open boundary conditions  C     o set open boundary conditions
345  c       same as EXF_SET_OBCS_YZ but for Nr=1  C       same as EXF_SET_OBCS_YZ but for Nr=1
346  c  C
347  c     ==================================================================  C     ==================================================================
348  c     SUBROUTINE EXF_SET_OBCS_Y  C     SUBROUTINE EXF_SET_OBCS_Y
349  c     ==================================================================  C     ==================================================================
350    
351        IMPLICIT NONE        IMPLICIT NONE
352    
353  c     == global variables ==  C     == global variables ==
354    
355  #include "EEPARAMS.h"  #include "EEPARAMS.h"
356  #include "SIZE.h"  #include "SIZE.h"
# Line 348  c     == global variables == Line 358  c     == global variables ==
358  #include "EXF_PARAM.h"  #include "EXF_PARAM.h"
359  #include "EXF_CONSTANTS.h"  #include "EXF_CONSTANTS.h"
360    
361  c     == routine arguments ==  C     == routine arguments ==
362    
363        _RL obcs_fld_y(1-OLy:sNy+OLy,nSx,nSy)        _RL obcs_fld_y(1-OLy:sNy+OLy,nSx,nSy)
364        _RL obcs_y_0(1-OLy:sNy+OLy,nSx,nSy)        _RL obcs_y_0(1-OLy:sNy+OLy,nSx,nSy)
# Line 366  c     == routine arguments == Line 376  c     == routine arguments ==
376    
377  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
378    
379  c     == local variables ==  C     == local variables ==
380    
381        CHARACTER*(128) obcs_file0, obcs_file1        CHARACTER*(128) obcs_file0, obcs_file1
382        INTEGER bi, bj, j        INTEGER bi, bj, j
383    
384  c     == end of interface ==  C     == end of interface ==
385    
386          STOP 'S/R EXF_SET_OBCS_X no longer maintained'
387    
388        IF ( obcs_file .NE. ' ' ) THEN        IF ( obcs_file .NE. ' ' ) THEN
389    
# Line 388  c     == end of interface == Line 400  c     == end of interface ==
400           ENDIF           ENDIF
401    
402           IF (( first ) .OR. ( changed )) THEN           IF (( first ) .OR. ( changed )) THEN
403              CALL exf_swapffields_y( obcs_y_0, obcs_y_1, myThid )              CALL exf_swapffields_yz( obcs_y_0, obcs_y_1, 1,myThid )
404    
405              CALL exf_GetYearlyFieldName(              CALL exf_GetYearlyFieldName(
406       I         useYearlyFields, twoDigitYear, obcs_period, year1,       I         useYearlyFields, twoDigitYear, obcs_period, year1,
Legend:
Removed from v.1.16  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22