C $Header: /u/gcmpack/MITgcm/pkg/rbcs/rbcs_fields_load.F,v 1.10 2010/04/06 20:38:18 jmc Exp $
C $Name: $
#include "RBCS_OPTIONS.h"
C !ROUTINE: RBCS_FIELDS_LOAD
C !INTERFACE:
SUBROUTINE RBCS_FIELDS_LOAD( myTime, myIter, myThid )
C *==========================================================*
C | SUBROUTINE RBCS_FIELDS_LOAD
C | o Control reading of fields from external source.
C *==========================================================*
C | Offline External source field loading routine.
C | This routine is called every time we want to
C | load a a set of external fields. The routine decides
C | which fields to load and then reads them in.
C | This routine needs to be customised for particular
C | experiments.
C *==========================================================*
C !USES:
IMPLICIT NONE
C === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "FFIELDS.h"
#include "GRID.h"
#include "DYNVARS.h"
#ifdef ALLOW_PTRACERS
#include "PTRACERS_SIZE.h"
#include "PTRACERS_PARAMS.h"
#endif
#include "RBCS.h"
C !INPUT/OUTPUT PARAMETERS:
C === Routine arguments ===
C myTime :: Simulation time
C myIter :: Simulation timestep number
C myThid :: Thread no. that called this routine.
_RL myTime
INTEGER myIter
INTEGER myThid
C !FUNCTIONS:
INTEGER IFNBLNK, ILNBLNK
EXTERNAL , ILNBLNK
C !LOCAL VARIABLES:
C === Local arrays ===
C [01] :: End points for interpolation
C Above use static heap storage to allow exchange.
C aWght, bWght :: Interpolation weights
INTEGER bi,bj,i,j,k,intime0,intime1
_RL aWght,bWght,rdt
INTEGER nForcingPeriods,Imytm,Ifprd,Ifcyc,Iftm
#ifdef ALLOW_PTRACERS
INTEGER iTracer
#endif
#ifdef ALLOW_RBCS
CALL TIMER_START('RBCS_FIELDS_LOAD [I/O]', myThid)
C First call requires that we initialize everything to zero for safety
IF ( myIter .EQ. nIter0 ) THEN
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO k=1,Nr
DO j=1-Oly,sNy+Oly
DO i=1-Olx,sNx+Olx
rbct0(i,j,k,bi,bj)=0. _d 0
rbcs0(i,j,k,bi,bj)=0. _d 0
rbct1(i,j,k,bi,bj)=0. _d 0
rbcs1(i,j,k,bi,bj)=0. _d 0
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
#ifdef ALLOW_PTRACERS
DO iTracer = 1, PTRACERS_numInUse
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO k=1,Nr
DO j=1-Oly,sNy+Oly
DO i=1-Olx,sNx+Olx
rbcptr0(i,j,k,bi,bj,iTracer)=0. _d 0
rbcptr1(i,j,k,bi,bj,iTracer)=0. _d 0
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
#endif
ENDIF
C Now calculate whether it is time to update the forcing arrays
IF ( rbcsForcingCycle.GT.0. _d 0 ) THEN
rdt = 1. _d 0 / deltaTclock
nForcingPeriods = NINT(rbcsForcingCycle/rbcsForcingPeriod)
Imytm = NINT( (myTime-rbcsIniter*deltaTclock)*rdt )
Ifprd = NINT(rbcsForcingPeriod*rdt)
Ifcyc = NINT(rbcsForcingCycle*rdt)
Iftm = MOD( Imytm+Ifcyc-Ifprd/2, Ifcyc)
intime0 = 1 + INT( Iftm/Ifprd )
intime1 = 1 + MOD( intime0,nForcingPeriods )
c aWght = DFLOAT( Iftm-Ifprd*(intime0 - 1) ) / DFLOAT( Ifprd )
aWght = FLOAT( Iftm-Ifprd*(intime0 - 1) )
bWght = FLOAT( Ifprd )
aWght = aWght / bWght
bWght = 1. _d 0 - aWght
ELSE
intime1 = 1
intime0 = 1
Iftm = 1
Ifprd = 0
aWght = .5 _d 0
bWght = .5 _d 0
ENDIF
IF (
& Iftm-Ifprd*(intime0-1) .EQ. 0
& .OR. myIter .EQ. nIter0
& ) THEN
C If the above condition is met then we need to read in
C data for the period ahead and the period behind myTime.
_BEGIN_MASTER(myThid)
WRITE(standardMessageUnit,'(A,2I5,I10,1P1E20.12)')
& 'S/R RBCS_FIELDS_LOAD: Reading new data:',
& intime0, intime1, myIter, myTime
_END_MASTER(myThid)
IF ( useRBCtemp .AND. relaxTFile .NE. ' ' ) THEN
CALL READ_REC_XYZ_RS(relaxTFile, rbct0, intime0, myIter,myThid)
CALL READ_REC_XYZ_RS(relaxTFile, rbct1, intime1, myIter,myThid)
ENDIF
IF ( useRBCsalt .AND. relaxSFile .NE. ' ' ) THEN
CALL READ_REC_XYZ_RS(relaxSFile, rbcs0, intime0, myIter,myThid)
CALL READ_REC_XYZ_RS(relaxSFile, rbcs1, intime1, myIter,myThid)
ENDIF
#ifdef ALLOW_PTRACERS
IF ( usePTRACERS ) THEN
DO iTracer = 1, PTRACERS_numInUse
IF ( useRBCptrnum(iTracer) .AND.
& relaxPtracerFile(iTracer).NE. ' ' ) THEN
CALL READ_REC_XYZ_RS( relaxPtracerFile(iTracer),
& rbcptr0(1-Olx,1-Oly,1,1,1,iTracer),
& intime0, myIter, myThid )
CALL READ_REC_XYZ_RS( relaxPtracerFile(iTracer),
& rbcptr1(1-Olx,1-Oly,1,1,1,iTracer),
& intime1, myIter, myThid )
ENDIF
ENDDO
ENDIF
#endif
IF ( useRBCtemp .AND. relaxTFile .NE. ' ' ) THEN
CALL EXCH_XYZ_RS( rbct0 , myThid )
CALL EXCH_XYZ_RS( rbct1 , myThid )
ENDIF
IF ( useRBCsalt .AND. relaxSFile .NE. ' ' ) THEN
CALL EXCH_XYZ_RS( rbcs0 , myThid )
CALL EXCH_XYZ_RS( rbcs1 , myThid )
ENDIF
#ifdef ALLOW_PTRACERS
IF (usePTRACERS) THEN
DO iTracer = 1, PTRACERS_numInUse
IF ( useRBCptrnum(iTracer) ) THEN
CALL EXCH_XYZ_RS( rbcptr0(1-Olx,1-Oly,1,1,1,iTracer),myThid )
CALL EXCH_XYZ_RS( rbcptr1(1-Olx,1-Oly,1,1,1,iTracer),myThid )
ENDIF
ENDDO
ENDIF
#endif /* ALLOW_PTRACERS */
ENDIF
C-- Interpolate
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO k=1,Nr
DO j=1-Oly,sNy+Oly
DO i=1-Olx,sNx+Olx
RBCtemp(i,j,k,bi,bj) = bWght*rbct0(i,j,k,bi,bj)
& +aWght*rbct1(i,j,k,bi,bj)
RBCsalt(i,j,k,bi,bj) = bWght*rbcs0(i,j,k,bi,bj)
& +aWght*rbcs1(i,j,k,bi,bj)
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
#ifdef ALLOW_PTRACERS
IF ( usePTRACERS ) THEN
DO iTracer = 1, PTRACERS_numInUse
IF (useRBCptrnum(iTracer)) THEN
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO k=1,Nr
DO j=1-Oly,sNy+Oly
DO i=1-Olx,sNx+Olx
RBC_ptracers(i,j,k,bi,bj,iTracer) =
& bWght*rbcptr0(i,j,k,bi,bj,iTracer)
& +aWght*rbcptr1(i,j,k,bi,bj,iTracer)
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
ENDIF
ENDDO
ENDIF
#endif /* ALLOW_PTRACERS */
CALL TIMER_STOP ('RBCS_FIELDS_LOAD [I/O]', myThid)
#endif /* ALLOW_RBCS */
RETURN
END