Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:43:04 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
c3afacc940 Jean*0001 #include "RBCS_OPTIONS.h"
7c7521a1da Jean*0002 
5a13c92ce6 Step*0003 C     !ROUTINE: RBCS_FIELDS_LOAD
                0004 C     !INTERFACE:
                0005       SUBROUTINE RBCS_FIELDS_LOAD( myTime, myIter, myThid )
72a8e44ea5 Jean*0006 
                0007 C     !DESCRIPTION: \bv
5a13c92ce6 Step*0008 C     *==========================================================*
7c7521a1da Jean*0009 C     | SUBROUTINE RBCS_FIELDS_LOAD
                0010 C     | o Control reading of fields from external source.
5a13c92ce6 Step*0011 C     *==========================================================*
72a8e44ea5 Jean*0012 C     | RBCS External source field loading routine.
7c7521a1da Jean*0013 C     | This routine is called every time we want to
                0014 C     | load a a set of external fields. The routine decides
                0015 C     | which fields to load and then reads them in.
5a13c92ce6 Step*0016 C     *==========================================================*
72a8e44ea5 Jean*0017 C     \ev
5a13c92ce6 Step*0018 
                0019 C     !USES:
                0020       IMPLICIT NONE
                0021 C     === Global variables ===
                0022 #include "SIZE.h"
                0023 #include "EEPARAMS.h"
                0024 #include "PARAMS.h"
                0025 #ifdef ALLOW_PTRACERS
                0026 #include "PTRACERS_SIZE.h"
2ead855d15 Jean*0027 #include "PTRACERS_PARAMS.h"
5a13c92ce6 Step*0028 #endif
a16c4403c6 Jean*0029 #include "RBCS_SIZE.h"
                0030 #include "RBCS_PARAMS.h"
                0031 #include "RBCS_FIELDS.h"
5a13c92ce6 Step*0032 
                0033 C     !INPUT/OUTPUT PARAMETERS:
                0034 C     === Routine arguments ===
2ead855d15 Jean*0035 C     myTime :: Simulation time
                0036 C     myIter :: Simulation timestep number
                0037 C     myThid :: Thread no. that called this routine.
5a13c92ce6 Step*0038       _RL     myTime
                0039       INTEGER myIter
2ead855d15 Jean*0040       INTEGER myThid
5a13c92ce6 Step*0041 
c3afacc940 Jean*0042 C     !FUNCTIONS:
                0043       INTEGER  IFNBLNK, ILNBLNK
                0044       EXTERNAL IFNBLNK, ILNBLNK
                0045 
5a13c92ce6 Step*0046 C     !LOCAL VARIABLES:
                0047 C     === Local arrays ===
                0048 C     [01]      :: End points for interpolation
                0049 C     Above use static heap storage to allow exchange.
                0050 C     aWght, bWght :: Interpolation weights
                0051 
72a8e44ea5 Jean*0052       INTEGER bi, bj, i, j, k
                0053       INTEGER intimeP, intime0, intime1
                0054       _RL aWght, bWght, locTime
                0055       INTEGER Ifprd
c3afacc940 Jean*0056 #ifdef ALLOW_PTRACERS
5a13c92ce6 Step*0057       INTEGER iTracer
c3afacc940 Jean*0058 #endif
fb7cd45a1a Oliv*0059       INTEGER IL, initer0, initer1
                0060       CHARACTER*(MAX_LEN_FNAM) fullName
72a8e44ea5 Jean*0061 CEOP
5a13c92ce6 Step*0062 
                0063 #ifdef ALLOW_RBCS
                0064       CALL TIMER_START('RBCS_FIELDS_LOAD      [I/O]', myThid)
                0065 
72a8e44ea5 Jean*0066 C--   First call requires that we initialize everything to zero for safety
                0067 C      <= already done in RBCS_INIT_VARIA
5a13c92ce6 Step*0068 
72a8e44ea5 Jean*0069 C--   Now calculate whether it is time to update the forcing arrays
                0070       bi = myBxLo(myThid)
                0071       bj = myByLo(myThid)
fb7cd45a1a Oliv*0072       IF (rbcsForcingPeriod.GT.0. _d 0) THEN
72a8e44ea5 Jean*0073        locTime = myTime - rbcsForcingOffset
                0074        CALL GET_PERIODIC_INTERVAL(
                0075      O                   intimeP, intime0, intime1, bWght, aWght,
                0076      I                   rbcsForcingCycle, rbcsForcingPeriod,
                0077      I                   deltaTclock, locTime, myThid )
                0078 #ifdef ALLOW_DEBUG
8830b8f970 Jean*0079        IF ( debugLevel.GE.debLevB ) THEN
72a8e44ea5 Jean*0080         _BEGIN_MASTER(myThid)
                0081         WRITE(standardMessageUnit,'(A,I10,A,4I5,A,2F14.10)')
                0082      &   ' RBCS_FIELDS_LOAD,', myIter,
                0083      &   ' : iP,iLd,i0,i1=', intimeP,rbcsLdRec(bi,bj), intime0,intime1,
                0084      &   ' ; Wght=', bWght, aWght
                0085         _END_MASTER(myThid)
fb7cd45a1a Oliv*0086        ENDIF
72a8e44ea5 Jean*0087 #endif /* ALLOW_DEBUG */
2ead855d15 Jean*0088       ELSE
72a8e44ea5 Jean*0089        intimeP = 1
cf3acdaa63 Jean*0090        intime1 = 1
                0091        intime0 = 1
                0092        aWght = .5 _d 0
                0093        bWght = .5 _d 0
2ead855d15 Jean*0094       ENDIF
5a13c92ce6 Step*0095 
72a8e44ea5 Jean*0096 #ifdef ALLOW_AUTODIFF_TAMC
                0097 C-    assuming that we call S/R RBCS_FIELDS_LOAD at each time-step and
                0098 C     with increasing time, this will catch when we need to load new records;
                0099 C     But with Adjoint run, this is not always the case => might end-up using
                0100 C     the wrong time-records
                0101       IF ( intime0.NE.intimeP .OR. myIter.EQ.nIter0 ) THEN
                0102 #else /* ALLOW_AUTODIFF_TAMC */
                0103 C-    Make no assumption on sequence of calls to RBCS_FIELDS_LOAD ;
                0104 C     This is the correct formulation (works in Adjoint run).
                0105 C     Unfortunatly, produces many recomputations <== not used until it is fixed
                0106       IF ( intime1.NE.rbcsLdRec(bi,bj) ) THEN
                0107 #endif /* ALLOW_AUTODIFF_TAMC */
                0108 
                0109 C--   If the above condition is met then we need to read in
                0110 C     data for the period ahead and the period behind myTime.
8830b8f970 Jean*0111        IF ( debugLevel.GE.debLevZero ) THEN
                0112         _BEGIN_MASTER(myThid)
                0113         WRITE(standardMessageUnit,'(A,I10,A,2(2I5,A))')
                0114      &    ' RBCS_FIELDS_LOAD, it=', myIter,
                0115      &    ' : Reading new data, i0,i1=', intime0, intime1,
72a8e44ea5 Jean*0116      &    ' (prev=', intimeP, rbcsLdRec(bi,bj), ' )'
8830b8f970 Jean*0117         _END_MASTER(myThid)
                0118        ENDIF
5a13c92ce6 Step*0119 
72a8e44ea5 Jean*0120 C     for rbcsSingleTimeFiles=.TRUE.
                0121        Ifprd = NINT(rbcsForcingPeriod/deltaTrbcs)
                0122        initer0 = rbcsIter0 + intime0*Ifprd
                0123        initer1 = rbcsIter0 + intime1*Ifprd
                0124 
a16c4403c6 Jean*0125 #ifndef DISABLE_RBCS_MOM
                0126        IF ( useRBCuVel .AND. relaxUFile.NE.' '  ) THEN
                0127         IF ( rbcsSingleTimeFiles ) THEN
                0128          IL=ILNBLNK( relaxUFile )
                0129          WRITE(fullName,'(2A,I10.10)') relaxUFile(1:IL),'.',initer0
                0130          CALL READ_REC_XYZ_RS(fullName, rbcu0, 1, myIter, myThid)
                0131          WRITE(fullName,'(2A,I10.10)') relaxUFile(1:IL),'.',initer1
                0132          CALL READ_REC_XYZ_RS(fullName, rbcu1, 1, myIter, myThid)
                0133         ELSE
                0134          CALL READ_REC_XYZ_RS(relaxUFile,rbcu0,intime0,myIter,myThid)
                0135          CALL READ_REC_XYZ_RS(relaxUFile,rbcu1,intime1,myIter,myThid)
                0136         ENDIF
                0137        ENDIF
                0138        IF ( useRBCvVel .AND. relaxVFile.NE.' '  ) THEN
                0139         IF ( rbcsSingleTimeFiles ) THEN
                0140          IL=ILNBLNK( relaxVFile )
                0141          WRITE(fullName,'(2A,I10.10)') relaxVFile(1:IL),'.',initer0
                0142          CALL READ_REC_XYZ_RS(fullName, rbcv0, 1, myIter, myThid)
                0143          WRITE(fullName,'(2A,I10.10)') relaxVFile(1:IL),'.',initer1
                0144          CALL READ_REC_XYZ_RS(fullName, rbcv1, 1, myIter, myThid)
                0145         ELSE
                0146          CALL READ_REC_XYZ_RS(relaxVFile,rbcv0,intime0,myIter,myThid)
                0147          CALL READ_REC_XYZ_RS(relaxVFile,rbcv1,intime1,myIter,myThid)
                0148         ENDIF
                0149        ENDIF
                0150        IF ( (useRBCuVel .AND. relaxUFile.NE.' ') .OR.
                0151      &      (useRBCvVel .AND. relaxVFile.NE.' ') ) THEN
                0152         CALL EXCH_UV_XYZ_RS( rbcu0, rbcv0, .TRUE., myThid )
                0153         CALL EXCH_UV_XYZ_RS( rbcu1, rbcv1, .TRUE., myThid )
                0154        ENDIF
                0155 #endif /* DISABLE_RBCS_MOM */
c3afacc940 Jean*0156        IF ( useRBCtemp .AND. relaxTFile .NE. ' '  ) THEN
fb7cd45a1a Oliv*0157         IF ( rbcsSingleTimeFiles ) THEN
                0158          IL=ILNBLNK( relaxTFile )
                0159          WRITE(fullName,'(2a,i10.10)') relaxTFile(1:IL),'.',initer0
                0160          CALL READ_REC_XYZ_RS(fullName, rbct0, 1, myIter, myThid)
                0161          WRITE(fullName,'(2a,i10.10)') relaxTFile(1:IL),'.',initer1
                0162          CALL READ_REC_XYZ_RS(fullName, rbct1, 1, myIter, myThid)
                0163         ELSE
                0164          CALL READ_REC_XYZ_RS(relaxTFile,rbct0,intime0,myIter,myThid)
                0165          CALL READ_REC_XYZ_RS(relaxTFile,rbct1,intime1,myIter,myThid)
                0166         ENDIF
a16c4403c6 Jean*0167         CALL EXCH_XYZ_RS( rbct0 , myThid )
                0168         CALL EXCH_XYZ_RS( rbct1 , myThid )
5a13c92ce6 Step*0169        ENDIF
c3afacc940 Jean*0170        IF ( useRBCsalt .AND. relaxSFile .NE. ' '  ) THEN
fb7cd45a1a Oliv*0171         IF ( rbcsSingleTimeFiles ) THEN
                0172          IL=ILNBLNK( relaxSFile )
                0173          WRITE(fullName,'(2a,i10.10)') relaxSFile(1:IL),'.',initer0
                0174          CALL READ_REC_XYZ_RS(fullName, rbcs0, 1, myIter, myThid)
                0175          WRITE(fullName,'(2a,i10.10)') relaxSFile(1:IL),'.',initer1
                0176          CALL READ_REC_XYZ_RS(fullName, rbcs1, 1, myIter, myThid)
                0177         ELSE
                0178          CALL READ_REC_XYZ_RS(relaxSFile,rbcs0,intime0,myIter,myThid)
                0179          CALL READ_REC_XYZ_RS(relaxSFile,rbcs1,intime1,myIter,myThid)
                0180         ENDIF
a16c4403c6 Jean*0181         CALL EXCH_XYZ_RS( rbcs0 , myThid )
                0182         CALL EXCH_XYZ_RS( rbcs1 , myThid )
5a13c92ce6 Step*0183        ENDIF
                0184 
                0185 #ifdef ALLOW_PTRACERS
c3afacc940 Jean*0186        IF ( usePTRACERS ) THEN
2ead855d15 Jean*0187         DO iTracer = 1, PTRACERS_numInUse
c3afacc940 Jean*0188          IF ( useRBCptrnum(iTracer) .AND.
                0189      &        relaxPtracerFile(iTracer).NE. ' ' ) THEN
fb7cd45a1a Oliv*0190           IF ( rbcsSingleTimeFiles ) THEN
                0191            IL=ILNBLNK( relaxPtracerFile(iTracer) )
                0192            WRITE(fullName,'(2a,i10.10)') relaxPtracerFile(iTracer)(1:IL)
                0193      &                                   ,'.',initer0
                0194            CALL READ_REC_XYZ_RS( fullName,
                0195      &                           rbcptr0(1-Olx,1-Oly,1,1,1,iTracer),
                0196      &                           1, myIter, myThid )
                0197            WRITE(fullName,'(2a,i10.10)') relaxPtracerFile(iTracer)(1:IL)
                0198      &                                   ,'.',initer1
                0199            CALL READ_REC_XYZ_RS( fullName,
                0200      &                           rbcptr1(1-Olx,1-Oly,1,1,1,iTracer),
                0201      &                           1, myIter, myThid )
                0202           ELSE
2ead855d15 Jean*0203            CALL READ_REC_XYZ_RS( relaxPtracerFile(iTracer),
                0204      &                           rbcptr0(1-Olx,1-Oly,1,1,1,iTracer),
                0205      &                           intime0, myIter, myThid )
                0206            CALL READ_REC_XYZ_RS( relaxPtracerFile(iTracer),
                0207      &                           rbcptr1(1-Olx,1-Oly,1,1,1,iTracer),
                0208      &                           intime1, myIter, myThid )
fb7cd45a1a Oliv*0209           ENDIF
c3afacc940 Jean*0210           CALL EXCH_XYZ_RS( rbcptr0(1-Olx,1-Oly,1,1,1,iTracer),myThid )
                0211           CALL EXCH_XYZ_RS( rbcptr1(1-Olx,1-Oly,1,1,1,iTracer),myThid )
                0212          ENDIF
2ead855d15 Jean*0213         ENDDO
                0214        ENDIF
c3afacc940 Jean*0215 #endif /* ALLOW_PTRACERS */
7c7521a1da Jean*0216 
72a8e44ea5 Jean*0217 C-    save newly loaded time-record
                0218        DO bj = myByLo(myThid), myByHi(myThid)
                0219          DO bi = myBxLo(myThid), myBxHi(myThid)
                0220            rbcsLdRec(bi,bj) = intime1
                0221          ENDDO
                0222        ENDDO
                0223 
                0224 C--   end if-block for loading new time-records
5a13c92ce6 Step*0225       ENDIF
7c7521a1da Jean*0226 
                0227 C--   Interpolate
5a13c92ce6 Step*0228       DO bj = myByLo(myThid), myByHi(myThid)
                0229        DO bi = myBxLo(myThid), myBxHi(myThid)
a16c4403c6 Jean*0230 #ifndef DISABLE_RBCS_MOM
                0231         IF ( useRBCuVel .OR. useRBCvVel ) THEN
                0232          DO k=1,Nr
                0233           DO j=1-Oly,sNy+Oly
                0234            DO i=1-Olx,sNx+Olx
                0235             RBCuVel(i,j,k,bi,bj) = bWght*rbcu0(i,j,k,bi,bj)
                0236      &                            +aWght*rbcu1(i,j,k,bi,bj)
                0237             RBCvVel(i,j,k,bi,bj) = bWght*rbcv0(i,j,k,bi,bj)
                0238      &                            +aWght*rbcv1(i,j,k,bi,bj)
                0239            ENDDO
                0240           ENDDO
                0241          ENDDO
                0242         ENDIF
                0243 #endif /* DISABLE_RBCS_MOM */
                0244          DO k=1,Nr
                0245           DO j=1-Oly,sNy+Oly
                0246            DO i=1-Olx,sNx+Olx
                0247             RBCtemp(i,j,k,bi,bj) = bWght*rbct0(i,j,k,bi,bj)
                0248      &                            +aWght*rbct1(i,j,k,bi,bj)
                0249             RBCsalt(i,j,k,bi,bj) = bWght*rbcs0(i,j,k,bi,bj)
                0250      &                            +aWght*rbcs1(i,j,k,bi,bj)
                0251            ENDDO
2ead855d15 Jean*0252           ENDDO
5a13c92ce6 Step*0253          ENDDO
                0254        ENDDO
                0255       ENDDO
                0256 
                0257 #ifdef ALLOW_PTRACERS
c3afacc940 Jean*0258       IF ( usePTRACERS ) THEN
2ead855d15 Jean*0259        DO iTracer = 1, PTRACERS_numInUse
                0260         IF (useRBCptrnum(iTracer)) THEN
                0261          DO bj = myByLo(myThid), myByHi(myThid)
5a13c92ce6 Step*0262           DO bi = myBxLo(myThid), myBxHi(myThid)
2ead855d15 Jean*0263            DO k=1,Nr
                0264             DO j=1-Oly,sNy+Oly
                0265              DO i=1-Olx,sNx+Olx
                0266                RBC_ptracers(i,j,k,bi,bj,iTracer) =
53faeb7c01 Step*0267      &                      bWght*rbcptr0(i,j,k,bi,bj,iTracer)
                0268      &                     +aWght*rbcptr1(i,j,k,bi,bj,iTracer)
2ead855d15 Jean*0269              ENDDO
5a13c92ce6 Step*0270             ENDDO
                0271            ENDDO
                0272           ENDDO
2ead855d15 Jean*0273          ENDDO
                0274         ENDIF
                0275        ENDDO
                0276       ENDIF
c3afacc940 Jean*0277 #endif /* ALLOW_PTRACERS */
5a13c92ce6 Step*0278 
2ead855d15 Jean*0279       CALL TIMER_STOP ('RBCS_FIELDS_LOAD      [I/O]', myThid)
5a13c92ce6 Step*0280 
2ead855d15 Jean*0281 #endif /* ALLOW_RBCS */
5a13c92ce6 Step*0282 
                0283       RETURN
                0284       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!