/[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.4 by mlosch, Wed Jul 6 08:22:00 2005 UTC revision 1.5 by mlosch, Mon Oct 10 05:53:48 2005 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
# Line 12  C     *================================= Line 11  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     | the open boundary fields are overwritten.
19    C     | The routine decides which fields to load and then reads them in.
20  C     | This routine needs to be customised for particular          C     | This routine needs to be customised for particular        
21  C     | experiments.                                                C     | experiments.                                              
22  C     | Notes                                                      C     | Notes                                                    
# Line 35  C     | - Forcing period and cycle are t Line 36  C     | - Forcing period and cycle are t
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 56  C     myIter - Simulation timestep numbe Line 57  C     myIter - Simulation timestep numbe
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.h
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 97  C Now calculate whether it is time to up Line 105  C Now calculate whether it is time to up
105    
106  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
107  C      data for the period ahead and the period behind myTime.  C      data for the period ahead and the period behind myTime.
108         WRITE(standardMessageUnit,'(A,2I5,I10,1P1E20.12)')         WRITE(msgBuf,'(1X,A,2I5,I10,1P1E20.12)')
109       &  'S/R OBCS_EXTERNAL_FIELDS_LOAD: Reading new data:',       &  'OBCS_EXTERNAL_FIELDS_LOAD: Reading new data:',
110       &  intime0, intime1, myIter, myTime       &  intime0, intime1, myIter, myTime
111           CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
112         &                   SQUEEZE_RIGHT,myThid)
113    
114  #ifdef ALLOW_OBCS_EAST  #ifdef ALLOW_OBCS_EAST
115  C     Eastern boundary  C     Eastern boundary
116        IF ( OBEuFile .NE. ' '  ) THEN        IF ( OBEuFile .NE. ' '  ) THEN
117         CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
118       &        'RL', Nr, OBEu0, intime0, myThid )       &        'RL', Nr, OBEu0, intime0, myThid )
119         CALL MDSREADFIELDXz ( OBEuFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBEuFile, readBinaryPrec,
120       &        'RL', Nr, OBEu1, intime1, myThid )       &        'RL', Nr, OBEu1, intime1, myThid )
121        ENDIF        ENDIF
122        IF ( OBEvFile .NE. ' '  ) THEN        IF ( OBEvFile .NE. ' '  ) THEN
# Line 133  C     Western boundary Line 143  C     Western boundary
143        IF ( OBWuFile .NE. ' '  ) THEN        IF ( OBWuFile .NE. ' '  ) THEN
144         CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
145       &        'RL', Nr, OBWu0, intime0, myThid )       &        'RL', Nr, OBWu0, intime0, myThid )
146         CALL MDSREADFIELDXz ( OBWuFile, readBinaryPrec,         CALL MDSREADFIELDYZ ( OBWuFile, readBinaryPrec,
147       &        'RL', Nr, OBWu1, intime1, myThid )       &        'RL', Nr, OBWu1, intime1, myThid )
148        ENDIF        ENDIF
149        IF ( OBWvFile .NE. ' '  ) THEN        IF ( OBWvFile .NE. ' '  ) THEN
# Line 160  C     Northern boundary Line 170  C     Northern boundary
170        IF ( OBNuFile .NE. ' '  ) THEN        IF ( OBNuFile .NE. ' '  ) THEN
171         CALL MDSREADFIELDXZ ( OBNuFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBNuFile, readBinaryPrec,
172       &        'RL', Nr, OBNu0, intime0, myThid )       &        'RL', Nr, OBNu0, intime0, myThid )
173         CALL MDSREADFIELDXz ( OBNuFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBNuFile, readBinaryPrec,
174       &        'RL', Nr, OBNu1, intime1, myThid )       &        'RL', Nr, OBNu1, intime1, myThid )
175        ENDIF        ENDIF
176        IF ( OBNvFile .NE. ' '  ) THEN        IF ( OBNvFile .NE. ' '  ) THEN
# Line 187  C     Southern boundary Line 197  C     Southern boundary
197        IF ( OBSuFile .NE. ' '  ) THEN        IF ( OBSuFile .NE. ' '  ) THEN
198         CALL MDSREADFIELDXZ ( OBSuFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBSuFile, readBinaryPrec,
199       &        'RL', Nr, OBSu0, intime0, myThid )       &        'RL', Nr, OBSu0, intime0, myThid )
200         CALL MDSREADFIELDXz ( OBSuFile, readBinaryPrec,         CALL MDSREADFIELDXZ ( OBSuFile, readBinaryPrec,
201       &        'RL', Nr, OBSu1, intime1, myThid )       &        'RL', Nr, OBSu1, intime1, myThid )
202        ENDIF        ENDIF
203        IF ( OBSvFile .NE. ' '  ) THEN        IF ( OBSvFile .NE. ' '  ) THEN
# Line 209  C     Southern boundary Line 219  C     Southern boundary
219       &        'RL', Nr, OBSs1, intime1, myThid )       &        'RL', Nr, OBSs1, intime1, myThid )
220        ENDIF        ENDIF
221  #endif /* ALLOW_OBCS_SOUTH */  #endif /* ALLOW_OBCS_SOUTH */
222    #ifdef ALLOW_PTRACERS
223          IF (usePTRACERS) THEN
224    C     read boundary values for passive tracers
225           DO iTracer = 1, PTRACERS_numInUse
226    # ifdef ALLOW_OBCS_EAST
227    C     Eastern boundary
228            IF ( OBEptrFile(iTracer) .NE. ' '  ) THEN
229             CALL MDSREADFIELDYZ ( OBEptrFile(itracer), readBinaryPrec,
230         &        'RL', Nr, OBEptr0(1-Oly,1,1,1,iTracer),
231         &        intime0, myThid )
232             CALL MDSREADFIELDYZ ( OBEptrFile(itracer), readBinaryPrec,
233         &        'RL', Nr, OBEptr1(1-Oly,1,1,1,iTracer),
234         &        intime1, myThid )
235            ENDIF
236    # endif /* ALLOW_OBCS_WEST */
237    # ifdef ALLOW_OBCS_WEST
238    C     Western boundary
239            IF ( OBWptrFile(iTracer) .NE. ' '  ) THEN
240             CALL MDSREADFIELDYZ ( OBWptrFile(itracer), readBinaryPrec,
241         &        'RL', Nr, OBWptr0(1-Oly,1,1,1,iTracer),
242         &        intime0, myThid )
243             CALL MDSREADFIELDYZ ( OBWptrFile(itracer), readBinaryPrec,
244         &        'RL', Nr, OBWptr1(1-Oly,1,1,1,iTracer),
245         &        intime1, myThid )
246            ENDIF
247    # endif /* ALLOW_OBCS_WEST */
248    # ifdef ALLOW_OBCS_NORTH
249    C     Northern boundary
250            IF ( OBNptrFile(iTracer) .NE. ' '  ) THEN
251             CALL MDSREADFIELDXZ ( OBNptrFile(itracer), readBinaryPrec,
252         &        'RL', Nr, OBNptr0(1-Olx,1,1,1,iTracer),
253         &        intime0, myThid )
254             CALL MDSREADFIELDXZ ( OBNptrFile(itracer), readBinaryPrec,
255         &        'RL', Nr, OBNptr1(1-Olx,1,1,1,iTracer),
256         &        intime1, myThid )
257            ENDIF
258    # endif /* ALLOW_OBCS_NORTH */
259    # ifdef ALLOW_OBCS_SOUTH
260    C     Southern boundary
261            IF ( OBSptrFile(iTracer) .NE. ' '  ) THEN
262             CALL MDSREADFIELDXZ ( OBSptrFile(itracer), readBinaryPrec,
263         &        'RL', Nr, OBSptr0(1-Olx,1,1,1,iTracer),
264         &        intime0, myThid )
265             CALL MDSREADFIELDXZ ( OBSptrFile(itracer), readBinaryPrec,
266         &        'RL', Nr, OBSptr1(1-Olx,1,1,1,iTracer),
267         &        intime1, myThid )
268            ENDIF
269    # endif /* ALLOW_OBCS_SOUTH */
270    C     end do iTracer
271           ENDDO
272    C     end if (usePTRACERS)
273          ENDIF
274    #endif /* ALLOW_PTRACERS */
275         _END_MASTER(myThid)         _END_MASTER(myThid)
276  C  C
277  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.
# Line 217  C     slices and they are not planned, e Line 280  C     slices and they are not planned, e
280  C     are exchanged after the open boundary conditions have been  C     are exchanged after the open boundary conditions have been
281  C     applied. (in DYNAMICS and DO_FIELDS_BLOCKING_EXCHANGES)  C     applied. (in DYNAMICS and DO_FIELDS_BLOCKING_EXCHANGES)
282  C  C
283    C     time to read new data?
284        ENDIF        ENDIF
285    
 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  
286  C     if not periodicForcing  C     if not periodicForcing
287        ELSE        ELSE
288           aWght = 0. _d 0
289           bWght = 1. _d 0
290  C     read boundary values once and for all  C     read boundary values once and for all
291         IF ( myIter .EQ. nIter0 ) THEN         IF ( myIter .EQ. nIter0 ) THEN
292          _BEGIN_MASTER(myThid)          _BEGIN_MASTER(myThid)
293  C      Read constant boundary conditions only for myIter = nIter0  C      Read constant boundary conditions only for myIter = nIter0
294         WRITE(*,*)          WRITE(msgBuf,'(1X,A,I10,1P1E20.12)')
295       &  'S/R OBCS_EXTERNAl_FIELDS_LOAD: Reading new data',myTime,myIter       &       'OBCS_EXTERNAL_FIELDS_LOAD: Reading new data:',
296         inTime0 = 1       &       myIter, myTime
297            CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,
298         &       SQUEEZE_RIGHT,myThid)
299            inTime0 = 1
300  #ifdef ALLOW_OBCS_EAST  #ifdef ALLOW_OBCS_EAST
301  C     Eastern boundary  C     Eastern boundary
302          IF ( OBEuFile .NE. ' '  ) THEN          IF ( OBEuFile .NE. ' '  ) THEN
# Line 355  C     Southern boundary Line 373  C     Southern boundary
373       &        'RL', Nr, OBSs0, inTime0, myThid )       &        'RL', Nr, OBSs0, inTime0, myThid )
374          ENDIF          ENDIF
375  #endif /* ALLOW_OBCS_SOUTH */  #endif /* ALLOW_OBCS_SOUTH */
376    #ifdef ALLOW_PTRACERS
377            IF (usePTRACERS) THEN
378    C     read passive tracer boundary values
379             DO iTracer = 1, PTRACERS_numInUse
380    # ifdef ALLOW_OBCS_EAST
381    C     Eastern boundary
382              IF ( OBEptrFile(iTracer) .NE. ' '  ) THEN
383               CALL MDSREADFIELDYZ ( OBEptrFile(iTracer), readBinaryPrec,
384         &          'RL', Nr, OBEptr0(1-Oly,1,1,1,iTracer),
385         &          inTime0, myThid )
386              ENDIF
387    # endif /* ALLOW_OBCS_WEST */
388    # ifdef ALLOW_OBCS_WEST
389    C     Western boundary
390              IF ( OBWptrFile(iTracer) .NE. ' '  ) THEN
391               CALL MDSREADFIELDYZ ( OBWptrFile(iTracer), readBinaryPrec,
392         &          'RL', Nr, OBWptr0(1-Oly,1,1,1,iTracer),
393         &          inTime0, myThid )
394              ENDIF
395    # endif /* ALLOW_OBCS_WEST */
396    # ifdef ALLOW_OBCS_NORTH
397    C     Northern boundary
398              IF ( OBNptrFile(iTracer) .NE. ' '  ) THEN
399               CALL MDSREADFIELDXZ ( OBNptrFile(iTracer), readBinaryPrec,
400         &          'RL', Nr, OBNptr0(1-Olx,1,1,1,iTracer),
401         &          inTime0, myThid )
402              ENDIF
403    # endif /* ALLOW_OBCS_NORTH */
404    # ifdef ALLOW_OBCS_SOUTH
405    C     Southern boundary
406              IF ( OBSptrFile(iTracer) .NE. ' '  ) THEN
407               CALL MDSREADFIELDXZ ( OBSptrFile(iTracer), readBinaryPrec,
408         &          'RL', Nr, OBSptr0(1-Olx,1,1,1,iTracer),
409         &          inTime0, myThid )
410              ENDIF
411    # endif /* ALLOW_OBCS_SOUTH */
412    C     end do iTracer
413             ENDDO
414    C     end if (usePTRACERS)
415            ENDIF
416    #endif /* ALLOW_PTRACERS */
417          _END_MASTER(myThid)          _END_MASTER(myThid)
418  C     endif myIter .EQ. nIter0  C     endif myIter .EQ. nIter0
419         ENDIF         ENDIF
420         DO bj = myByLo(myThid), myByHi(myThid)  C     endif for periodicForcing
421          DO bi = myBxLo(myThid), myBxHi(myThid)        ENDIF
422           DO K = 1, Nr  
423            DO j=1-Oly,sNy+Oly  C--   Now interpolate OBSu, OBSv, OBSt, OBSs, OBSptr, etc.
424    C--   For periodicForcing, aWght = 0. and bWght = 1. so that the
425    C--   interpolation boilds down to copying the time-independent
426    C--   forcing field OBSu0 to OBSu
427  #ifdef ALLOW_OBCS_EAST  #ifdef ALLOW_OBCS_EAST
428             OBEu(j,k,bi,bj) = OBEu0(j,k,bi,bj)           IF ( OBEuFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
429             OBEv(j,k,bi,bj) = OBEv0(j,k,bi,bj)         &      OBEu, OBEu0, OBEu1, aWght, bWght, myThid )
430             OBEt(j,k,bi,bj) = OBEt0(j,k,bi,bj)           IF ( OBEvFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
431             OBEs(j,k,bi,bj) = OBEs0(j,k,bi,bj)         &      OBEv, OBEv0, OBEv1, aWght, bWght, myThid )
432           IF ( OBEtFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
433         &      OBEt, OBEt0, OBEt1, aWght, bWght, myThid )
434           IF ( OBEsFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
435         &      OBEs, OBEs0, OBEs1, aWght, bWght, myThid )
436  #endif /* ALLOW_OBCS_EAST */  #endif /* ALLOW_OBCS_EAST */
437  #ifdef ALLOW_OBCS_WEST  #ifdef ALLOW_OBCS_WEST
438             OBWu(j,k,bi,bj) = OBWu0(j,k,bi,bj)           IF ( OBWuFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
439             OBWv(j,k,bi,bj) = OBWv0(j,k,bi,bj)         &      OBWu, OBWu0, OBWu1, aWght, bWght, myThid )
440             OBWt(j,k,bi,bj) = OBWt0(j,k,bi,bj)           IF ( OBWvFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
441             OBWs(j,k,bi,bj) = OBWs0(j,k,bi,bj)         &      OBWv, OBWv0, OBWv1, aWght, bWght, myThid )
442           IF ( OBWtFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
443         &      OBWt, OBWt0, OBWt1, aWght, bWght, myThid )
444           IF ( OBWsFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
445         &      OBWs, OBWs0, OBWs1, aWght, bWght, myThid )
446  #endif /* ALLOW_OBCS_WEST */  #endif /* ALLOW_OBCS_WEST */
           ENDDO  
           DO i=1-Olx,sNx+Olx  
447  #ifdef ALLOW_OBCS_NORTH  #ifdef ALLOW_OBCS_NORTH
448             OBNu(i,k,bi,bj) = OBNu0(i,k,bi,bj)           IF ( OBNuFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
449             OBNv(i,k,bi,bj) = OBNv0(i,k,bi,bj)         &      OBNu, OBNu0, OBNu1, aWght, bWght, myThid )
450             OBNt(i,k,bi,bj) = OBNt0(i,k,bi,bj)           IF ( OBNvFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
451             OBNs(i,k,bi,bj) = OBNs0(i,k,bi,bj)         &      OBNv, OBNv0, OBNv1, aWght, bWght, myThid )
452           IF ( OBNtFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
453         &      OBNt, OBNt0, OBNt1, aWght, bWght, myThid )
454           IF ( OBNsFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
455         &      OBNs, OBNs0, OBNs1, aWght, bWght, myThid )
456  #endif /* ALLOW_OBCS_NORTH */  #endif /* ALLOW_OBCS_NORTH */
457  #ifdef ALLOW_OBCS_SOUTH  #ifdef ALLOW_OBCS_SOUTH
458             OBSu(i,k,bi,bj) = OBSu0(i,k,bi,bj)           IF ( OBSuFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
459             OBSv(i,k,bi,bj) = OBSv0(i,k,bi,bj)         &      OBSu, OBSu0, OBSu1, aWght, bWght, myThid )
460             OBSt(i,k,bi,bj) = OBSt0(i,k,bi,bj)           IF ( OBSvFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
461             OBSs(i,k,bi,bj) = OBSs0(i,k,bi,bj)         &      OBSv, OBSv0, OBSv1, aWght, bWght, myThid )
462           IF ( OBStFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
463         &      OBSt, OBSt0, OBSt1, aWght, bWght, myThid )
464           IF ( OBSsFile .NE. ' '  ) CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
465         &      OBSs, OBSs0, OBSs1, aWght, bWght, myThid )
466  #endif /* ALLOW_OBCS_SOUTH */  #endif /* ALLOW_OBCS_SOUTH */
467    #ifdef ALLOW_PTRACERS
468          IF (usePTRACERS) THEN
469    C     "interpolate" passive tracer boundary values
470           DO iTracer = 1, PTRACERS_numInUse
471    # ifdef ALLOW_OBCS_EAST
472            IF ( OBEptrFile(iTracer) .NE. ' '  )
473         &       CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
474         O       OBWptr (1-Oly,1,1,1,iTracer),
475         I       OBWptr0(1-Oly,1,1,1,iTracer),
476         I       OBWptr1(1-Oly,1,1,1,iTracer), aWght, bWght, myThid )
477    # endif /* ALLOW_OBCS_EAST */
478    # ifdef ALLOW_OBCS_WEST
479            IF ( OBWptrFile(iTracer) .NE. ' '  )
480         &       CALL OBCS_EXTERNAL_FIELDS_INTERP_YZ(
481         O       OBWptr (1-Oly,1,1,1,iTracer),
482         I       OBWptr0(1-Oly,1,1,1,iTracer),
483         I       OBWptr1(1-Oly,1,1,1,iTracer), aWght, bWght, myThid )
484    # endif /* ALLOW_OBCS_WEST */
485    # ifdef ALLOW_OBCS_NORTH
486            IF ( OBNptrFile(iTracer) .NE. ' '  )
487         &       CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
488         O       OBNptr (1-Olx,1,1,1,iTracer),
489         I       OBNptr0(1-Olx,1,1,1,iTracer),
490         I       OBNptr1(1-Olx,1,1,1,iTracer), aWght, bWght, myThid )
491    # endif /* ALLOW_OBCS_NORTH */
492    # ifdef ALLOW_OBCS_SOUTH
493            IF ( OBSptrFile(iTracer) .NE. ' '  )
494         &       CALL OBCS_EXTERNAL_FIELDS_INTERP_XZ(
495         O       OBSptr (1-Olx,1,1,1,iTracer),
496         I       OBSptr0(1-Olx,1,1,1,iTracer),
497         I       OBSptr1(1-Olx,1,1,1,iTracer), aWght, bWght, myThid )
498    # endif /* ALLOW_OBCS_SOUTH */
499    C     end do iTracer
500           ENDDO
501    C     end if (usePTRACERS)
502          ENDIF
503    #endif /* ALLOW_PTRACERS */
504    CMLC     endif for periodicForcing
505    CML      ENDIF
506    
507          RETURN
508          END
509    
510    CBOP
511    C     !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_XZ
512    C     !INTERFACE:
513          SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ(
514         O     fld,
515         I     fld0, fld1, aWght, bWght, myThid )
516    C     !DESCRIPTION: \bv
517    C     *==========================================================*
518    C     | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_XZ                      
519    C     | o Interpolate between to records
520    C     *==========================================================*
521    C     \ev
522    
523    C     !USES:
524          IMPLICIT NONE
525    C     === Global variables ===
526    #include "SIZE.h"
527    #include "EEPARAMS.h"
528    #include "PARAMS.h"
529    
530    C     !INPUT/OUTPUT PARAMETERS:
531    C     === Routine arguments ===
532    C     myThid - Thread no. that called this routine.
533    C     aWght, bWght :: Interpolation weights
534          INTEGER myThid
535          _RL aWght,bWght
536          _RL fld (1-Olx:sNx+Olx,Nr,nSx,nSy)
537          _RL fld0(1-Olx:sNx+Olx,Nr,nSx,nSy)
538          _RL fld1(1-Olx:sNx+Olx,Nr,nSx,nSy)
539    
540    C     !LOCAL VARIABLES:
541    C     === Local arrays ===
542    C     bi,bj,i,j :: loop counters
543          INTEGER bi,bj,i,k
544    CEOP
545           DO bj = myByLo(myThid), myByHi(myThid)
546            DO bi = myBxLo(myThid), myBxHi(myThid)
547             DO K = 1, Nr
548              DO i=1-Olx,sNx+Olx
549               fld(i,k,bi,bj)   = bWght*fld0(i,k,bi,bj)  
550         &                       +aWght*fld1(i,k,bi,bj)
551            ENDDO            ENDDO
552           ENDDO           ENDDO
553          ENDDO          ENDDO
554         ENDDO             ENDDO    
 C     endif for periodicForcing  
       ENDIF  
   
 #endif /* ALLOW_EXF */  
 #endif /* ALLOw_OBCS AND ALLOW_OBCS_PRESCRIBE */  
555    
556        RETURN        RETURN
557        END        END
558    CBOP
559    C     !ROUTINE: OBCS_EXTERNAL_FIELDS_INTERP_YZ
560    C     !INTERFACE:
561          SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ(
562         O     fld,
563         I     fld0, fld1, aWght, bWght, myThid )
564    C     !DESCRIPTION: \bv
565    C     *==========================================================*
566    C     | SUBROUTINE OBCS_EXTERNAL_FIELDS_INTERP_YZ                      
567    C     | o Interpolate between to records
568    C     *==========================================================*
569    C     \ev
570    
571    C     !USES:
572          IMPLICIT NONE
573    C     === Global variables ===
574    #include "SIZE.h"
575    #include "EEPARAMS.h"
576    #include "PARAMS.h"
577    
578    C     !INPUT/OUTPUT PARAMETERS:
579    C     === Routine arguments ===
580    C     myThid - Thread no. that called this routine.
581    C     aWght, bWght :: Interpolation weights
582          INTEGER myThid
583          _RL aWght,bWght
584          _RL fld (1-Oly:sNy+Oly,Nr,nSx,nSy)
585          _RL fld0(1-Oly:sNy+Oly,Nr,nSx,nSy)
586          _RL fld1(1-Oly:sNy+Oly,Nr,nSx,nSy)
587    
588    C     !LOCAL VARIABLES:
589    C     === Local arrays ===
590    C     bi,bj,i,j :: loop counters
591          INTEGER bi,bj,j,k
592    CEOP
593           DO bj = myByLo(myThid), myByHi(myThid)
594            DO bi = myBxLo(myThid), myBxHi(myThid)
595             DO K = 1, Nr
596              DO j=1-Oly,sNy+Oly
597               fld(j,k,bi,bj)   = bWght*fld0(j,k,bi,bj)  
598         &                       +aWght*fld1(j,k,bi,bj)
599              ENDDO
600             ENDDO
601            ENDDO
602           ENDDO    
603    
604    #endif /* ALLOW_OBCS AND ALLOW_OBCS_PRESCRIBE AND .NOT. ALLOW_EXF */
605    
606           RETURN
607           END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22