/[MITgcm]/MITgcm/pkg/obcs/obcs_external_fields_load.F
ViewVC logotype

Diff of /MITgcm/pkg/obcs/obcs_external_fields_load.F

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

revision 1.3 by jmc, Wed Apr 6 18:43:35 2005 UTC revision 1.8 by jmc, Sun Nov 4 03:51:30 2007 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
   
3  #include "OBCS_OPTIONS.h"  #include "OBCS_OPTIONS.h"
4    
5  CBOP  CBOP
6  C     !ROUTINE: OBCS_EXTERNAL_FIELDS_LOAD  C     !ROUTINE: OBCS_EXTERNAL_FIELDS_LOAD
7  C     !INTERFACE:  C     !INTERFACE:
8        SUBROUTINE OBCS_EXTERNAL_FIELDS_LOAD( myTime, myIter, myThid )        SUBROUTINE OBCS_EXTERNAL_FIELDS_LOAD( myTime, myIter, myThid )
9  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
10  C     *==========================================================*  C     *==========================================================*
11  C     | SUBROUTINE OBCS_EXTERNAL_FIELDS_LOAD                            C     | SUBROUTINE OBCS_EXTERNAL_FIELDS_LOAD
12  C     | o Control reading of fields from external source.          C     | o Control reading of fields from external source.
13  C     *==========================================================*  C     *==========================================================*
14  C     | External source field loading routine.                      C     | External source field loading routine for open boundaries.
15  C     | This routine is called every time we want to                C     | This routine is called every time we want to
16  C     | load a a set of external fields. The routine decides        C     | load a a set of external open boundary fields.
17  C     | which fields to load and then reads them in.                C     | Only if there are fields available (file names are not empty)
18  C     | This routine needs to be customised for particular          C     | the open boundary fields are overwritten.
19  C     | experiments.                                                C     | The routine decides which fields to load and then reads them in.
20  C     | Notes                                                      C     | This routine needs to be customised for particular
21  C     | =====                                                      C     | experiments.
22  C     | Two-dimensional and three-dimensional I/O are handled in    C     | Notes
23  C     | the following way under MITgcmUV. A master thread          C     | =====
24  C     | performs I/O using system calls. This threads reads data    C     | Two-dimensional and three-dimensional I/O are handled in
25  C     | into a temporary buffer. At present the buffer is loaded    C     | the following way under MITgcmUV. A master thread
26  C     | with the entire model domain. This is probably OK for now  C     | performs I/O using system calls. This threads reads data
27  C     | Each thread then copies data from the buffer to the        C     | into a temporary buffer. At present the buffer is loaded
28  C     | region of the proper array it is responsible for.    C     | with the entire model domain. This is probably OK for now
29    C     | Each thread then copies data from the buffer to the
30    C     | region of the proper array it is responsible for.
31  C     | =====  C     | =====
32  C     | This routine is the complete analogue to external_fields_load,  C     | This routine is the complete analogue to external_fields_load,
33  C     | except for exchanges of forcing fields. These are done in  C     | except for exchanges of forcing fields. These are done in
# Line 34  C     | obcs_precribe_exchanges, which i Line 35  C     | obcs_precribe_exchanges, which i
35  C     | - Forcing period and cycle are the same as for other fields  C     | - Forcing period and cycle are the same as for other fields
36  C     |   in external forcing.  C     |   in external forcing.
37  C     | - constant boundary values are also read here and not  C     | - constant boundary values are also read here and not
38  C     |   directly in obcs_init_variables (which calls obcs_calc  C     |   directly in obcs_init_variables (which calls obcs_calc
39  C     |   which in turn call this routine)  C     |   which in turn calls this routine)
40  C     *==========================================================*  C     *==========================================================*
41  C     \ev  C     \ev
42    
# Line 46  C     === Global variables === Line 47  C     === Global variables ===
47  #include "EEPARAMS.h"  #include "EEPARAMS.h"
48  #include "PARAMS.h"  #include "PARAMS.h"
49  #include "GRID.h"  #include "GRID.h"
50    
51  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
52  C     === Routine arguments ===  C     === Routine arguments ===
53  C     myThid - Thread no. that called this routine.  C     myThid - Thread no. that called this routine.
# Line 55  C     myIter - Simulation timestep numbe Line 56  C     myIter - Simulation timestep numbe
56        INTEGER myThid        INTEGER myThid
57        _RL     myTime        _RL     myTime
58        INTEGER myIter        INTEGER myIter
59    
 #if (defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE)  
60  C     if external forcing (exf) package is enabled, all loading of external  C     if external forcing (exf) package is enabled, all loading of external
61  C     fields is done by exf  C     fields is done by exf
62  #ifndef ALLOW_EXF  #if (defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE && !defined ALLOW_EXF)
63    C
64  #include "OBCS.h"  #include "OBCS.h"
65    #ifdef ALLOW_PTRACERS
66    #include "PTRACERS_SIZE.h"
67    #include "OBCS_PTRACERS.h"
68    #include "PTRACERS.h"
69    #endif /* ALLOW_PTRACERS */
70    
71  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
72  C     === Local arrays ===  C     === Local arrays ===
73  C     aWght, bWght :: Interpolation weights  C     aWght, bWght :: Interpolation weights
74        INTEGER bi,bj,i,j,k,intime0,intime1  C     msgBuf       :: Informational/error meesage buffer
75          INTEGER intime0,intime1,iTracer
76        _RL aWght,bWght,rdt        _RL aWght,bWght,rdt
77        INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm        INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm
78          CHARACTER*(MAX_LEN_MBUF) msgBuf
79  CEOP  CEOP
80    
81        IF ( periodicExternalForcing ) THEN        IF ( periodicExternalForcing ) THEN
# Line 93  C Now calculate whether it is time to up Line 101  C Now calculate whether it is time to up
101       &  .OR. myIter .EQ. nIter0       &  .OR. myIter .EQ. nIter0
102       & ) THEN       & ) THEN
103    
104           _BARRIER
105         _BEGIN_MASTER(myThid)         _BEGIN_MASTER(myThid)
106    
107  C      If the above condition is met then we need to read in  C      If the above condition is met then we need to read in
108  C      data for the period ahead and the period behind myTime.  C      data for the period ahead and the period behind myTime.
109         WRITE(*,*)         WRITE(msgBuf,'(1X,A,2I5,I10,1P1E20.12)')
110       &  'S/R OBCS_EXTERNAL_FIELDS_LOAD: Reading new data',myTime,myIter       &  'OBCS_EXTERNAL_FIELDS_LOAD: Reading new data:',
111         &  intime0, intime1, myIter, myTime
112           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
113         &                   SQUEEZE_RIGHT,myThid)
114    
115    #ifdef ALLOW_MDSIO
116  #ifdef ALLOW_OBCS_EAST  #ifdef ALLOW_OBCS_EAST
117  C     Eastern boundary  C     Eastern boundary
118        IF ( OBEuFile .NE. ' '  ) THEN        IF ( OBEuFile .NE. ' '  ) THEN
119         CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
120       &        'RL', Nr, OBEu0, intime0, myThid )       &        'RL', Nr, OBEu0, intime0, myThid )
121         CALL MDSREADFIELDXz ( OBEuFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
122       &        'RL', Nr, OBEu1, intime0, myThid )       &        'RL', Nr, OBEu1, intime1, myThid )
123        ENDIF        ENDIF
124        IF ( OBEvFile .NE. ' '  ) THEN        IF ( OBEvFile .NE. ' '  ) THEN
125         CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
126       &        'RL', Nr, OBEv0, intime0, myThid )       &        'RL', Nr, OBEv0, intime0, myThid )
127         CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,
128       &        'RL', Nr, OBEv1, intime0, myThid )       &        'RL', Nr, OBEv1, intime1, myThid )
129        ENDIF        ENDIF
130        IF ( OBEtFile .NE. ' '  ) THEN        IF ( OBEtFile .NE. ' '  ) THEN
131         CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
132       &        'RL', Nr, OBEt0, intime0, myThid )       &        'RL', Nr, OBEt0, intime0, myThid )
133         CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,
134       &        'RL', Nr, OBEt1, intime0, myThid )       &        'RL', Nr, OBEt1, intime1, myThid )
135        ENDIF        ENDIF
136        IF ( OBEsFile .NE. ' '  ) THEN        IF ( OBEsFile .NE. ' '  ) THEN
137         CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
138       &        'RL', Nr, OBEs0, intime0, myThid )       &        'RL', Nr, OBEs0, intime0, myThid )
139         CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,
140       &        'RL', Nr, OBEs1, intime0, myThid )       &        'RL', Nr, OBEs1, intime1, myThid )
141        ENDIF        ENDIF
142  #endif /* ALLOW_OBCS_WEST */  #endif /* ALLOW_OBCS_WEST */
143  #ifdef ALLOW_OBCS_WEST  #ifdef ALLOW_OBCS_WEST
# Line 132  C     Western boundary Line 145  C     Western boundary
145        IF ( OBWuFile .NE. ' '  ) THEN        IF ( OBWuFile .NE. ' '  ) THEN
146         CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
147       &        'RL', Nr, OBWu0, intime0, myThid )       &        'RL', Nr, OBWu0, intime0, myThid )
148         CALL MDSREADFIELDXz ( OBWuFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
149       &        'RL', Nr, OBWu1, intime0, myThid )       &        'RL', Nr, OBWu1, intime1, myThid )
150        ENDIF        ENDIF
151        IF ( OBWvFile .NE. ' '  ) THEN        IF ( OBWvFile .NE. ' '  ) THEN
152         CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
153       &        'RL', Nr, OBWv0, intime0, myThid )       &        'RL', Nr, OBWv0, intime0, myThid )
154         CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,
155       &        'RL', Nr, OBWv1, intime0, myThid )       &        'RL', Nr, OBWv1, intime1, myThid )
156        ENDIF        ENDIF
157        IF ( OBWtFile .NE. ' '  ) THEN        IF ( OBWtFile .NE. ' '  ) THEN
158         CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
159       &        'RL', Nr, OBWt0, intime0, myThid )       &        'RL', Nr, OBWt0, intime0, myThid )
160         CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,
161       &        'RL', Nr, OBWt1, intime0, myThid )       &        'RL', Nr, OBWt1, intime1, myThid )
162        ENDIF        ENDIF
163        IF ( OBWsFile .NE. ' '  ) THEN        IF ( OBWsFile .NE. ' '  ) THEN
164         CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
165       &        'RL', Nr, OBWs0, intime0, myThid )       &        'RL', Nr, OBWs0, intime0, myThid )
166         CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,
167       &        'RL', Nr, OBWs1, intime0, myThid )       &        'RL', Nr, OBWs1, intime1, myThid )
168        ENDIF        ENDIF
169  #endif /* ALLOW_OBCS_WEST */  #endif /* ALLOW_OBCS_WEST */
170  #ifdef ALLOW_OBCS_NORTH  #ifdef ALLOW_OBCS_NORTH
# Line 159  C     Northern boundary Line 172  C     Northern boundary
172        IF ( OBNuFile .NE. ' '  ) THEN        IF ( OBNuFile .NE. ' '  ) THEN
173         CALL MDSREADFIELDXZ ( OBNuFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBNuFile, readBinaryPrec,
174       &        'RL', Nr, OBNu0, intime0, myThid )       &        'RL', Nr, OBNu0, intime0, myThid )
175         CALL MDSREADFIELDXz ( OBNuFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBNuFile, readBinaryPrec,
176       &        'RL', Nr, OBNu1, intime0, myThid )       &        'RL', Nr, OBNu1, intime1, myThid )
177        ENDIF        ENDIF
178        IF ( OBNvFile .NE. ' '  ) THEN        IF ( OBNvFile .NE. ' '  ) THEN
179         CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
180       &        'RL', Nr, OBNv0, intime0, myThid )       &        'RL', Nr, OBNv0, intime0, myThid )
181         CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,
182       &        'RL', Nr, OBNv1, intime0, myThid )       &        'RL', Nr, OBNv1, intime1, myThid )
183        ENDIF        ENDIF
184        IF ( OBNtFile .NE. ' '  ) THEN        IF ( OBNtFile .NE. ' '  ) THEN
185         CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
186       &        'RL', Nr, OBNt0, intime0, myThid )       &        'RL', Nr, OBNt0, intime0, myThid )
187         CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,
188       &        'RL', Nr, OBNt1, intime0, myThid )       &        'RL', Nr, OBNt1, intime1, myThid )
189        ENDIF        ENDIF
190        IF ( OBNsFile .NE. ' '  ) THEN        IF ( OBNsFile .NE. ' '  ) THEN
191         CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
192       &        'RL', Nr, OBNs0, intime0, myThid )       &        'RL', Nr, OBNs0, intime0, myThid )
193         CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,
194       &        'RL', Nr, OBNs1, intime0, myThid )       &        'RL', Nr, OBNs1, intime1, myThid )
195        ENDIF        ENDIF
196  #endif /* ALLOW_OBCS_NORTH */  #endif /* ALLOW_OBCS_NORTH */
197  #ifdef ALLOW_OBCS_SOUTH  #ifdef ALLOW_OBCS_SOUTH
# Line 186  C     Southern boundary Line 199  C     Southern boundary
199        IF ( OBSuFile .NE. ' '  ) THEN        IF ( OBSuFile .NE. ' '  ) THEN
200         CALL MDSREADFIELDXZ ( OBSuFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBSuFile, readBinaryPrec,
201       &        'RL', Nr, OBSu0, intime0, myThid )       &        'RL', Nr, OBSu0, intime0, myThid )
202         CALL MDSREADFIELDXz ( OBSuFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBSuFile, readBinaryPrec,
203       &        'RL', Nr, OBSu1, intime0, myThid )       &        'RL', Nr, OBSu1, intime1, myThid )
204        ENDIF        ENDIF
205        IF ( OBSvFile .NE. ' '  ) THEN        IF ( OBSvFile .NE. ' '  ) THEN
206         CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
207       &        'RL', Nr, OBSv0, intime0, myThid )       &        'RL', Nr, OBSv0, intime0, myThid )
208         CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,
209       &        'RL', Nr, OBSv1, intime0, myThid )       &        'RL', Nr, OBSv1, intime1, myThid )
210        ENDIF        ENDIF
211        IF ( OBStFile .NE. ' '  ) THEN        IF ( OBStFile .NE. ' '  ) THEN
212         CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
213       &        'RL', Nr, OBSt0, intime0, myThid )       &        'RL', Nr, OBSt0, intime0, myThid )
214         CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,
215       &        'RL', Nr, OBSt1, intime0, myThid )       &        'RL', Nr, OBSt1, intime1, myThid )
216        ENDIF        ENDIF
217        IF ( OBSsFile .NE. ' '  ) THEN        IF ( OBSsFile .NE. ' '  ) THEN
218         CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
219       &        'RL', Nr, OBSs0, intime0, myThid )       &        'RL', Nr, OBSs0, intime0, myThid )
220         CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,
221       &        'RL', Nr, OBSs1, intime0, myThid )       &        'RL', Nr, OBSs1, intime1, myThid )
222        ENDIF        ENDIF
223  #endif /* ALLOW_OBCS_SOUTH */  #endif /* ALLOW_OBCS_SOUTH */
224    #ifdef ALLOW_PTRACERS
225          IF (usePTRACERS) THEN
226    C     read boundary values for passive tracers
227           DO iTracer = 1, PTRACERS_numInUse
228    # ifdef ALLOW_OBCS_EAST
229    C     Eastern boundary
230            IF ( OBEptrFile(iTracer) .NE. ' '  ) THEN
231             CALL MDSREADFIELDYZ ( OBEptrFile(itracer), readBinaryPrec,
232         &        'RL', Nr, OBEptr0(1-Oly,1,1,1,iTracer),
233         &        intime0, myThid )
234             CALL MDSREADFIELDYZ ( OBEptrFile(itracer), readBinaryPrec,
235         &        'RL', Nr, OBEptr1(1-Oly,1,1,1,iTracer),
236         &        intime1, myThid )
237            ENDIF
238    # endif /* ALLOW_OBCS_WEST */
239    # ifdef ALLOW_OBCS_WEST
240    C     Western boundary
241            IF ( OBWptrFile(iTracer) .NE. ' '  ) THEN
242             CALL MDSREADFIELDYZ ( OBWptrFile(itracer), readBinaryPrec,
243         &        'RL', Nr, OBWptr0(1-Oly,1,1,1,iTracer),
244         &        intime0, myThid )
245             CALL MDSREADFIELDYZ ( OBWptrFile(itracer), readBinaryPrec,
246         &        'RL', Nr, OBWptr1(1-Oly,1,1,1,iTracer),
247         &        intime1, myThid )
248            ENDIF
249    # endif /* ALLOW_OBCS_WEST */
250    # ifdef ALLOW_OBCS_NORTH
251    C     Northern boundary
252            IF ( OBNptrFile(iTracer) .NE. ' '  ) THEN
253             CALL MDSREADFIELDXZ ( OBNptrFile(itracer), readBinaryPrec,
254         &        'RL', Nr, OBNptr0(1-Olx,1,1,1,iTracer),
255         &        intime0, myThid )
256             CALL MDSREADFIELDXZ ( OBNptrFile(itracer), readBinaryPrec,
257         &        'RL', Nr, OBNptr1(1-Olx,1,1,1,iTracer),
258         &        intime1, myThid )
259            ENDIF
260    # endif /* ALLOW_OBCS_NORTH */
261    # ifdef ALLOW_OBCS_SOUTH
262    C     Southern boundary
263            IF ( OBSptrFile(iTracer) .NE. ' '  ) THEN
264             CALL MDSREADFIELDXZ ( OBSptrFile(itracer), readBinaryPrec,
265         &        'RL', Nr, OBSptr0(1-Olx,1,1,1,iTracer),
266         &        intime0, myThid )
267             CALL MDSREADFIELDXZ ( OBSptrFile(itracer), readBinaryPrec,
268         &        'RL', Nr, OBSptr1(1-Olx,1,1,1,iTracer),
269         &        intime1, myThid )
270            ENDIF
271    # endif /* ALLOW_OBCS_SOUTH */
272    C     end do iTracer
273           ENDDO
274    C     end if (usePTRACERS)
275          ENDIF
276    #endif /* ALLOW_PTRACERS */
277    #else /* ALLOW_MDSIO */
278          STOP 'ABNORMAL END: OBCS_EXTERNAL_FIELDS_LOAD: NEEDS MSDIO PKG'
279    #endif /* ALLOW_MDSIO */
280    
281         _END_MASTER(myThid)         _END_MASTER(myThid)
282  C  C
283  C     At this point in external_fields_load the input fields are exchanged.  C     At this point in external_fields_load the input fields are exchanged.
284  C     However, we do not have exchange routines for vertical  C     However, we do not have exchange routines for vertical
285  C     slices and they are not planned, either, so the approriate fields  C     slices and they are not planned, either, so the approriate fields
286  C     are exchanged after the open boundary conditions have been  C     are exchanged after the open boundary conditions have been
287  C     applied. (in DYNAMICS and DO_FIELDS_BLOCKING_EXCHANGES)  C     applied. (in DYNAMICS and DO_FIELDS_BLOCKING_EXCHANGES)
288  C         _BARRIER
289    
290    C     end if time to read new data
291        ENDIF        ENDIF
292    
 C--   Interpolate OBSu, OBSv, OBSt, OBSs  
       DO bj = myByLo(myThid), myByHi(myThid)  
        DO bi = myBxLo(myThid), myBxHi(myThid)  
         DO K = 1, Nr  
          DO j=1-Oly,sNy+Oly  
 #ifdef ALLOW_OBCS_EAST  
           OBEu(j,k,bi,bj)   = bWght*OBEu0(j,k,bi,bj)    
      &                       +aWght*OBEu1(j,k,bi,bj)  
           OBEv(j,k,bi,bj)   = bWght*OBEv0(j,k,bi,bj)    
      &                       +aWght*OBEv1(j,k,bi,bj)  
           OBEt(j,k,bi,bj)   = bWght*OBEt0(j,k,bi,bj)    
      &                       +aWght*OBEt1(j,k,bi,bj)  
           OBEs(j,k,bi,bj)   = bWght*OBEs0(j,k,bi,bj)    
      &                       +aWght*OBEs1(j,k,bi,bj)  
 #endif /* ALLOW_OBCS_EAST */  
 #ifdef ALLOW_OBCS_WEST  
           OBWu(j,k,bi,bj)   = bWght*OBWu0(j,k,bi,bj)    
      &                       +aWght*OBWu1(j,k,bi,bj)  
           OBWv(j,k,bi,bj)   = bWght*OBWv0(j,k,bi,bj)    
      &                       +aWght*OBWv1(j,k,bi,bj)  
           OBWt(j,k,bi,bj)   = bWght*OBWt0(j,k,bi,bj)    
      &                       +aWght*OBWt1(j,k,bi,bj)  
           OBWs(j,k,bi,bj)   = bWght*OBWs0(j,k,bi,bj)    
      &                       +aWght*OBWs1(j,k,bi,bj)  
 #endif /* ALLOW_OBCS_WEST */  
          ENDDO    
          DO i=1-Olx,sNx+Olx  
 #ifdef ALLOW_OBCS_NORTH  
           OBNu(i,k,bi,bj)   = bWght*OBNu0(i,k,bi,bj)    
      &                       +aWght*OBNu1(i,k,bi,bj)  
           OBNv(i,k,bi,bj)   = bWght*OBNv0(i,k,bi,bj)    
      &                       +aWght*OBNv1(i,k,bi,bj)  
           OBNt(i,k,bi,bj)   = bWght*OBNt0(i,k,bi,bj)    
      &                       +aWght*OBNt1(i,k,bi,bj)  
           OBNs(i,k,bi,bj)   = bWght*OBNs0(i,k,bi,bj)    
      &                       +aWght*OBNs1(i,k,bi,bj)  
 #endif /* ALLOW_OBCS_NORTH */  
 #ifdef ALLOW_OBCS_SOUTH  
           OBSu(i,k,bi,bj)   = bWght*OBSu0(i,k,bi,bj)    
      &                       +aWght*OBSu1(i,k,bi,bj)  
           OBSv(i,k,bi,bj)   = bWght*OBSv0(i,k,bi,bj)    
      &                       +aWght*OBSv1(i,k,bi,bj)  
           OBSt(i,k,bi,bj)   = bWght*OBSt0(i,k,bi,bj)    
      &                       +aWght*OBSt1(i,k,bi,bj)  
           OBSs(i,k,bi,bj)   = bWght*OBSs0(i,k,bi,bj)    
      &                       +aWght*OBSs1(i,k,bi,bj)  
 #endif /* ALLOW_OBCS_SOUTH */  
          ENDDO  
         ENDDO  
        ENDDO  
       ENDDO  
293  C     if not periodicForcing  C     if not periodicForcing
294        ELSE        ELSE
295           aWght = 0. _d 0
296           bWght = 1. _d 0
297  C     read boundary values once and for all  C     read boundary values once and for all
298         IF ( myIter .EQ. nIter0 ) THEN         IF ( myIter .EQ. nIter0 ) THEN
299            _BARRIER
300          _BEGIN_MASTER(myThid)          _BEGIN_MASTER(myThid)
301  C      Read constant boundary conditions only for myIter = nIter0  C      Read constant boundary conditions only for myIter = nIter0
302         WRITE(*,*)          WRITE(msgBuf,'(1X,A,I10,1P1E20.12)')
303       &  'S/R OBCS_EXTERNAl_FIELDS_LOAD: Reading new data',myTime,myIter       &       'OBCS_EXTERNAL_FIELDS_LOAD: Reading initial data:',
304         inTime0 = 1       &       myIter, myTime
305            CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
306         &       SQUEEZE_RIGHT,myThid)
307            inTime0 = 1
308    #ifdef ALLOW_MDSIO
309  #ifdef ALLOW_OBCS_EAST  #ifdef ALLOW_OBCS_EAST
310  C     Eastern boundary  C     Eastern boundary
311          IF ( OBEuFile .NE. ' '  ) THEN          IF ( OBEuFile .NE. ' '  ) THEN
# Line 354  C     Southern boundary Line 382  C     Southern boundary
382       &        'RL', Nr, OBSs0, inTime0, myThid )       &        'RL', Nr, OBSs0, inTime0, myThid )
383          ENDIF          ENDIF
384  #endif /* ALLOW_OBCS_SOUTH */  #endif /* ALLOW_OBCS_SOUTH */
385    #ifdef ALLOW_PTRACERS
386            IF (usePTRACERS) THEN
387    C     read passive tracer boundary values
388             DO iTracer = 1, PTRACERS_numInUse
389    # ifdef ALLOW_OBCS_EAST
390    C     Eastern boundary
391              IF ( OBEptrFile(iTracer) .NE. ' '  ) THEN
392               CALL MDSREADFIELDYZ ( OBEptrFile(iTracer), readBinaryPrec,
393         &          'RL', Nr, OBEptr0(1-Oly,1,1,1,iTracer),
394         &          inTime0, myThid )
395              ENDIF
396    # endif /* ALLOW_OBCS_WEST */
397    # ifdef ALLOW_OBCS_WEST
398    C     Western boundary
399              IF ( OBWptrFile(iTracer) .NE. ' '  ) THEN
400               CALL MDSREADFIELDYZ ( OBWptrFile(iTracer), readBinaryPrec,
401         &          'RL', Nr, OBWptr0(1-Oly,1,1,1,iTracer),
402         &          inTime0, myThid )
403              ENDIF
404    # endif /* ALLOW_OBCS_WEST */
405    # ifdef ALLOW_OBCS_NORTH
406    C     Northern boundary
407              IF ( OBNptrFile(iTracer) .NE. ' '  ) THEN
408               CALL MDSREADFIELDXZ ( OBNptrFile(iTracer), readBinaryPrec,
409         &          'RL', Nr, OBNptr0(1-Olx,1,1,1,iTracer),
410         &          inTime0, myThid )
411              ENDIF
412    # endif /* ALLOW_OBCS_NORTH */
413    # ifdef ALLOW_OBCS_SOUTH
414    C     Southern boundary
415              IF ( OBSptrFile(iTracer) .NE. ' '  ) THEN
416               CALL MDSREADFIELDXZ ( OBSptrFile(iTracer), readBinaryPrec,
417         &          'RL', Nr, OBSptr0(1-Olx,1,1,1,iTracer),
418         &          inTime0, myThid )
419              ENDIF
420    # endif /* ALLOW_OBCS_SOUTH */
421    C     end do iTracer
422             ENDDO
423    C     end if (usePTRACERS)
424            ENDIF
425    #endif /* ALLOW_PTRACERS */
426    #else /* ALLOW_MDSIO */
427          STOP 'ABNORMAL END: OBCS_EXTERNAL_FIELDS_LOAD: NEEDS MSDIO PKG'
428    #endif /* ALLOW_MDSIO */
429          _END_MASTER(myThid)          _END_MASTER(myThid)
430            _BARRIER
431  C     endif myIter .EQ. nIter0  C     endif myIter .EQ. nIter0
432         ENDIF         ENDIF
433         DO bj = myByLo(myThid), myByHi(myThid)  C     endif for periodicForcing
434          DO bi = myBxLo(myThid), myBxHi(myThid)        ENDIF
435           DO K = 1, Nr  
436            DO j=1-Oly,sNy+Oly  C--   Now interpolate OBSu, OBSv, OBSt, OBSs, OBSptr, etc.
437    C--   For periodicForcing, aWght = 0. and bWght = 1. so that the
438    C--   interpolation boilds down to copying the time-independent
439    C--   forcing field OBSu0 to OBSu
440  #ifdef ALLOW_OBCS_EAST  #ifdef ALLOW_OBCS_EAST
441             OBEu(j,k,bi,bj) = OBEu0(j,k,bi,bj)           IF ( OBEuFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
442             OBEv(j,k,bi,bj) = OBEv0(j,k,bi,bj)         &      OBEu, OBEu0, OBEu1, aWght, bWght, myThid )
443             OBEt(j,k,bi,bj) = OBEt0(j,k,bi,bj)           IF ( OBEvFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
444             OBEs(j,k,bi,bj) = OBEs0(j,k,bi,bj)         &      OBEv, OBEv0, OBEv1, aWght, bWght, myThid )
445           IF ( OBEtFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
446         &      OBEt, OBEt0, OBEt1, aWght, bWght, myThid )
447           IF ( OBEsFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
448         &      OBEs, OBEs0, OBEs1, aWght, bWght, myThid )
449  #endif /* ALLOW_OBCS_EAST */  #endif /* ALLOW_OBCS_EAST */
450  #ifdef ALLOW_OBCS_WEST  #ifdef ALLOW_OBCS_WEST
451             OBWu(j,k,bi,bj) = OBWu0(j,k,bi,bj)           IF ( OBWuFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
452             OBWv(j,k,bi,bj) = OBWv0(j,k,bi,bj)         &      OBWu, OBWu0, OBWu1, aWght, bWght, myThid )
453             OBWt(j,k,bi,bj) = OBWt0(j,k,bi,bj)           IF ( OBWvFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
454             OBWs(j,k,bi,bj) = OBWs0(j,k,bi,bj)         &      OBWv, OBWv0, OBWv1, aWght, bWght, myThid )
455           IF ( OBWtFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
456         &      OBWt, OBWt0, OBWt1, aWght, bWght, myThid )
457           IF ( OBWsFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
458         &      OBWs, OBWs0, OBWs1, aWght, bWght, myThid )
459  #endif /* ALLOW_OBCS_WEST */  #endif /* ALLOW_OBCS_WEST */
           ENDDO  
           DO i=1-Olx,sNx+Olx  
460  #ifdef ALLOW_OBCS_NORTH  #ifdef ALLOW_OBCS_NORTH
461             OBNu(i,k,bi,bj) = OBNu0(i,k,bi,bj)           IF ( OBNuFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
462             OBNv(i,k,bi,bj) = OBNv0(i,k,bi,bj)         &      OBNu, OBNu0, OBNu1, aWght, bWght, myThid )
463             OBNt(i,k,bi,bj) = OBNt0(i,k,bi,bj)           IF ( OBNvFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
464             OBNs(i,k,bi,bj) = OBNs0(i,k,bi,bj)         &      OBNv, OBNv0, OBNv1, aWght, bWght, myThid )
465           IF ( OBNtFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
466         &      OBNt, OBNt0, OBNt1, aWght, bWght, myThid )
467           IF ( OBNsFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
468         &      OBNs, OBNs0, OBNs1, aWght, bWght, myThid )
469  #endif /* ALLOW_OBCS_NORTH */  #endif /* ALLOW_OBCS_NORTH */
470  #ifdef ALLOW_OBCS_SOUTH  #ifdef ALLOW_OBCS_SOUTH
471             OBSu(i,k,bi,bj) = OBSu0(i,k,bi,bj)           IF ( OBSuFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
472             OBSv(i,k,bi,bj) = OBSv0(i,k,bi,bj)         &      OBSu, OBSu0, OBSu1, aWght, bWght, myThid )
473             OBSt(i,k,bi,bj) = OBSt0(i,k,bi,bj)           IF ( OBSvFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
474             OBSs(i,k,bi,bj) = OBSs0(i,k,bi,bj)         &      OBSv, OBSv0, OBSv1, aWght, bWght, myThid )
475           IF ( OBStFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
476         &      OBSt, OBSt0, OBSt1, aWght, bWght, myThid )
477           IF ( OBSsFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
478         &      OBSs, OBSs0, OBSs1, aWght, bWght, myThid )
479  #endif /* ALLOW_OBCS_SOUTH */  #endif /* ALLOW_OBCS_SOUTH */
480    #ifdef ALLOW_PTRACERS
481          IF (usePTRACERS) THEN
482    C     "interpolate" passive tracer boundary values
483           DO iTracer = 1, PTRACERS_numInUse
484    # ifdef ALLOW_OBCS_EAST
485            IF ( OBEptrFile(iTracer) .NE. ' '  )
486         &       CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
487         O       OBEptr (1-Oly,1,1,1,iTracer),
488         I       OBEptr0(1-Oly,1,1,1,iTracer),
489         I       OBEptr1(1-Oly,1,1,1,iTracer), aWght, bWght, myThid )
490    # endif /* ALLOW_OBCS_EAST */
491    # ifdef ALLOW_OBCS_WEST
492            IF ( OBWptrFile(iTracer) .NE. ' '  )
493         &       CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
494         O       OBWptr (1-Oly,1,1,1,iTracer),
495         I       OBWptr0(1-Oly,1,1,1,iTracer),
496         I       OBWptr1(1-Oly,1,1,1,iTracer), aWght, bWght, myThid )
497    # endif /* ALLOW_OBCS_WEST */
498    # ifdef ALLOW_OBCS_NORTH
499            IF ( OBNptrFile(iTracer) .NE. ' '  )
500         &       CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
501         O       OBNptr (1-Olx,1,1,1,iTracer),
502         I       OBNptr0(1-Olx,1,1,1,iTracer),
503         I       OBNptr1(1-Olx,1,1,1,iTracer), aWght, bWght, myThid )
504    # endif /* ALLOW_OBCS_NORTH */
505    # ifdef ALLOW_OBCS_SOUTH
506            IF ( OBSptrFile(iTracer) .NE. ' '  )
507         &       CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
508         O       OBSptr (1-Olx,1,1,1,iTracer),
509         I       OBSptr0(1-Olx,1,1,1,iTracer),
510         I       OBSptr1(1-Olx,1,1,1,iTracer), aWght, bWght, myThid )
511    # endif /* ALLOW_OBCS_SOUTH */
512    C     end do iTracer
513           ENDDO
514    C     end if (usePTRACERS)
515          ENDIF
516    #endif /* ALLOW_PTRACERS */
517    CMLC     endif for periodicForcing
518    CML      ENDIF
519    
520          RETURN
521          END
522    
523    CBOP
524    C     !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_XZ
525    C     !INTERFACE:
526          SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ(
527         O     fld,
528         I     fld0, fld1, aWght, bWght, myThid )
529    C     !DESCRIPTION: \bv
530    C     *==========================================================*
531    C     | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ
532    C     | o Interpolate between to records
533    C     *==========================================================*
534    C     \ev
535    
536    C     !USES:
537          IMPLICIT NONE
538    C     === Global variables ===
539    #include "SIZE.h"
540    #include "EEPARAMS.h"
541    #include "PARAMS.h"
542    
543    C     !INPUT/OUTPUT PARAMETERS:
544    C     === Routine arguments ===
545    C     myThid - Thread no. that called this routine.
546    C     aWght, bWght :: Interpolation weights
547          INTEGER myThid
548          _RL aWght,bWght
549          _RL fld (1-Olx:sNx+Olx,Nr,nSx,nSy)
550          _RL fld0(1-Olx:sNx+Olx,Nr,nSx,nSy)
551          _RL fld1(1-Olx:sNx+Olx,Nr,nSx,nSy)
552    
553    C     !LOCAL VARIABLES:
554    C     === Local arrays ===
555    C     bi,bj,i,j :: loop counters
556          INTEGER bi,bj,i,k
557    CEOP
558           DO bj = myByLo(myThid), myByHi(myThid)
559            DO bi = myBxLo(myThid), myBxHi(myThid)
560             DO K = 1, Nr
561              DO i=1-Olx,sNx+Olx
562               fld(i,k,bi,bj)   = bWght*fld0(i,k,bi,bj)
563         &                       +aWght*fld1(i,k,bi,bj)
564            ENDDO            ENDDO
565           ENDDO           ENDDO
566          ENDDO          ENDDO
567         ENDDO             ENDDO
 C     endif for periodicForcing  
       ENDIF  
   
 #endif /* ALLOW_EXF */  
 #endif /* ALLOw_OBCS AND ALLOW_OBCS_PRESCRIBE */  
568    
569        RETURN        RETURN
570        END        END
571    CBOP
572    C     !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_YZ
573    C     !INTERFACE:
574          SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ(
575         O     fld,
576         I     fld0, fld1, aWght, bWght, myThid )
577    C     !DESCRIPTION: \bv
578    C     *==========================================================*
579    C     | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ
580    C     | o Interpolate between to records
581    C     *==========================================================*
582    C     \ev
583    
584    C     !USES:
585          IMPLICIT NONE
586    C     === Global variables ===
587    #include "SIZE.h"
588    #include "EEPARAMS.h"
589    #include "PARAMS.h"
590    
591    C     !INPUT/OUTPUT PARAMETERS:
592    C     === Routine arguments ===
593    C     myThid - Thread no. that called this routine.
594    C     aWght, bWght :: Interpolation weights
595          INTEGER myThid
596          _RL aWght,bWght
597          _RL fld (1-Oly:sNy+Oly,Nr,nSx,nSy)
598          _RL fld0(1-Oly:sNy+Oly,Nr,nSx,nSy)
599          _RL fld1(1-Oly:sNy+Oly,Nr,nSx,nSy)
600    
601    C     !LOCAL VARIABLES:
602    C     === Local arrays ===
603    C     bi,bj,i,j :: loop counters
604          INTEGER bi,bj,j,k
605    CEOP
606           DO bj = myByLo(myThid), myByHi(myThid)
607            DO bi = myBxLo(myThid), myBxHi(myThid)
608             DO K = 1, Nr
609              DO j=1-Oly,sNy+Oly
610               fld(j,k,bi,bj)   = bWght*fld0(j,k,bi,bj)
611         &                       +aWght*fld1(j,k,bi,bj)
612              ENDDO
613             ENDDO
614            ENDDO
615           ENDDO    
616    
617    #endif /* ALLOW_OBCS AND ALLOW_OBCS_PRESCRIBE AND .NOT. ALLOW_EXF */
618    
619           RETURN
620           END
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22