C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/rbcs/rbcs_fields_load.F,v 1.6 2007/10/09 00:09:25 jmc Exp $ C $Name: $ #include "CPP_OPTIONS.h" #include "PACKAGES_CONFIG.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.h" #endif #include "RBCS.h" C !INPUT/OUTPUT PARAMETERS: C === Routine arguments === C myThid - Thread no. that called this routine. C myTime - Simulation time C myIter - Simulation timestep number INTEGER myThid _RL myTime INTEGER myIter c fn :: Temp. for building file name. CHARACTER*(MAX_LEN_FNAM) fn CHARACTER*(MAX_LEN_FNAM) fn2 INTEGER prec 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 INTEGER I1, I2 INTEGER iTracer INTEGER IFNBLNK, ILNBLNK EXTERNAL IFNBLNK, ILNBLNK #ifdef ALLOW_RBCS CALL TIMER_START('RBCS_FIELDS_LOAD [I/O]', myThid) prec = readBinaryPrec 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.d0 rbcs0(i,j,k,bi,bj)=0.d0 rbct1(i,j,k,bi,bj)=0.d0 rbcs1(i,j,k,bi,bj)=0.d0 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.d0 rbcptr1(i,j,k,bi,bj,iTracer)=0.d0 ENDDO ENDDO enddo ENDDO ENDDO ENDDO #endif ENDIF C Now calculate whether it is time to update the forcing arrays if (rbcsForcingCycle.gt.0.d0) then rdt=1. _d 0 / deltaTclock nForcingPeriods=int(rbcsForcingCycle/rbcsForcingPeriod+0.5) Imytm=int((myTime-float(rbcsIniter)*deltaTclock)*rdt+0.5) Ifprd=int(rbcsForcingPeriod*rdt+0.5) Ifcyc=int(rbcsForcingCycle*rdt+0.5) Iftm=mod( Imytm+Ifcyc-Ifprd/2 ,Ifcyc) intime0=int(Iftm/Ifprd) intime1=mod(intime0+1,nForcingPeriods) aWght=float( Iftm-Ifprd*intime0 )/float( Ifprd ) bWght=1.-aWght intime0=intime0+1 INTIME1=intime1+1 else intime1=1 intime0=1 Iftm=1 Ifprd=0 aWght=.5d0 bWght=.5d0 endif IF ( & Iftm-Ifprd*(intime0-1) .EQ. 0 & .OR. myIter .EQ. nIter0 & ) THEN _BEGIN_MASTER(myThid) C If the above condition is met then we need to read in C data for the period ahead and the period behind myTime. WRITE(*,*) & 'S/R RBCS_FIELDS_LOAD: Reading new data',myTime,myIter & , nIter0, intime0,intime1 c IF ( relaxTFile .NE. ' ' ) THEN CALL MDSREADFIELD ( relaxTFile, prec, & 'RS', Nr, rbct0, intime0, myThid ) CALL MDSREADFIELD ( relaxTFile, prec, & 'RS', Nr, rbct1, intime1, myThid ) ENDIF IF ( relaxSFile .NE. ' ' ) THEN CALL MDSREADFIELD ( relaxSFile, prec, & 'RS', Nr, rbcs0, intime0, myThid ) CALL MDSREADFIELD ( relaxSFile, prec, & 'RS', Nr, rbcs1, intime1, myThid ) ENDIF #ifdef ALLOW_PTRACERS if (useRBCptracers) then DO iTracer = 1, PTRACERS_numInUse if (useRBCptrnum(iTracer)) then WRITE(fn,'(A)') relaxPtracerFile(iTracer) CALL MDSREADFIELD ( fn, prec, & 'RS', Nr, rbcptr0(1-Olx,1-Oly,1,1,1,iTracer), & intime0, myThid ) CALL MDSREADFIELD ( fn, prec, & 'RS', Nr, rbcptr1(1-Olx,1-Oly,1,1,1,iTracer), & intime1, myThid ) endif ENDDO endif #endif c _END_MASTER(myThid) C _EXCH_XYZ_R4(rbct0 , myThid ) _EXCH_XYZ_R4(rbct1 , myThid ) _EXCH_XYZ_R4(rbcs0 , myThid ) _EXCH_XYZ_R4(rbcs1 , myThid ) #ifdef ALLOW_PTRACERS if (useRBCptracers) then DO iTracer = 1, PTRACERS_numInUse _EXCH_XYZ_R4(rbcptr0(1-Olx,1-Oly,1,1,1,iTracer),myThid) _EXCH_XYZ_R4(rbcptr1(1-Olx,1-Oly,1,1,1,iTracer),myThid) ENDDO endif #endif c ENDIF c 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 (useRBCptracers) 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 CALL TIMER_STOP ('RBCS_FIELDS_LOAD [I/O]', myThid) #endif c! ALLOW_RBCS RETURN END