pkg/exf/exf_set_obcs.F

C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_set_obcs.F,v 1.16 2009/09/01 19:37:46 jmc Exp $
C $Name:  $

#include "EXF_OPTIONS.h"

C--  File exf_set_obcs.F:
C--   Contents
C--   o EXF_SET_OBCS_XZ
C--   o EXF_SET_OBCS_YZ
C--   o EXF_SET_OBCS_X   <- no longer maintained ; use SET_OBCS_XZ with nNz=1
C--   o EXF_SET_OBCS_Y   <- no longer maintained ; use SET_OBCS_YZ with nNz=1

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE EXF_SET_OBCS_XZ (
     U       obcs_fld_xz, obcs_xz_0, obcs_xz_1,
     I       obcs_file, obcsmask, nNz,
     I       fac, first, changed, useYearlyFields, obcs_period,
     I       count0, count1, year0, year1,
     I       myTime, myIter, myThid )

C     ==================================================================
C     SUBROUTINE EXF_SET_OBCS_XZ
C     ==================================================================
C
C     o set open boundary conditions
C
C     started: heimbach@mit.edu 01-May-2001
C     mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002

C     ==================================================================
C     SUBROUTINE EXF_SET_OBCS_XZ
C     ==================================================================

      IMPLICIT NONE

C     == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "GRID.h"
#include "EXF_PARAM.h"
#include "EXF_CONSTANTS.h"

C     == routine arguments ==
C     nNz   :: number of levels to process
      INTEGER nNz
      _RL obcs_fld_xz(1-OLx:sNx+OLx,nNz,nSx,nSy)
      _RL obcs_xz_0(1-OLx:sNx+OLx,nNz,nSx,nSy)
      _RL obcs_xz_1(1-OLx:sNx+OLx,nNz,nSx,nSy)

      CHARACTER*(128) obcs_file
      CHARACTER*1 obcsmask
      LOGICAL first, changed
      LOGICAL useYearlyFields
      _RL     obcs_period
      INTEGER count0, count1, year0, year1
      _RL     fac
      _RL     myTime
      INTEGER myIter
      INTEGER myThid

#ifdef ALLOW_OBCS

C     == local variables ==

      CHARACTER*(128) obcs_file0, obcs_file1
      INTEGER bi, bj
      INTEGER i, k

C     == end of interface ==

      IF ( obcs_file .NE. ' ' ) THEN

         IF ( first ) THEN

            CALL exf_GetYearlyFieldName(
     I         useYearlyFields, twoDigitYear, obcs_period, year0,
     I         obcs_file,
     O         obcs_file0,
     I         myTime, myIter, myThid )

            _BARRIER
            CALL READ_REC_XZ_RL( obcs_file0, exf_iprec_obcs, nNz,
     &                           obcs_xz_1, count0, myIter, myThid )
            _BARRIER
         ENDIF

         IF ( first .OR. changed ) THEN
            CALL exf_swapffields_xz( obcs_xz_0, obcs_xz_1, nNz,myThid )

            CALL exf_GetYearlyFieldName(
     I         useYearlyFields, twoDigitYear, obcs_period, year1,
     I         obcs_file,
     O         obcs_file1,
     I         myTime, myIter, myThid )

            _BARRIER
            CALL READ_REC_XZ_RL( obcs_file1, exf_iprec_obcs, nNz,
     &                           obcs_xz_1, count1, myIter, myThid )
            _BARRIER
         ENDIF

         DO bj = myByLo(myThid),myByHi(myThid)
            DO bi = myBxLo(myThid),myBxHi(myThid)
               DO k = 1,nNz
                  DO i = 1,sNx
                     obcs_fld_xz(i,k,bi,bj) =
     &                    fac * obcs_xz_0(i,k,bi,bj) +
     &                    (exf_one - fac) * obcs_xz_1(i,k,bi,bj)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO

      ENDIF

#endif /* ALLOW_OBCS */

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE EXF_SET_OBCS_YZ (
     U       obcs_fld_yz, obcs_yz_0, obcs_yz_1,
     I       obcs_file, obcsmask, nNz,
     I       fac, first, changed, useYearlyFields, obcs_period,
     I       count0, count1, year0, year1,
     I       myTime, myIter, myThid)

C     ==================================================================
C     SUBROUTINE EXF_SET_OBCS_YZ
C     ==================================================================
C
C     o set open boundary conditions
C
C     started: heimbach@mit.edu 01-May-2001

C     ==================================================================
C     SUBROUTINE EXF_SET_OBCS_YZ
C     ==================================================================

      IMPLICIT NONE

C     == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "GRID.h"
#include "EXF_PARAM.h"
#include "EXF_CONSTANTS.h"

C     == routine arguments ==
C     nNz   :: number of levels to process
      INTEGER nNz
      _RL obcs_fld_yz(1-OLy:sNy+OLy,nNz,nSx,nSy)
      _RL obcs_yz_0(1-OLy:sNy+OLy,nNz,nSx,nSy)
      _RL obcs_yz_1(1-OLy:sNy+OLy,nNz,nSx,nSy)
      CHARACTER*(MAX_LEN_FNAM) obcs_file
      CHARACTER*1 obcsmask
      LOGICAL first, changed
      LOGICAL useYearlyFields
      _RL     obcs_period
      INTEGER count0, count1, year0, year1
      _RL     fac
      _RL     myTime
      INTEGER myIter
      INTEGER myThid

#ifdef ALLOW_OBCS

C     == local variables ==

      CHARACTER*(128) obcs_file0, obcs_file1
      INTEGER bi, bj
      INTEGER j, k

C     == end of interface ==

      IF ( obcs_file .NE. ' ' ) THEN

         IF ( first ) THEN

            CALL exf_GetYearlyFieldName(
     I         useYearlyFields, twoDigitYear, obcs_period, year0,
     I         obcs_file,
     O         obcs_file0,
     I         myTime, myIter, myThid )

            _BARRIER
            CALL READ_REC_YZ_RL( obcs_file0, exf_iprec_obcs, nNz,
     &                           obcs_yz_1, count0, myIter, myThid )
            _BARRIER
         ENDIF

         IF ( first .OR. changed ) THEN
            CALL exf_swapffields_yz( obcs_yz_0, obcs_yz_1, nNz,myThid )

            CALL exf_GetYearlyFieldName(
     I         useYearlyFields, twoDigitYear, obcs_period, year1,
     I         obcs_file,
     O         obcs_file1,
     I         myTime, myIter, myThid )

            _BARRIER
            CALL READ_REC_YZ_RL( obcs_file1, exf_iprec_obcs, nNz,
     &                           obcs_yz_1, count1, myIter, myThid )
            _BARRIER
         ENDIF

         DO bj = myByLo(myThid),myByHi(myThid)
            DO bi = myBxLo(myThid),myBxHi(myThid)
               DO k = 1,nNz
                  DO j = 1,sNy
                     obcs_fld_yz(j,k,bi,bj) =
     &                    fac             *obcs_yz_0(j,k,bi,bj) +
     &                    (exf_one - fac) *obcs_yz_1(j,k,bi,bj)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO

      ENDIF

#endif /* ALLOW_OBCS */

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE EXF_SET_OBCS_X (
     U       obcs_fld_x, obcs_x_0, obcs_x_1,
     I       obcs_file, obcsmask,
     I       fac, first, changed, useYearlyFields, obcs_period,
     I       count0, count1, year0, year1,
     I       myTime, myIter, myThid )

C     ==================================================================
C     SUBROUTINE EXF_SET_OBCS_X
C     ==================================================================
C
C     o set open boundary conditions
C       same as EXF_SET_OBCS_XZ but for Nr=1
C
C     ==================================================================
C     SUBROUTINE EXF_SET_OBCS_X
C     ==================================================================

      IMPLICIT NONE

C     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"
#include "GRID.h"
#include "EXF_PARAM.h"
#include "EXF_CONSTANTS.h"

C     == routine arguments ==

      _RL obcs_fld_x(1-OLx:sNx+OLx,nSx,nSy)
      _RL obcs_x_0(1-OLx:sNx+OLx,nSx,nSy)
      _RL obcs_x_1(1-OLx:sNx+OLx,nSx,nSy)

      CHARACTER*(128) obcs_file
      CHARACTER*1 obcsmask
      LOGICAL first, changed
      LOGICAL useYearlyFields
      _RL     obcs_period
      INTEGER count0, count1, year0, year1
      _RL     fac
      _RL     myTime
      INTEGER myIter
      INTEGER myThid

#ifdef ALLOW_OBCS

C     == local variables ==

      CHARACTER*(128) obcs_file0, obcs_file1
      INTEGER bi, bj, i

C     == end of interface ==

      STOP 'S/R EXF_SET_OBCS_X no longer maintained'

      IF ( obcs_file .NE. ' ' ) THEN

         IF ( first ) THEN

            CALL exf_GetYearlyFieldName(
     I         useYearlyFields, twoDigitYear, obcs_period, year0,
     I         obcs_file,
     O         obcs_file0,
     I         myTime, myIter, myThid )

            CALL READ_REC_XZ_RL( obcs_file0, exf_iprec_obcs, 1,
     &                           obcs_x_1, count0, myIter, myThid )
         ENDIF

         IF (( first ) .OR. ( changed )) THEN
            CALL exf_swapffields_xz( obcs_x_0, obcs_x_1, 1,myThid )

            CALL exf_GetYearlyFieldName(
     I         useYearlyFields, twoDigitYear, obcs_period, year1,
     I         obcs_file,
     O         obcs_file1,
     I         myTime, myIter, myThid )

            CALL READ_REC_XZ_RL( obcs_file1, exf_iprec_obcs, 1,
     &                           obcs_x_1, count1, myIter, myThid )
         ENDIF

         DO bj = myByLo(myThid),myByHi(myThid)
            DO bi = myBxLo(myThid),myBxHi(myThid)
               DO i = 1,sNx
                  obcs_fld_x(i,bi,bj) =
     &                 fac * obcs_x_0(i,bi,bj) +
     &                 (exf_one - fac) * obcs_x_1(i,bi,bj)
               ENDDO
            ENDDO
         ENDDO

      ENDIF

#endif /* ALLOW_OBCS */

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE EXF_SET_OBCS_Y (
     U       obcs_fld_y, obcs_y_0, obcs_y_1,
     I       obcs_file, obcsmask,
     I       fac, first, changed, useYearlyFields, obcs_period,
     I       count0, count1, year0, year1,
     I       myTime, myIter, myThid )

C     ==================================================================
C     SUBROUTINE EXF_SET_OBCS_Y
C     ==================================================================
C
C     o set open boundary conditions
C       same as EXF_SET_OBCS_YZ but for Nr=1
C
C     ==================================================================
C     SUBROUTINE EXF_SET_OBCS_Y
C     ==================================================================

      IMPLICIT NONE

C     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"
#include "GRID.h"
#include "EXF_PARAM.h"
#include "EXF_CONSTANTS.h"

C     == routine arguments ==

      _RL obcs_fld_y(1-OLy:sNy+OLy,nSx,nSy)
      _RL obcs_y_0(1-OLy:sNy+OLy,nSx,nSy)
      _RL obcs_y_1(1-OLy:sNy+OLy,nSx,nSy)
      CHARACTER*(MAX_LEN_FNAM) obcs_file
      CHARACTER*1 obcsmask
      LOGICAL first, changed
      LOGICAL useYearlyFields
      _RL     obcs_period
      INTEGER count0, count1, year0, year1
      _RL     fac
      _RL     myTime
      INTEGER myIter
      INTEGER myThid

#ifdef ALLOW_OBCS

C     == local variables ==

      CHARACTER*(128) obcs_file0, obcs_file1
      INTEGER bi, bj, j

C     == end of interface ==

      STOP 'S/R EXF_SET_OBCS_X no longer maintained'

      IF ( obcs_file .NE. ' ' ) THEN

         IF ( first ) THEN

            CALL exf_GetYearlyFieldName(
     I         useYearlyFields, twoDigitYear, obcs_period, year0,
     I         obcs_file,
     O         obcs_file0,
     I         myTime, myIter, myThid )

            CALL READ_REC_YZ_RL( obcs_file0, exf_iprec_obcs, 1,
     &                           obcs_y_1, count0, myIter, myThid )
         ENDIF

         IF (( first ) .OR. ( changed )) THEN
            CALL exf_swapffields_yz( obcs_y_0, obcs_y_1, 1,myThid )

            CALL exf_GetYearlyFieldName(
     I         useYearlyFields, twoDigitYear, obcs_period, year1,
     I         obcs_file,
     O         obcs_file1,
     I         myTime, myIter, myThid )

            CALL READ_REC_YZ_RL( obcs_file1, exf_iprec_obcs, 1,
     &                           obcs_y_1, count1, myIter, myThid )
         ENDIF

         DO bj = myByLo(myThid),myByHi(myThid)
            DO bi = myBxLo(myThid),myBxHi(myThid)
               DO j = 1,sNy
                  obcs_fld_y(j,bi,bj) =
     &                 fac             *obcs_y_0(j,bi,bj) +
     &                 (exf_one - fac) *obcs_y_1(j,bi,bj)
               ENDDO
            ENDDO
         ENDDO

      ENDIF

#endif /* ALLOW_OBCS */

      RETURN
      END
1	jmc	1.17	C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_set_obcs.F,v 1.16 2009/09/01 19:37:46 jmc Exp $
2	jmc	1.7	C $Name: $
3
4	edhill	1.6	#include "EXF_OPTIONS.h"
5	heimbach	1.1
6	jmc	1.16	C-- File exf_set_obcs.F:
7			C-- Contents
8			C-- o EXF_SET_OBCS_XZ
9			C-- o EXF_SET_OBCS_YZ
10	jmc	1.17	C-- o EXF_SET_OBCS_X <- no longer maintained ; use SET_OBCS_XZ with nNz=1
11			C-- o EXF_SET_OBCS_Y <- no longer maintained ; use SET_OBCS_YZ with nNz=1
12	jmc	1.16
13			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
14
15			SUBROUTINE EXF_SET_OBCS_XZ (
16			U obcs_fld_xz, obcs_xz_0, obcs_xz_1,
17	jmc	1.17	I obcs_file, obcsmask, nNz,
18	jmc	1.16	I fac, first, changed, useYearlyFields, obcs_period,
19			I count0, count1, year0, year1,
20			I myTime, myIter, myThid )
21	heimbach	1.1
22	jmc	1.17	C ==================================================================
23			C SUBROUTINE EXF_SET_OBCS_XZ
24			C ==================================================================
25			C
26			C o set open boundary conditions
27			C
28			C started: heimbach@mit.edu 01-May-2001
29			C mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
30
31			C ==================================================================
32			C SUBROUTINE EXF_SET_OBCS_XZ
33			C ==================================================================
34	heimbach	1.1
35	jmc	1.16	IMPLICIT NONE
36	heimbach	1.1
37	jmc	1.17	C == global variables ==
38	heimbach	1.1	#include "EEPARAMS.h"
39			#include "SIZE.h"
40			#include "GRID.h"
41	jmc	1.7	#include "EXF_PARAM.h"
42			#include "EXF_CONSTANTS.h"
43	heimbach	1.1
44	jmc	1.17	C == routine arguments ==
45			C nNz :: number of levels to process
46			INTEGER nNz
47			_RL obcs_fld_xz(1-OLx:sNx+OLx,nNz,nSx,nSy)
48			_RL obcs_xz_0(1-OLx:sNx+OLx,nNz,nSx,nSy)
49			_RL obcs_xz_1(1-OLx:sNx+OLx,nNz,nSx,nSy)
50	jmc	1.16
51			CHARACTER*(128) obcs_file
52			CHARACTER*1 obcsmask
53			LOGICAL first, changed
54			LOGICAL useYearlyFields
55	mlosch	1.10	_RL obcs_period
56	jmc	1.16	INTEGER count0, count1, year0, year1
57	heimbach	1.1	_RL fac
58	jmc	1.16	_RL myTime
59			INTEGER myIter
60			INTEGER myThid
61	heimbach	1.1
62			#ifdef ALLOW_OBCS
63
64	jmc	1.17	C == local variables ==
65	heimbach	1.1
66	jmc	1.16	CHARACTER*(128) obcs_file0, obcs_file1
67			INTEGER bi, bj
68			INTEGER i, k
69	mlosch	1.10
70	jmc	1.17	C == end of interface ==
71	heimbach	1.1
72	jmc	1.16	IF ( obcs_file .NE. ' ' ) THEN
73	heimbach	1.1
74	jmc	1.16	IF ( first ) THEN
75	mlosch	1.10
76	jmc	1.16	CALL exf_GetYearlyFieldName(
77	mlosch	1.11	I useYearlyFields, twoDigitYear, obcs_period, year0,
78			I obcs_file,
79			O obcs_file0,
80	jmc	1.16	I myTime, myIter, myThid )
81	mlosch	1.10
82	jmc	1.17	_BARRIER
83			CALL READ_REC_XZ_RL( obcs_file0, exf_iprec_obcs, nNz,
84	jmc	1.16	& obcs_xz_1, count0, myIter, myThid )
85	jmc	1.17	_BARRIER
86	jmc	1.16	ENDIF
87	dimitri	1.4
88	jmc	1.17	IF ( first .OR. changed ) THEN
89			CALL exf_swapffields_xz( obcs_xz_0, obcs_xz_1, nNz,myThid )
90	dimitri	1.4
91	jmc	1.16	CALL exf_GetYearlyFieldName(
92			I useYearlyFields, twoDigitYear, obcs_period, year1,
93	mlosch	1.11	I obcs_file,
94			O obcs_file1,
95	jmc	1.16	I myTime, myIter, myThid )
96	mlosch	1.10
97	jmc	1.17	_BARRIER
98			CALL READ_REC_XZ_RL( obcs_file1, exf_iprec_obcs, nNz,
99	jmc	1.16	& obcs_xz_1, count1, myIter, myThid )
100	jmc	1.17	_BARRIER
101	jmc	1.16	ENDIF
102
103			DO bj = myByLo(myThid),myByHi(myThid)
104			DO bi = myBxLo(myThid),myBxHi(myThid)
105	jmc	1.17	DO k = 1,nNz
106	jmc	1.16	DO i = 1,sNx
107			obcs_fld_xz(i,k,bi,bj) =
108	dimitri	1.13	& fac * obcs_xz_0(i,k,bi,bj) +
109	dimitri	1.4	& (exf_one - fac) * obcs_xz_1(i,k,bi,bj)
110	jmc	1.16	ENDDO
111			ENDDO
112			ENDDO
113			ENDDO
114	heimbach	1.1
115	jmc	1.16	ENDIF
116	heimbach	1.1
117	dimitri	1.8	#endif /* ALLOW_OBCS */
118	heimbach	1.1
119	jmc	1.16	RETURN
120			END
121	heimbach	1.1
122	jmc	1.16	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
123
124			SUBROUTINE EXF_SET_OBCS_YZ (
125			U obcs_fld_yz, obcs_yz_0, obcs_yz_1,
126	jmc	1.17	I obcs_file, obcsmask, nNz,
127	jmc	1.16	I fac, first, changed, useYearlyFields, obcs_period,
128			I count0, count1, year0, year1,
129			I myTime, myIter, myThid)
130	heimbach	1.1
131	jmc	1.17	C ==================================================================
132			C SUBROUTINE EXF_SET_OBCS_YZ
133			C ==================================================================
134			C
135			C o set open boundary conditions
136			C
137			C started: heimbach@mit.edu 01-May-2001
138
139			C ==================================================================
140			C SUBROUTINE EXF_SET_OBCS_YZ
141			C ==================================================================
142	heimbach	1.1
143	jmc	1.16	IMPLICIT NONE
144	heimbach	1.1
145	jmc	1.17	C == global variables ==
146	heimbach	1.1	#include "EEPARAMS.h"
147			#include "SIZE.h"
148			#include "GRID.h"
149	jmc	1.7	#include "EXF_PARAM.h"
150			#include "EXF_CONSTANTS.h"
151	heimbach	1.1
152	jmc	1.17	C == routine arguments ==
153			C nNz :: number of levels to process
154			INTEGER nNz
155			_RL obcs_fld_yz(1-OLy:sNy+OLy,nNz,nSx,nSy)
156			_RL obcs_yz_0(1-OLy:sNy+OLy,nNz,nSx,nSy)
157			_RL obcs_yz_1(1-OLy:sNy+OLy,nNz,nSx,nSy)
158	jmc	1.16	CHARACTER*(MAX_LEN_FNAM) obcs_file
159			CHARACTER*1 obcsmask
160			LOGICAL first, changed
161			LOGICAL useYearlyFields
162	mlosch	1.10	_RL obcs_period
163	jmc	1.16	INTEGER count0, count1, year0, year1
164	heimbach	1.1	_RL fac
165	jmc	1.16	_RL myTime
166			INTEGER myIter
167			INTEGER myThid
168	heimbach	1.1
169			#ifdef ALLOW_OBCS
170
171	jmc	1.17	C == local variables ==
172	heimbach	1.1
173	jmc	1.16	CHARACTER*(128) obcs_file0, obcs_file1
174			INTEGER bi, bj
175			INTEGER j, k
176	heimbach	1.2
177	jmc	1.17	C == end of interface ==
178	heimbach	1.1
179	jmc	1.16	IF ( obcs_file .NE. ' ' ) THEN
180	heimbach	1.5
181	jmc	1.16	IF ( first ) THEN
182	mlosch	1.10
183	jmc	1.16	CALL exf_GetYearlyFieldName(
184			I useYearlyFields, twoDigitYear, obcs_period, year0,
185	mlosch	1.11	I obcs_file,
186			O obcs_file0,
187	jmc	1.16	I myTime, myIter, myThid )
188	mlosch	1.10
189	jmc	1.17	_BARRIER
190			CALL READ_REC_YZ_RL( obcs_file0, exf_iprec_obcs, nNz,
191	jmc	1.16	& obcs_yz_1, count0, myIter, myThid )
192	jmc	1.17	_BARRIER
193	jmc	1.16	ENDIF
194	heimbach	1.1
195	jmc	1.17	IF ( first .OR. changed ) THEN
196			CALL exf_swapffields_yz( obcs_yz_0, obcs_yz_1, nNz,myThid )
197	heimbach	1.1
198	jmc	1.16	CALL exf_GetYearlyFieldName(
199			I useYearlyFields, twoDigitYear, obcs_period, year1,
200	mlosch	1.11	I obcs_file,
201			O obcs_file1,
202	jmc	1.16	I myTime, myIter, myThid )
203	mlosch	1.10
204	jmc	1.17	_BARRIER
205			CALL READ_REC_YZ_RL( obcs_file1, exf_iprec_obcs, nNz,
206	jmc	1.16	& obcs_yz_1, count1, myIter, myThid )
207	jmc	1.17	_BARRIER
208	jmc	1.16	ENDIF
209
210			DO bj = myByLo(myThid),myByHi(myThid)
211			DO bi = myBxLo(myThid),myBxHi(myThid)
212	jmc	1.17	DO k = 1,nNz
213	jmc	1.16	DO j = 1,sNy
214			obcs_fld_yz(j,k,bi,bj) =
215	dimitri	1.13	& fac *obcs_yz_0(j,k,bi,bj) +
216			& (exf_one - fac) *obcs_yz_1(j,k,bi,bj)
217	jmc	1.16	ENDDO
218			ENDDO
219			ENDDO
220			ENDDO
221	heimbach	1.5
222	jmc	1.16	ENDIF
223	heimbach	1.1
224	dimitri	1.8	#endif /* ALLOW_OBCS */
225
226	jmc	1.16	RETURN
227			END
228	dimitri	1.8
229	jmc	1.16	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
230
231			SUBROUTINE EXF_SET_OBCS_X (
232			U obcs_fld_x, obcs_x_0, obcs_x_1,
233			I obcs_file, obcsmask,
234			I fac, first, changed, useYearlyFields, obcs_period,
235			I count0, count1, year0, year1,
236			I myTime, myIter, myThid )
237	dimitri	1.8
238	jmc	1.17	C ==================================================================
239			C SUBROUTINE EXF_SET_OBCS_X
240			C ==================================================================
241			C
242			C o set open boundary conditions
243			C same as EXF_SET_OBCS_XZ but for Nr=1
244			C
245			C ==================================================================
246			C SUBROUTINE EXF_SET_OBCS_X
247			C ==================================================================
248	dimitri	1.8
249	jmc	1.16	IMPLICIT NONE
250	dimitri	1.8
251	jmc	1.17	C == global variables ==
252	dimitri	1.8
253			#include "EEPARAMS.h"
254			#include "SIZE.h"
255			#include "GRID.h"
256			#include "EXF_PARAM.h"
257			#include "EXF_CONSTANTS.h"
258
259	jmc	1.17	C == routine arguments ==
260	dimitri	1.8
261	jmc	1.16	_RL obcs_fld_x(1-OLx:sNx+OLx,nSx,nSy)
262			_RL obcs_x_0(1-OLx:sNx+OLx,nSx,nSy)
263			_RL obcs_x_1(1-OLx:sNx+OLx,nSx,nSy)
264
265			CHARACTER*(128) obcs_file
266			CHARACTER*1 obcsmask
267			LOGICAL first, changed
268			LOGICAL useYearlyFields
269	mlosch	1.10	_RL obcs_period
270	jmc	1.16	INTEGER count0, count1, year0, year1
271	dimitri	1.8	_RL fac
272	jmc	1.16	_RL myTime
273			INTEGER myIter
274			INTEGER myThid
275	dimitri	1.8
276			#ifdef ALLOW_OBCS
277
278	jmc	1.17	C == local variables ==
279	dimitri	1.8
280	jmc	1.16	CHARACTER*(128) obcs_file0, obcs_file1
281			INTEGER bi, bj, i
282	mlosch	1.10
283	jmc	1.17	C == end of interface ==
284
285			STOP 'S/R EXF_SET_OBCS_X no longer maintained'
286	dimitri	1.8
287	jmc	1.16	IF ( obcs_file .NE. ' ' ) THEN
288	dimitri	1.8
289	jmc	1.16	IF ( first ) THEN
290	mlosch	1.10
291	jmc	1.16	CALL exf_GetYearlyFieldName(
292			I useYearlyFields, twoDigitYear, obcs_period, year0,
293	mlosch	1.11	I obcs_file,
294			O obcs_file0,
295	jmc	1.16	I myTime, myIter, myThid )
296	mlosch	1.10
297	jmc	1.16	CALL READ_REC_XZ_RL( obcs_file0, exf_iprec_obcs, 1,
298			& obcs_x_1, count0, myIter, myThid )
299			ENDIF
300	dimitri	1.8
301	jmc	1.16	IF (( first ) .OR. ( changed )) THEN
302	jmc	1.17	CALL exf_swapffields_xz( obcs_x_0, obcs_x_1, 1,myThid )
303	dimitri	1.8
304	jmc	1.16	CALL exf_GetYearlyFieldName(
305			I useYearlyFields, twoDigitYear, obcs_period, year1,
306	mlosch	1.11	I obcs_file,
307			O obcs_file1,
308	jmc	1.16	I myTime, myIter, myThid )
309	mlosch	1.10
310	jmc	1.16	CALL READ_REC_XZ_RL( obcs_file1, exf_iprec_obcs, 1,
311			& obcs_x_1, count1, myIter, myThid )
312			ENDIF
313
314			DO bj = myByLo(myThid),myByHi(myThid)
315			DO bi = myBxLo(myThid),myBxHi(myThid)
316			DO i = 1,sNx
317			obcs_fld_x(i,bi,bj) =
318	dimitri	1.13	& fac * obcs_x_0(i,bi,bj) +
319	dimitri	1.8	& (exf_one - fac) * obcs_x_1(i,bi,bj)
320	jmc	1.16	ENDDO
321			ENDDO
322			ENDDO
323	dimitri	1.8
324	jmc	1.16	ENDIF
325	dimitri	1.8
326			#endif /* ALLOW_OBCS */
327
328	jmc	1.16	RETURN
329			END
330
331			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
332	dimitri	1.8
333	jmc	1.16	SUBROUTINE EXF_SET_OBCS_Y (
334			U obcs_fld_y, obcs_y_0, obcs_y_1,
335			I obcs_file, obcsmask,
336			I fac, first, changed, useYearlyFields, obcs_period,
337			I count0, count1, year0, year1,
338			I myTime, myIter, myThid )
339	dimitri	1.8
340	jmc	1.17	C ==================================================================
341			C SUBROUTINE EXF_SET_OBCS_Y
342			C ==================================================================
343			C
344			C o set open boundary conditions
345			C same as EXF_SET_OBCS_YZ but for Nr=1
346			C
347			C ==================================================================
348			C SUBROUTINE EXF_SET_OBCS_Y
349			C ==================================================================
350	dimitri	1.8
351	jmc	1.16	IMPLICIT NONE
352	dimitri	1.8
353	jmc	1.17	C == global variables ==
354	dimitri	1.8
355			#include "EEPARAMS.h"
356			#include "SIZE.h"
357			#include "GRID.h"
358			#include "EXF_PARAM.h"
359			#include "EXF_CONSTANTS.h"
360
361	jmc	1.17	C == routine arguments ==
362	dimitri	1.8
363	jmc	1.16	_RL obcs_fld_y(1-OLy:sNy+OLy,nSx,nSy)
364			_RL obcs_y_0(1-OLy:sNy+OLy,nSx,nSy)
365			_RL obcs_y_1(1-OLy:sNy+OLy,nSx,nSy)
366			CHARACTER*(MAX_LEN_FNAM) obcs_file
367			CHARACTER*1 obcsmask
368			LOGICAL first, changed
369			LOGICAL useYearlyFields
370	mlosch	1.10	_RL obcs_period
371	jmc	1.16	INTEGER count0, count1, year0, year1
372	dimitri	1.8	_RL fac
373	jmc	1.16	_RL myTime
374			INTEGER myIter
375			INTEGER myThid
376	dimitri	1.8
377			#ifdef ALLOW_OBCS
378
379	jmc	1.17	C == local variables ==
380	dimitri	1.8
381	jmc	1.16	CHARACTER*(128) obcs_file0, obcs_file1
382			INTEGER bi, bj, j
383	mlosch	1.10
384	jmc	1.17	C == end of interface ==
385
386			STOP 'S/R EXF_SET_OBCS_X no longer maintained'
387	dimitri	1.8
388	jmc	1.16	IF ( obcs_file .NE. ' ' ) THEN
389	dimitri	1.8
390	jmc	1.16	IF ( first ) THEN
391	mlosch	1.10
392	jmc	1.16	CALL exf_GetYearlyFieldName(
393			I useYearlyFields, twoDigitYear, obcs_period, year0,
394	mlosch	1.11	I obcs_file,
395			O obcs_file0,
396	jmc	1.16	I myTime, myIter, myThid )
397	mlosch	1.10
398	jmc	1.16	CALL READ_REC_YZ_RL( obcs_file0, exf_iprec_obcs, 1,
399			& obcs_y_1, count0, myIter, myThid )
400			ENDIF
401	dimitri	1.8
402	jmc	1.16	IF (( first ) .OR. ( changed )) THEN
403	jmc	1.17	CALL exf_swapffields_yz( obcs_y_0, obcs_y_1, 1,myThid )
404	dimitri	1.8
405	jmc	1.16	CALL exf_GetYearlyFieldName(
406			I useYearlyFields, twoDigitYear, obcs_period, year1,
407	mlosch	1.11	I obcs_file,
408			O obcs_file1,
409	jmc	1.16	I myTime, myIter, myThid )
410	mlosch	1.10
411	jmc	1.16	CALL READ_REC_YZ_RL( obcs_file1, exf_iprec_obcs, 1,
412			& obcs_y_1, count1, myIter, myThid )
413			ENDIF
414
415			DO bj = myByLo(myThid),myByHi(myThid)
416			DO bi = myBxLo(myThid),myBxHi(myThid)
417			DO j = 1,sNy
418			obcs_fld_y(j,bi,bj) =
419	dimitri	1.13	& fac *obcs_y_0(j,bi,bj) +
420			& (exf_one - fac) *obcs_y_1(j,bi,bj)
421	jmc	1.16	ENDDO
422			ENDDO
423			ENDDO
424	dimitri	1.8
425	jmc	1.16	ENDIF
426	dimitri	1.8
427			#endif /* ALLOW_OBCS */
428	heimbach	1.1
429	jmc	1.16	RETURN
430			END