/[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.1 by mlosch, Fri Sep 24 12:32:09 2004 UTC revision 1.14 by jmc, Sun Oct 4 21:52:25 2009 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        LOGICAL DIFFERENT_MULTIPLE  #include "OBCS.h"
51        EXTERNAL DIFFERENT_MULTIPLE  #ifdef ALLOW_PTRACERS
52    #include "PTRACERS_SIZE.h"
53    #include "OBCS_PTRACERS.h"
54    #include "PTRACERS_PARAMS.h"
55    c#include "PTRACERS_FIELDS.h"
56    #endif /* ALLOW_PTRACERS */
57    
58  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
59  C     === Routine arguments ===  C     === Routine arguments ===
60  C     myThid - Thread no. that called this routine.  C     myTime :: Simulation time
61  C     myTime - Simulation time  C     myIter :: Simulation timestep number
62  C     myIter - Simulation timestep number  C     myThid :: Thread no. that called this routine.
       INTEGER myThid  
63        _RL     myTime        _RL     myTime
64        INTEGER myIter        INTEGER myIter
65          INTEGER myThid
66  #if (defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE)  
67  C     if external forcing (exf) package is enabled, all loading of external  C     if external forcing (exf) package is enabled (useEXF=T), all loading of
68  C     fields is done by exf  C     external fields is done by exf
69  #ifndef ALLOW_EXF  #if (defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE )
 #include "OBCS.h"  
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    #ifdef NONLIN_FRSURF
76          INTEGER i,j,bi,bj
77    #endif /* NONLIN_FRSURF */
78          INTEGER fp
79          INTEGER iRec0, iRec1, iTr
80        _RL aWght,bWght,rdt        _RL aWght,bWght,rdt
81        INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm        INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm
82          CHARACTER*(MAX_LEN_MBUF) msgBuf
83  CEOP  CEOP
84    
85          fp = readBinaryPrec
86    
87        IF ( periodicExternalForcing ) THEN        IF ( periodicExternalForcing ) THEN
88    
89  C Now calculate whether it is time to update the forcing arrays  C Now calculate whether it is time to update the forcing arrays
90        rdt=1. _d 0 / deltaTclock        rdt = 1. _d 0 / deltaTclock
91        nForcingPeriods=int(externForcingCycle/externForcingPeriod+0.5)        nForcingPeriods = NINT(externForcingCycle/externForcingPeriod)
92        Imytm=int(myTime*rdt+0.5)        Imytm = NINT(myTime*rdt)
93        Ifprd=int(externForcingPeriod*rdt+0.5)        Ifprd = NINT(externForcingPeriod*rdt)
94        Ifcyc=int(externForcingCycle*rdt+0.5)        Ifcyc = NINT(externForcingCycle*rdt)
95        Iftm=mod( Imytm+Ifcyc-Ifprd/2 ,Ifcyc)        Iftm  = MOD( Imytm+Ifcyc-Ifprd/2, Ifcyc)
96    
97        intime0=int(Iftm/Ifprd)        iRec0 = 1 + INT(Iftm/Ifprd)
98        intime1=mod(intime0+1,nForcingPeriods)        iRec1 = 1 + MOD(iRec0,nForcingPeriods)
99        aWght=float( Iftm-Ifprd*intime0 )/float( Ifprd )  c     aWght = DFLOAT( Iftm-Ifprd*(iRec0 - 1) ) / DFLOAT( Ifprd )
100        bWght=1.-aWght        aWght = FLOAT( Iftm-Ifprd*(iRec0 - 1) )
101          bWght = FLOAT( Ifprd )
102        intime0=intime0+1        aWght =  aWght / bWght
103        intime1=intime1+1        bWght = 1. _d 0 - aWght
104    
105        IF (        IF (
106       &  Iftm-Ifprd*(intime0-1) .EQ. 0       &  Iftm-Ifprd*(iRec0-1) .EQ. 0
107       &  .OR. myIter .EQ. nIter0       &  .OR. myIter .EQ. nIter0
108       & ) THEN       & ) THEN
109    
110         _BEGIN_MASTER(myThid)  #ifndef ALLOW_MDSIO
111           STOP 'ABNORMAL END: OBCS_EXTERNAL_FIELDS_LOAD: NEEDS MSDIO PKG'
112    #endif /* ALLOW_MDSIO */
113    
114           _BARRIER
115    
116  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
117  C      data for the period ahead and the period behind myTime.  C      data for the period ahead and the period behind myTime.
118         WRITE(*,*)         WRITE(msgBuf,'(1X,A,2I5,I10,1P1E20.12)')
119       &  'S/R OBCS_EXTERNAL_FIELDS_LOAD: Reading new data',myTime,myIter       &  'OBCS_EXTERNAL_FIELDS_LOAD: Reading new data:',
120         &  iRec0, iRec1, myIter, myTime
121           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
122         &                   SQUEEZE_RIGHT,myThid)
123    
124  #ifdef ALLOW_OBCS_WEST  #ifdef ALLOW_OBCS_EAST
125  C     Eastern boundary  C     Eastern boundary
126        IF ( OBEuFile .NE. ' '  ) THEN        IF ( OBEuFile .NE. ' '  ) THEN
127         CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,         CALL READ_REC_YZ_RL( OBEuFile, fp,Nr,OBEu0,iRec0,myIter,myThid )
128       &        'RL', Nr, OBEu0, intime0, myThid )         CALL READ_REC_YZ_RL( OBEuFile, fp,Nr,OBEu1,iRec1,myIter,myThid )
        CALL MDSREADFIELDXz ( OBEuFile, readBinaryPrec,  
      &        'RL', Nr, OBEu1, intime0, myThid )  
129        ENDIF        ENDIF
130        IF ( OBEvFile .NE. ' '  ) THEN        IF ( OBEvFile .NE. ' '  ) THEN
131         CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,         CALL READ_REC_YZ_RL( OBEvFile, fp,Nr,OBEv0,iRec0,myIter,myThid )
132       &        'RL', Nr, OBEv0, intime0, myThid )         CALL READ_REC_YZ_RL( OBEvFile, fp,Nr,OBEv1,iRec1,myIter,myThid )
        CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,  
      &        'RL', Nr, OBEv1, intime0, myThid )  
133        ENDIF        ENDIF
134        IF ( OBEuFile .NE. ' '  ) THEN        IF ( OBEtFile .NE. ' '  ) THEN
135         CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,         CALL READ_REC_YZ_RL( OBEtFile, fp,Nr,OBEt0,iRec0,myIter,myThid )
136       &        'RL', Nr, OBEt0, intime0, myThid )         CALL READ_REC_YZ_RL( OBEtFile, fp,Nr,OBEt1,iRec1,myIter,myThid )
137         CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,        ENDIF
138       &        'RL', Nr, OBEt1, intime0, myThid )        IF ( OBEsFile .NE. ' '  ) THEN
139        ENDIF         CALL READ_REC_YZ_RL( OBEsFile, fp,Nr,OBEs0,iRec0,myIter,myThid )
140        IF ( OBEuFile .NE. ' '  ) THEN         CALL READ_REC_YZ_RL( OBEsFile, fp,Nr,OBEs1,iRec1,myIter,myThid )
141         CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,        ENDIF
142       &        'RL', Nr, OBEs0, intime0, myThid )  # ifdef NONLIN_FRSURF
143         CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,        IF ( OBEetaFile .NE. ' '  ) THEN
144       &        'RL', Nr, OBEs1, intime0, myThid )         CALL READ_REC_YZ_RL(OBEetaFile,fp,1,OBEeta0,iRec0,myIter,myThid)
145           CALL READ_REC_YZ_RL(OBEetaFile,fp,1,OBEeta1,iRec1,myIter,myThid)
146        ENDIF        ENDIF
147  #endif /* ALLOW_OBCS_WEST */  # endif /* NONLIN_FRSURF */
148    #endif /* ALLOW_OBCS_EAST */
149  #ifdef ALLOW_OBCS_WEST  #ifdef ALLOW_OBCS_WEST
150  C     Western boundary  C     Western boundary
151        IF ( OBWuFile .NE. ' '  ) THEN        IF ( OBWuFile .NE. ' '  ) THEN
152         CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,         CALL READ_REC_YZ_RL( OBWuFile, fp,Nr,OBWu0,iRec0,myIter,myThid )
153       &        'RL', Nr, OBWu0, intime0, myThid )         CALL READ_REC_YZ_RL( OBWuFile, fp,Nr,OBWu1,iRec1,myIter,myThid )
        CALL MDSREADFIELDXz ( OBWuFile, readBinaryPrec,  
      &        'RL', Nr, OBWu1, intime0, myThid )  
154        ENDIF        ENDIF
155        IF ( OBWvFile .NE. ' '  ) THEN        IF ( OBWvFile .NE. ' '  ) THEN
156         CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,         CALL READ_REC_YZ_RL( OBWvFile, fp,Nr,OBWv0,iRec0,myIter,myThid )
157       &        'RL', Nr, OBWv0, intime0, myThid )         CALL READ_REC_YZ_RL( OBWvFile, fp,Nr,OBWv1,iRec1,myIter,myThid )
        CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,  
      &        'RL', Nr, OBWv1, intime0, myThid )  
158        ENDIF        ENDIF
159        IF ( OBWuFile .NE. ' '  ) THEN        IF ( OBWtFile .NE. ' '  ) THEN
160         CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,         CALL READ_REC_YZ_RL( OBWtFile, fp,Nr,OBWt0,iRec0,myIter,myThid )
161       &        'RL', Nr, OBWt0, intime0, myThid )         CALL READ_REC_YZ_RL( OBWtFile, fp,Nr,OBWt1,iRec1,myIter,myThid )
162         CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,        ENDIF
163       &        'RL', Nr, OBWt1, intime0, myThid )        IF ( OBWsFile .NE. ' '  ) THEN
164        ENDIF         CALL READ_REC_YZ_RL( OBWsFile, fp,Nr,OBWs0,iRec0,myIter,myThid )
165        IF ( OBWuFile .NE. ' '  ) THEN         CALL READ_REC_YZ_RL( OBWsFile, fp,Nr,OBWs1,iRec1,myIter,myThid )
166         CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,        ENDIF
167       &        'RL', Nr, OBWs0, intime0, myThid )  # ifdef NONLIN_FRSURF
168         CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,        IF ( OBWetaFile .NE. ' '  ) THEN
169       &        'RL', Nr, OBWs1, intime0, myThid )         CALL READ_REC_YZ_RL(OBWetaFile,fp,1,OBWeta0,iRec0,myIter,myThid)
170           CALL READ_REC_YZ_RL(OBWetaFile,fp,1,OBWeta1,iRec1,myIter,myThid)
171        ENDIF        ENDIF
172    # endif /* NONLIN_FRSURF */
173  #endif /* ALLOW_OBCS_WEST */  #endif /* ALLOW_OBCS_WEST */
174  #ifdef ALLOW_OBCS_NORTH  #ifdef ALLOW_OBCS_NORTH
175  C     Northern boundary  C     Northern boundary
176        IF ( OBNuFile .NE. ' '  ) THEN        IF ( OBNuFile .NE. ' '  ) THEN
177         CALL MDSREADFIELDXZ ( OBNuFile, readBinaryPrec,         CALL READ_REC_XZ_RL( OBNuFile, fp,Nr,OBNu0,iRec0,myIter,myThid )
178       &        'RL', Nr, OBNu0, intime0, myThid )         CALL READ_REC_XZ_RL( OBNuFile, fp,Nr,OBNu1,iRec1,myIter,myThid )
        CALL MDSREADFIELDXz ( OBNuFile, readBinaryPrec,  
      &        'RL', Nr, OBNu1, intime0, myThid )  
179        ENDIF        ENDIF
180        IF ( OBNvFile .NE. ' '  ) THEN        IF ( OBNvFile .NE. ' '  ) THEN
181         CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,         CALL READ_REC_XZ_RL( OBNvFile, fp,Nr,OBNv0,iRec0,myIter,myThid )
182       &        'RL', Nr, OBNv0, intime0, myThid )         CALL READ_REC_XZ_RL( OBNvFile, fp,Nr,OBNv1,iRec1,myIter,myThid )
        CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,  
      &        'RL', Nr, OBNv1, intime0, myThid )  
       ENDIF  
       IF ( OBNuFile .NE. ' '  ) THEN  
        CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,  
      &        'RL', Nr, OBNt0, intime0, myThid )  
        CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,  
      &        'RL', Nr, OBNt1, intime0, myThid )  
183        ENDIF        ENDIF
184        IF ( OBNuFile .NE. ' '  ) THEN        IF ( OBNtFile .NE. ' '  ) THEN
185         CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,         CALL READ_REC_XZ_RL( OBNtFile, fp,Nr,OBNt0,iRec0,myIter,myThid )
186       &        'RL', Nr, OBNs0, intime0, myThid )         CALL READ_REC_XZ_RL( OBNtFile, fp,Nr,OBNt1,iRec1,myIter,myThid )
187         CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,        ENDIF
188       &        'RL', Nr, OBNs1, intime0, myThid )        IF ( OBNsFile .NE. ' '  ) THEN
189           CALL READ_REC_XZ_RL( OBNsFile, fp,Nr,OBNs0,iRec0,myIter,myThid )
190           CALL READ_REC_XZ_RL( OBNsFile, fp,Nr,OBNs1,iRec1,myIter,myThid )
191          ENDIF
192    # ifdef NONLIN_FRSURF
193          IF ( OBNetaFile .NE. ' '  ) THEN
194           CALL READ_REC_XZ_RL(OBNetaFile,fp,1,OBNeta0,iRec0,myIter,myThid)
195           CALL READ_REC_XZ_RL(OBNetaFile,fp,1,OBNeta1,iRec1,myIter,myThid)
196        ENDIF        ENDIF
197    # endif /* NONLIN_FRSURF */
198  #endif /* ALLOW_OBCS_NORTH */  #endif /* ALLOW_OBCS_NORTH */
199  #ifdef ALLOW_OBCS_SOUTH  #ifdef ALLOW_OBCS_SOUTH
200  C     Southern boundary  C     Southern boundary
201        IF ( OBSuFile .NE. ' '  ) THEN        IF ( OBSuFile .NE. ' '  ) THEN
202         CALL MDSREADFIELDXZ ( OBSuFile, readBinaryPrec,         CALL READ_REC_XZ_RL( OBSuFile, fp,Nr,OBSu0,iRec0,myIter,myThid )
203       &        'RL', Nr, OBSu0, intime0, myThid )         CALL READ_REC_XZ_RL( OBSuFile, fp,Nr,OBSu1,iRec1,myIter,myThid )
        CALL MDSREADFIELDXz ( OBSuFile, readBinaryPrec,  
      &        'RL', Nr, OBSu1, intime0, myThid )  
204        ENDIF        ENDIF
205        IF ( OBSvFile .NE. ' '  ) THEN        IF ( OBSvFile .NE. ' '  ) THEN
206         CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,         CALL READ_REC_XZ_RL( OBSvFile, fp,Nr,OBSv0,iRec0,myIter,myThid )
207       &        'RL', Nr, OBSv0, intime0, myThid )         CALL READ_REC_XZ_RL( OBSvFile, fp,Nr,OBSv1,iRec1,myIter,myThid )
        CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,  
      &        'RL', Nr, OBSv1, intime0, myThid )  
208        ENDIF        ENDIF
209        IF ( OBSuFile .NE. ' '  ) THEN        IF ( OBStFile .NE. ' '  ) THEN
210         CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,         CALL READ_REC_XZ_RL( OBStFile, fp,Nr,OBSt0,iRec0,myIter,myThid )
211       &        'RL', Nr, OBSt0, intime0, myThid )         CALL READ_REC_XZ_RL( OBStFile, fp,Nr,OBSt1,iRec1,myIter,myThid )
212         CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,        ENDIF
213       &        'RL', Nr, OBSt1, intime0, myThid )        IF ( OBSsFile .NE. ' '  ) THEN
214        ENDIF         CALL READ_REC_XZ_RL( OBSsFile, fp,Nr,OBSs0,iRec0,myIter,myThid )
215        IF ( OBSuFile .NE. ' '  ) THEN         CALL READ_REC_XZ_RL( OBSsFile, fp,Nr,OBSs1,iRec1,myIter,myThid )
216         CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,        ENDIF
217       &        'RL', Nr, OBSs0, intime0, myThid )  # ifdef NONLIN_FRSURF
218         CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,        IF ( OBSetaFile .NE. ' '  ) THEN
219       &        'RL', Nr, OBSs1, intime0, myThid )         CALL READ_REC_XZ_RL(OBSetaFile,fp,1,OBSeta0,iRec0,myIter,myThid)
220           CALL READ_REC_XZ_RL(OBSetaFile,fp,1,OBSeta1,iRec1,myIter,myThid)
221        ENDIF        ENDIF
222    # endif /* NONLIN_FRSURF */
223  #endif /* ALLOW_OBCS_SOUTH */  #endif /* ALLOW_OBCS_SOUTH */
224         _END_MASTER(myThid)  #ifdef ALLOW_PTRACERS
225          IF (usePTRACERS) THEN
226    C     read boundary values for passive tracers
227           DO iTr = 1, PTRACERS_numInUse
228    # ifdef ALLOW_OBCS_EAST
229    C     Eastern boundary
230            IF ( OBEptrFile(iTr) .NE. ' '  ) THEN
231             CALL READ_REC_YZ_RL( OBEptrFile(iTr), fp, Nr,
232         &                OBEptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
233             CALL READ_REC_YZ_RL( OBEptrFile(iTr), fp, Nr,
234         &                OBEptr1(1-Oly,1,1,1,iTr), iRec1, myIter, myThid )
235            ENDIF
236    # endif /* ALLOW_OBCS_WEST */
237    # ifdef ALLOW_OBCS_WEST
238    C     Western boundary
239            IF ( OBWptrFile(iTr) .NE. ' '  ) THEN
240             CALL READ_REC_YZ_RL( OBWptrFile(iTr), fp, Nr,
241         &                OBWptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
242             CALL READ_REC_YZ_RL( OBWptrFile(iTr), fp, Nr,
243         &                OBWptr1(1-Oly,1,1,1,iTr), iRec1, myIter, myThid )
244            ENDIF
245    # endif /* ALLOW_OBCS_WEST */
246    # ifdef ALLOW_OBCS_NORTH
247    C     Northern boundary
248            IF ( OBNptrFile(iTr) .NE. ' '  ) THEN
249             CALL READ_REC_XZ_RL( OBNptrFile(iTr), fp, Nr,
250         &                OBNptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
251             CALL READ_REC_XZ_RL( OBNptrFile(iTr), fp, Nr,
252         &                OBNptr1(1-Oly,1,1,1,iTr), iRec1, myIter, myThid )
253            ENDIF
254    # endif /* ALLOW_OBCS_NORTH */
255    # ifdef ALLOW_OBCS_SOUTH
256    C     Southern boundary
257            IF ( OBSptrFile(iTr) .NE. ' '  ) THEN
258             CALL READ_REC_XZ_RL( OBSptrFile(iTr), fp, Nr,
259         &                OBSptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
260             CALL READ_REC_XZ_RL( OBSptrFile(iTr), fp, Nr,
261         &                OBSptr1(1-Oly,1,1,1,iTr), iRec1, myIter, myThid )
262            ENDIF
263    # endif /* ALLOW_OBCS_SOUTH */
264    C     end do iTr
265           ENDDO
266    C     end if (usePTRACERS)
267          ENDIF
268    #endif /* ALLOW_PTRACERS */
269    
270  C  C
271  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.
272  C     However, we do not have exchange routines for vertical  C     However, we do not have exchange routines for vertical
273  C     slices and they are not planned, either, so the approriate fields  C     slices and they are not planned, either, so the approriate fields
274  C     are exchanged after the open boundary conditions have been  C     are exchanged after the open boundary conditions have been
275  C     applied. (in DYNAMICS and DO_FIELDS_BLOCKING_EXCHANGES)  C     applied. (in DYNAMICS and DO_FIELDS_BLOCKING_EXCHANGES)
276  C         _BARRIER
277    
278    C     end if time to read new data
279        ENDIF        ENDIF
280    
 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  
281  C     if not periodicForcing  C     if not periodicForcing
282        ELSE        ELSE
283           aWght = 0. _d 0
284           bWght = 1. _d 0
285  C     read boundary values once and for all  C     read boundary values once and for all
286         IF ( myIter .EQ. nIter0 ) THEN         IF ( myIter .EQ. nIter0 ) THEN
287          _BEGIN_MASTER(myThid)  #ifndef ALLOW_MDSIO
288  C      If the above condition is met then we need to read in           STOP 'ABNORMAL END: OBCS_EXTERNAL_FIELDS_LOAD: NEEDS MSDIO PKG'
289  C      data for the period ahead and the period behind myTime.  #endif /* ALLOW_MDSIO */
290         WRITE(*,*)          _BARRIER
291       &  'S/R OBCS_EXTERNAl_FIELDS_LOAD: Reading new data',myTime,myIter  C      Read constant boundary conditions only for myIter = nIter0
292         inTime0 = 1          WRITE(msgBuf,'(1X,A,I10,1P1E20.12)')
293  #ifdef ALLOW_OBCS_WEST       &       'OBCS_EXTERNAL_FIELDS_LOAD: Reading initial data:',
294         &       myIter, myTime
295            CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
296         &       SQUEEZE_RIGHT,myThid)
297            iRec0 = 1
298    
299    #ifdef ALLOW_OBCS_EAST
300  C     Eastern boundary  C     Eastern boundary
301          IF ( OBEuFile .NE. ' '  ) THEN          IF ( OBEuFile .NE. ' '  ) THEN
302           CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,           CALL READ_REC_YZ_RL( OBEuFile,fp,Nr,OBEu0,iRec0,myIter,myThid )
      &        'RL', Nr, OBEu, inTime0, myThid )  
303          ENDIF          ENDIF
304          IF ( OBEvFile .NE. ' '  ) THEN          IF ( OBEvFile .NE. ' '  ) THEN
305           CALL MDSREADFIELDYZ ( OBEvFile, readBinaryPrec,           CALL READ_REC_YZ_RL( OBEvFile,fp,Nr,OBEv0,iRec0,myIter,myThid )
      &        'RL', Nr, OBEv, inTime0, myThid )  
306          ENDIF          ENDIF
307          IF ( OBEuFile .NE. ' '  ) THEN          IF ( OBEtFile .NE. ' '  ) THEN
308           CALL MDSREADFIELDYZ ( OBEtFile, readBinaryPrec,           CALL READ_REC_YZ_RL( OBEtFile,fp,Nr,OBEt0,iRec0,myIter,myThid )
      &        'RL', Nr, OBEt, inTime0, myThid )  
309          ENDIF          ENDIF
310          IF ( OBEuFile .NE. ' '  ) THEN          IF ( OBEsFile .NE. ' '  ) THEN
311           CALL MDSREADFIELDYZ ( OBEsFile, readBinaryPrec,           CALL READ_REC_YZ_RL( OBEsFile,fp,Nr,OBEs0,iRec0,myIter,myThid )
312       &        'RL', Nr, OBEs, inTime0, myThid )          ENDIF
313    # ifdef NONLIN_FRSURF
314            IF ( OBEetaFile .NE. ' '  ) THEN
315             CALL READ_REC_YZ_RL( OBEetaFile, fp, 1, OBEeta0, iRec0,
316         &                        myIter, myThid )
317          ENDIF          ENDIF
318    # endif /* NONLIN_FRSURF */
319  #endif /* ALLOW_OBCS_WEST */  #endif /* ALLOW_OBCS_WEST */
320  #ifdef ALLOW_OBCS_WEST  #ifdef ALLOW_OBCS_WEST
321  C     Western boundary  C     Western boundary
322          IF ( OBWuFile .NE. ' '  ) THEN          IF ( OBWuFile .NE. ' '  ) THEN
323           CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,           CALL READ_REC_YZ_RL( OBWuFile,fp,Nr,OBWu0,iRec0,myIter,myThid )
      &        'RL', Nr, OBWu, inTime0, myThid )  
324          ENDIF          ENDIF
325          IF ( OBWvFile .NE. ' '  ) THEN          IF ( OBWvFile .NE. ' '  ) THEN
326           CALL MDSREADFIELDYZ ( OBWvFile, readBinaryPrec,           CALL READ_REC_YZ_RL( OBWvFile,fp,Nr,OBWv0,iRec0,myIter,myThid )
      &        'RL', Nr, OBWv, inTime0, myThid )  
327          ENDIF          ENDIF
328          IF ( OBWuFile .NE. ' '  ) THEN          IF ( OBWtFile .NE. ' '  ) THEN
329           CALL MDSREADFIELDYZ ( OBWtFile, readBinaryPrec,           CALL READ_REC_YZ_RL( OBWtFile,fp,Nr,OBWt0,iRec0,myIter,myThid )
      &        'RL', Nr, OBWt, inTime0, myThid )  
330          ENDIF          ENDIF
331          IF ( OBWuFile .NE. ' '  ) THEN          IF ( OBWsFile .NE. ' '  ) THEN
332           CALL MDSREADFIELDYZ ( OBWsFile, readBinaryPrec,           CALL READ_REC_YZ_RL( OBWsFile,fp,Nr,OBWs0,iRec0,myIter,myThid )
333       &        'RL', Nr, OBWs, inTime0, myThid )          ENDIF
334    # ifdef NONLIN_FRSURF
335            IF ( OBWetaFile .NE. ' '  ) THEN
336             CALL READ_REC_YZ_RL( OBWetaFile, fp, 1, OBWeta0, iRec0,
337         &                        myIter, myThid )
338          ENDIF          ENDIF
339    # endif /* NONLIN_FRSURF */
340  #endif /* ALLOW_OBCS_WEST */  #endif /* ALLOW_OBCS_WEST */
341  #ifdef ALLOW_OBCS_NORTH  #ifdef ALLOW_OBCS_NORTH
342  C     Northern boundary  C     Northern boundary
343          IF ( OBNuFile .NE. ' '  ) THEN          IF ( OBNuFile .NE. ' '  ) THEN
344           CALL MDSREADFIELDXz ( OBNuFile, readBinaryPrec,           CALL READ_REC_XZ_RL( OBNuFile,fp,Nr,OBNu0,iRec0,myIter,myThid )
      &        'RL', Nr, OBNu, inTime0, myThid )  
345          ENDIF          ENDIF
346          IF ( OBNvFile .NE. ' '  ) THEN          IF ( OBNvFile .NE. ' '  ) THEN
347           CALL MDSREADFIELDXZ ( OBNvFile, readBinaryPrec,           CALL READ_REC_XZ_RL( OBNvFile,fp,Nr,OBNv0,iRec0,myIter,myThid )
      &        'RL', Nr, OBNv, inTime0, myThid )  
348          ENDIF          ENDIF
349          IF ( OBNuFile .NE. ' '  ) THEN          IF ( OBNtFile .NE. ' '  ) THEN
350           CALL MDSREADFIELDXZ ( OBNtFile, readBinaryPrec,           CALL READ_REC_XZ_RL( OBNtFile,fp,Nr,OBNt0,iRec0,myIter,myThid )
      &        'RL', Nr, OBNt, inTime0, myThid )  
351          ENDIF          ENDIF
352          IF ( OBNuFile .NE. ' '  ) THEN          IF ( OBNsFile .NE. ' '  ) THEN
353           CALL MDSREADFIELDXZ ( OBNsFile, readBinaryPrec,           CALL READ_REC_XZ_RL( OBNsFile,fp,Nr,OBNs0,iRec0,myIter,myThid )
354       &        'RL', Nr, OBNs, inTime0, myThid )          ENDIF
355    # ifdef NONLIN_FRSURF
356            IF ( OBNetaFile .NE. ' '  ) THEN
357             CALL READ_REC_XZ_RL( OBNetaFile, fp, 1, OBNeta0, iRec0,
358         &                        myIter, myThid )
359          ENDIF          ENDIF
360    # endif /* NONLIN_FRSURF */
361  #endif /* ALLOW_OBCS_NORTH */  #endif /* ALLOW_OBCS_NORTH */
362  #ifdef ALLOW_OBCS_SOUTH  #ifdef ALLOW_OBCS_SOUTH
363  C     Southern boundary  C     Southern boundary
364          IF ( OBSuFile .NE. ' '  ) THEN          IF ( OBSuFile .NE. ' '  ) THEN
365           CALL MDSREADFIELDXz ( OBSuFile, readBinaryPrec,           CALL READ_REC_XZ_RL( OBSuFile,fp,Nr,OBSu0,iRec0,myIter,myThid )
      &        'RL', Nr, OBSu, inTime0, myThid )  
366          ENDIF          ENDIF
367          IF ( OBSvFile .NE. ' '  ) THEN          IF ( OBSvFile .NE. ' '  ) THEN
368           CALL MDSREADFIELDXZ ( OBSvFile, readBinaryPrec,           CALL READ_REC_XZ_RL( OBSvFile,fp,Nr,OBSv0,iRec0,myIter,myThid )
      &        'RL', Nr, OBSv, inTime0, myThid )  
369          ENDIF          ENDIF
370          IF ( OBSuFile .NE. ' '  ) THEN          IF ( OBStFile .NE. ' '  ) THEN
371           CALL MDSREADFIELDXZ ( OBStFile, readBinaryPrec,           CALL READ_REC_XZ_RL( OBStFile,fp,Nr,OBSt0,iRec0,myIter,myThid )
      &        'RL', Nr, OBSt, inTime0, myThid )  
372          ENDIF          ENDIF
373          IF ( OBSuFile .NE. ' '  ) THEN          IF ( OBSsFile .NE. ' '  ) THEN
374           CALL MDSREADFIELDXZ ( OBSsFile, readBinaryPrec,           CALL READ_REC_XZ_RL( OBSsFile,fp,Nr,OBSs0,iRec0,myIter,myThid )
      &        'RL', Nr, OBSs, inTime0, myThid )  
375          ENDIF          ENDIF
376    # ifdef NONLIN_FRSURF
377            IF ( OBSetaFile .NE. ' '  ) THEN
378             CALL READ_REC_XZ_RL( OBSetaFile, fp, 1, OBSeta0, iRec0,
379         &                        myIter, myThid )
380            ENDIF
381    # endif /* NONLIN_FRSURF */
382  #endif /* ALLOW_OBCS_SOUTH */  #endif /* ALLOW_OBCS_SOUTH */
383          _END_MASTER(myThid)  #ifdef ALLOW_PTRACERS
384            IF (usePTRACERS) THEN
385    C     read passive tracer boundary values
386             DO iTr = 1, PTRACERS_numInUse
387    # ifdef ALLOW_OBCS_EAST
388    C     Eastern boundary
389              IF ( OBEptrFile(iTr) .NE. ' '  ) THEN
390               CALL READ_REC_YZ_RL( OBEptrFile(iTr), fp, Nr,
391         &               OBEptr0(1-Oly,1,1,1,iTr), iRec0,myIter, myThid )
392              ENDIF
393    # endif /* ALLOW_OBCS_WEST */
394    # ifdef ALLOW_OBCS_WEST
395    C     Western boundary
396              IF ( OBWptrFile(iTr) .NE. ' '  ) THEN
397               CALL READ_REC_YZ_RL( OBWptrFile(iTr), fp, Nr,
398         &               OBWptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
399              ENDIF
400    # endif /* ALLOW_OBCS_WEST */
401    # ifdef ALLOW_OBCS_NORTH
402    C     Northern boundary
403              IF ( OBNptrFile(iTr) .NE. ' '  ) THEN
404               CALL READ_REC_XZ_RL( OBNptrFile(iTr), fp, Nr,
405         &               OBNptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
406              ENDIF
407    # endif /* ALLOW_OBCS_NORTH */
408    # ifdef ALLOW_OBCS_SOUTH
409    C     Southern boundary
410              IF ( OBSptrFile(iTr) .NE. ' '  ) THEN
411               CALL READ_REC_XZ_RL( OBSptrFile(iTr), fp, Nr,
412         &               OBSptr0(1-Oly,1,1,1,iTr), iRec0, myIter, myThid )
413              ENDIF
414    # endif /* ALLOW_OBCS_SOUTH */
415    C     end do iTr
416             ENDDO
417    C     end if (usePTRACERS)
418            ENDIF
419    #endif /* ALLOW_PTRACERS */
420            _BARRIER
421  C     endif myIter .EQ. nIter0  C     endif myIter .EQ. nIter0
422         ENDIF         ENDIF
423  C     endif for periodicForcing  C     endif for periodicForcing
424        ENDIF        ENDIF
425    
426  #endif /* ALLOW_EXF */  C--   Now interpolate OBSu, OBSv, OBSt, OBSs, OBSptr, etc.
427  #endif /* ALLOw_OBCS AND ALLOW_OBCS_PRESCRIBE */  C--   For periodicForcing, aWght = 0. and bWght = 1. so that the
428    C--   interpolation boilds down to copying the time-independent
429    C--   forcing field OBSu0 to OBSu
430    #ifdef ALLOW_OBCS_EAST
431           IF ( OBEuFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
432         &      OBEu, OBEu0, OBEu1, aWght, bWght, myThid )
433           IF ( OBEvFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
434         &      OBEv, OBEv0, OBEv1, aWght, bWght, myThid )
435           IF ( OBEtFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
436         &      OBEt, OBEt0, OBEt1, aWght, bWght, myThid )
437           IF ( OBEsFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
438         &      OBEs, OBEs0, OBEs1, aWght, bWght, myThid )
439    # ifdef NONLIN_FRSURF
440           IF ( OBEetaFile .NE. ' ' ) THEN
441            DO bj = myByLo(myThid), myByHi(myThid)
442             DO bi = myBxLo(myThid), myBxHi(myThid)
443              DO j=1-Oly,sNy+Oly
444               OBEeta(j,bi,bj) = bWght*OBEeta0(j,bi,bj)
445         &                      +aWght*OBEeta1(j,bi,bj)
446              ENDDO
447             ENDDO
448            ENDDO
449           ENDIF
450    # endif /* NONLIN_FRSURF */
451    #endif /* ALLOW_OBCS_EAST */
452    #ifdef ALLOW_OBCS_WEST
453           IF ( OBWuFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
454         &      OBWu, OBWu0, OBWu1, aWght, bWght, myThid )
455           IF ( OBWvFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
456         &      OBWv, OBWv0, OBWv1, aWght, bWght, myThid )
457           IF ( OBWtFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
458         &      OBWt, OBWt0, OBWt1, aWght, bWght, myThid )
459           IF ( OBWsFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
460         &      OBWs, OBWs0, OBWs1, aWght, bWght, myThid )
461    # ifdef NONLIN_FRSURF
462           IF ( OBWetaFile .NE. ' ' ) THEN
463            DO bj = myByLo(myThid), myByHi(myThid)
464             DO bi = myBxLo(myThid), myBxHi(myThid)
465              DO j=1-Oly,sNy+Oly
466               OBWeta(j,bi,bj) = bWght*OBWeta0(j,bi,bj)
467         &                      +aWght*OBWeta1(j,bi,bj)
468              ENDDO
469             ENDDO
470            ENDDO
471           ENDIF
472    # endif /* NONLIN_FRSURF */
473    #endif /* ALLOW_OBCS_WEST */
474    #ifdef ALLOW_OBCS_NORTH
475           IF ( OBNuFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
476         &      OBNu, OBNu0, OBNu1, aWght, bWght, myThid )
477           IF ( OBNvFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
478         &      OBNv, OBNv0, OBNv1, aWght, bWght, myThid )
479           IF ( OBNtFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
480         &      OBNt, OBNt0, OBNt1, aWght, bWght, myThid )
481           IF ( OBNsFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
482         &      OBNs, OBNs0, OBNs1, aWght, bWght, myThid )
483    # ifdef NONLIN_FRSURF
484           IF ( OBNetaFile .NE. ' ' ) THEN
485            DO bj = myByLo(myThid), myByHi(myThid)
486             DO bi = myBxLo(myThid), myBxHi(myThid)
487              DO i=1-Olx,sNx+Olx
488               OBNeta(i,bi,bj) = bWght*OBNeta0(i,bi,bj)
489         &                      +aWght*OBNeta1(i,bi,bj)
490              ENDDO
491             ENDDO
492            ENDDO
493           ENDIF
494    # endif /* NONLIN_FRSURF */
495    #endif /* ALLOW_OBCS_NORTH */
496    #ifdef ALLOW_OBCS_SOUTH
497           IF ( OBSuFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
498         &      OBSu, OBSu0, OBSu1, aWght, bWght, myThid )
499           IF ( OBSvFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
500         &      OBSv, OBSv0, OBSv1, aWght, bWght, myThid )
501           IF ( OBStFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
502         &      OBSt, OBSt0, OBSt1, aWght, bWght, myThid )
503           IF ( OBSsFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
504         &      OBSs, OBSs0, OBSs1, aWght, bWght, myThid )
505    # ifdef NONLIN_FRSURF
506           IF ( OBSetaFile .NE. ' ' ) THEN
507            DO bj = myByLo(myThid), myByHi(myThid)
508             DO bi = myBxLo(myThid), myBxHi(myThid)
509              DO i=1-Olx,sNx+Olx
510               OBSeta(i,bi,bj) = bWght*OBSeta0(i,bi,bj)
511         &                      +aWght*OBSeta1(i,bi,bj)
512              ENDDO
513             ENDDO
514            ENDDO
515           ENDIF
516    # endif /* NONLIN_FRSURF */
517    #endif /* ALLOW_OBCS_SOUTH */
518    #ifdef ALLOW_PTRACERS
519          IF (usePTRACERS) THEN
520    C     "interpolate" passive tracer boundary values
521           DO iTr = 1, PTRACERS_numInUse
522    # ifdef ALLOW_OBCS_EAST
523            IF ( OBEptrFile(iTr) .NE. ' '  )
524         &       CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
525         O       OBEptr (1-Oly,1,1,1,iTr),
526         I       OBEptr0(1-Oly,1,1,1,iTr),
527         I       OBEptr1(1-Oly,1,1,1,iTr), aWght, bWght, myThid )
528    # endif /* ALLOW_OBCS_EAST */
529    # ifdef ALLOW_OBCS_WEST
530            IF ( OBWptrFile(iTr) .NE. ' '  )
531         &       CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
532         O       OBWptr (1-Oly,1,1,1,iTr),
533         I       OBWptr0(1-Oly,1,1,1,iTr),
534         I       OBWptr1(1-Oly,1,1,1,iTr), aWght, bWght, myThid )
535    # endif /* ALLOW_OBCS_WEST */
536    # ifdef ALLOW_OBCS_NORTH
537            IF ( OBNptrFile(iTr) .NE. ' '  )
538         &       CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
539         O       OBNptr (1-Olx,1,1,1,iTr),
540         I       OBNptr0(1-Olx,1,1,1,iTr),
541         I       OBNptr1(1-Olx,1,1,1,iTr), aWght, bWght, myThid )
542    # endif /* ALLOW_OBCS_NORTH */
543    # ifdef ALLOW_OBCS_SOUTH
544            IF ( OBSptrFile(iTr) .NE. ' '  )
545         &       CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
546         O       OBSptr (1-Olx,1,1,1,iTr),
547         I       OBSptr0(1-Olx,1,1,1,iTr),
548         I       OBSptr1(1-Olx,1,1,1,iTr), aWght, bWght, myThid )
549    # endif /* ALLOW_OBCS_SOUTH */
550    C     end do iTr
551           ENDDO
552    C     end if (usePTRACERS)
553          ENDIF
554    #endif /* ALLOW_PTRACERS */
555    
556          RETURN
557          END
558    
559    CBOP
560    C     !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_XZ
561    C     !INTERFACE:
562          SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ(
563         O     fld,
564         I     fld0, fld1, aWght, bWght, myThid )
565    C     !DESCRIPTION: \bv
566    C     *==========================================================*
567    C     | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ
568    C     | o Interpolate between to records
569    C     *==========================================================*
570    C     \ev
571    
572    C     !USES:
573          IMPLICIT NONE
574    C     === Global variables ===
575    #include "SIZE.h"
576    #include "EEPARAMS.h"
577    #include "PARAMS.h"
578    
579    C     !INPUT/OUTPUT PARAMETERS:
580    C     === Routine arguments ===
581    C     myThid - Thread no. that called this routine.
582    C     aWght, bWght :: Interpolation weights
583          INTEGER myThid
584          _RL aWght,bWght
585          _RL fld (1-Olx:sNx+Olx,Nr,nSx,nSy)
586          _RL fld0(1-Olx:sNx+Olx,Nr,nSx,nSy)
587          _RL fld1(1-Olx:sNx+Olx,Nr,nSx,nSy)
588    
589    C     !LOCAL VARIABLES:
590    C     === Local arrays ===
591    C     bi,bj,i,j :: loop counters
592          INTEGER bi,bj,i,k
593    CEOP
594           DO bj = myByLo(myThid), myByHi(myThid)
595            DO bi = myBxLo(myThid), myBxHi(myThid)
596             DO K = 1, Nr
597              DO i=1-Olx,sNx+Olx
598               fld(i,k,bi,bj)   = bWght*fld0(i,k,bi,bj)
599         &                       +aWght*fld1(i,k,bi,bj)
600              ENDDO
601             ENDDO
602            ENDDO
603           ENDDO
604    
605        RETURN        RETURN
606        END        END
607    CBOP
608    C     !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_YZ
609    C     !INTERFACE:
610          SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ(
611         O     fld,
612         I     fld0, fld1, aWght, bWght, myThid )
613    C     !DESCRIPTION: \bv
614    C     *==========================================================*
615    C     | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ
616    C     | o Interpolate between to records
617    C     *==========================================================*
618    C     \ev
619    
620    C     !USES:
621          IMPLICIT NONE
622    C     === Global variables ===
623    #include "SIZE.h"
624    #include "EEPARAMS.h"
625    #include "PARAMS.h"
626    
627    C     !INPUT/OUTPUT PARAMETERS:
628    C     === Routine arguments ===
629    C     myThid - Thread no. that called this routine.
630    C     aWght, bWght :: Interpolation weights
631          INTEGER myThid
632          _RL aWght,bWght
633          _RL fld (1-Oly:sNy+Oly,Nr,nSx,nSy)
634          _RL fld0(1-Oly:sNy+Oly,Nr,nSx,nSy)
635          _RL fld1(1-Oly:sNy+Oly,Nr,nSx,nSy)
636    
637    C     !LOCAL VARIABLES:
638    C     === Local arrays ===
639    C     bi,bj,i,j :: loop counters
640          INTEGER bi,bj,j,k
641    CEOP
642           DO bj = myByLo(myThid), myByHi(myThid)
643            DO bi = myBxLo(myThid), myBxHi(myThid)
644             DO K = 1, Nr
645              DO j=1-Oly,sNy+Oly
646               fld(j,k,bi,bj)   = bWght*fld0(j,k,bi,bj)
647         &                       +aWght*fld1(j,k,bi,bj)
648              ENDDO
649             ENDDO
650            ENDDO
651           ENDDO
652    
653    #endif /* ALLOW_OBCS AND ALLOW_OBCS_PRESCRIBE */
654    
655           RETURN
656           END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22