Back to home page

MITgcm
 
 

    

File indexing completed on 2019-11-09 06:10:30 UTC

view on githubraw file Latest commit 566c6908 on 2019-10-29 16:03:07 UTC
212a8d049e Ed H*0001 #include "PACKAGES_CONFIG.h"
77af23a186 Patr*0002 #include "CPP_OPTIONS.h"
d197c88195 Jean*0003 
9366854e02 Chri*0004 CBOP
                0005 C     !ROUTINE: EXTERNAL_FIELDS_LOAD
                0006 C     !INTERFACE:
77af23a186 Patr*0007       SUBROUTINE EXTERNAL_FIELDS_LOAD( myTime, myIter, myThid )
23d1f65433 Jean*0008 
9366854e02 Chri*0009 C     !DESCRIPTION: \bv
                0010 C     *==========================================================*
d197c88195 Jean*0011 C     | SUBROUTINE EXTERNAL_FIELDS_LOAD
                0012 C     | o Control reading of fields from external source.
9366854e02 Chri*0013 C     *==========================================================*
d197c88195 Jean*0014 C     | External source field loading routine.
                0015 C     | This routine is called every time we want to
                0016 C     | load a a set of external fields. The routine decides
                0017 C     | which fields to load and then reads them in.
                0018 C     | This routine needs to be customised for particular
                0019 C     | experiments.
                0020 C     | Notes
                0021 C     | =====
                0022 C     | Two-dimensional and three-dimensional I/O are handled in
                0023 C     | the following way under MITgcmUV. A master thread
                0024 C     | performs I/O using system calls. This threads reads data
                0025 C     | into a temporary buffer. At present the buffer is loaded
                0026 C     | with the entire model domain. This is probably OK for now
                0027 C     | Each thread then copies data from the buffer to the
                0028 C     | region of the proper array it is responsible for.
                0029 C     | =====
                0030 C     | Conversion of flux fields are described in FFIELDS.h
9366854e02 Chri*0031 C     *==========================================================*
                0032 C     \ev
                0033 
                0034 C     !USES:
77af23a186 Patr*0035       IMPLICIT NONE
                0036 C     === Global variables ===
                0037 #include "SIZE.h"
                0038 #include "EEPARAMS.h"
                0039 #include "PARAMS.h"
                0040 #include "FFIELDS.h"
                0041 #include "GRID.h"
150696feb5 Patr*0042 #include "DYNVARS.h"
d197c88195 Jean*0043 
9366854e02 Chri*0044 C     !INPUT/OUTPUT PARAMETERS:
77af23a186 Patr*0045 C     === Routine arguments ===
5ea8ab5cf8 Jean*0046 C     myTime :: Simulation time
                0047 C     myIter :: Simulation timestep number
                0048 C     myThid :: Thread no. that called this routine.
77af23a186 Patr*0049       _RL     myTime
                0050       INTEGER myIter
5ea8ab5cf8 Jean*0051       INTEGER myThid
d197c88195 Jean*0052 
a8bcab80b7 Jean*0053 #ifndef EXCLUDE_FFIELDS_LOAD
                0054 
9366854e02 Chri*0055 C     !LOCAL VARIABLES:
77af23a186 Patr*0056 C     === Local arrays ===
9366854e02 Chri*0057 C     aWght, bWght :: Interpolation weights
5ea8ab5cf8 Jean*0058       INTEGER bi, bj, i, j
                0059       INTEGER intimeP, intime0, intime1
                0060       _RL aWght, bWght
9366854e02 Chri*0061 CEOP
77af23a186 Patr*0062 
                0063       IF ( periodicExternalForcing ) THEN
                0064 
5ea8ab5cf8 Jean*0065 C--   First call requires that we initialize everything to zero for safety
                0066 cph   has been shifted to ini_forcing.F
                0067 
                0068 C--   Now calculate whether it is time to update the forcing arrays
                0069       CALL GET_PERIODIC_INTERVAL(
                0070      O                  intimeP, intime0, intime1, bWght, aWght,
                0071      I                  externForcingCycle, externForcingPeriod,
02d90fb24c Jean*0072      I                  deltaTClock, myTime, myThid )
5ea8ab5cf8 Jean*0073 
                0074       bi = myBxLo(myThid)
                0075       bj = myByLo(myThid)
64fdb3fc13 Jean*0076 #ifdef ALLOW_DEBUG
23d1f65433 Jean*0077       IF ( debugLevel.GE.debLevB ) THEN
64fdb3fc13 Jean*0078         _BEGIN_MASTER(myThid)
                0079         WRITE(standardMessageUnit,'(A,I10,A,4I5,A,2F14.10)')
                0080      &   ' EXTERNAL_FIELDS_LOAD,', myIter,
                0081      &   ' : iP,iLd,i0,i1=', intimeP,loadedRec(bi,bj), intime0,intime1,
                0082      &   ' ; Wght=', bWght, aWght
                0083         _END_MASTER(myThid)
                0084       ENDIF
                0085 #endif /* ALLOW_DEBUG */
02d90fb24c Jean*0086 #ifdef ALLOW_AUTODIFF
5ea8ab5cf8 Jean*0087 C-    assuming that we call S/R EXTERNAL_FIELDS_LOAD at each time-step and
                0088 C     with increasing time, this will catch when we need to load new records;
                0089 C     But with Adjoint run, this is not always the case => might end-up using
                0090 C     the wrong time-records
411bc8ffc5 Jean*0091 # ifndef STORE_LOADEDREC_TEST
5ea8ab5cf8 Jean*0092       IF ( intime0.NE.intimeP .OR. myIter.EQ.nIter0 ) THEN
411bc8ffc5 Jean*0093 # else
                0094       IF ( intime1.NE.loadedRec(bi,bj) ) THEN
                0095 # endif
02d90fb24c Jean*0096 #else /* ALLOW_AUTODIFF */
5ea8ab5cf8 Jean*0097 C-    Make no assumption on sequence of calls to EXTERNAL_FIELDS_LOAD ;
                0098 C     This is the correct formulation (works in Adjoint run).
                0099 C     Unfortunatly, produces many recomputations <== not used until it is fixed
64fdb3fc13 Jean*0100       IF ( intime1.NE.loadedRec(bi,bj) ) THEN
02d90fb24c Jean*0101 #endif /* ALLOW_AUTODIFF */
5ea8ab5cf8 Jean*0102 
                0103 C--   If the above condition is met then we need to read in
                0104 C     data for the period ahead and the period behind myTime.
23d1f65433 Jean*0105         IF ( debugLevel.GE.debLevZero ) THEN
                0106          _BEGIN_MASTER(myThid)
                0107          WRITE(standardMessageUnit,'(A,I10,A,2(2I5,A))')
                0108      &    ' EXTERNAL_FIELDS_LOAD, it=', myIter,
                0109      &    ' : Reading new data, i0,i1=', intime0, intime1,
64fdb3fc13 Jean*0110      &    ' (prev=', intimeP, loadedRec(bi,bj), ' )'
23d1f65433 Jean*0111          _END_MASTER(myThid)
                0112         ENDIF
5ea8ab5cf8 Jean*0113 
                0114         IF ( zonalWindFile .NE. ' '  ) THEN
                0115          CALL READ_REC_XY_RS( zonalWindFile, taux0,
                0116      &                        intime0, myIter, myThid )
                0117          CALL READ_REC_XY_RS( zonalWindFile, taux1,
                0118      &                        intime1, myIter, myThid )
                0119         ENDIF
                0120         IF ( meridWindFile .NE. ' '  ) THEN
                0121          CALL READ_REC_XY_RS( meridWindFile, tauy0,
                0122      &                        intime0, myIter, myThid )
                0123          CALL READ_REC_XY_RS( meridWindFile, tauy1,
                0124      &                        intime1, myIter, myThid )
                0125         ENDIF
                0126         IF ( surfQFile .NE. ' '  ) THEN
                0127          CALL READ_REC_XY_RS( surfQFile, Qnet0,
                0128      &                        intime0, myIter, myThid )
                0129          CALL READ_REC_XY_RS( surfQFile, Qnet1,
                0130      &                        intime1, myIter, myThid )
                0131         ELSEIF ( surfQnetFile .NE. ' '  ) THEN
                0132          CALL READ_REC_XY_RS( surfQnetFile, Qnet0,
                0133      &                        intime0, myIter, myThid )
                0134          CALL READ_REC_XY_RS( surfQnetFile, Qnet1,
                0135      &                        intime1, myIter, myThid )
                0136         ENDIF
                0137         IF ( EmPmRfile .NE. ' '  ) THEN
                0138          CALL READ_REC_XY_RS( EmPmRfile, EmPmR0,
                0139      &                        intime0, myIter, myThid )
                0140          CALL READ_REC_XY_RS( EmPmRfile, EmPmR1,
                0141      &                        intime1, myIter, myThid )
                0142 c        IF ( convertEmP2rUnit.EQ.mass2rUnit ) THEN
                0143 C-    EmPmR is now (after c59h) expressed in kg/m2/s (fresh water mass flux)
                0144           DO bj = myByLo(myThid), myByHi(myThid)
                0145            DO bi = myBxLo(myThid), myBxHi(myThid)
02d90fb24c Jean*0146             DO j=1-OLy,sNy+OLy
                0147              DO i=1-OLx,sNx+OLx
5ea8ab5cf8 Jean*0148               EmPmR0(i,j,bi,bj) = EmPmR0(i,j,bi,bj)*rhoConstFresh
                0149               EmPmR1(i,j,bi,bj) = EmPmR1(i,j,bi,bj)*rhoConstFresh
                0150              ENDDO
                0151             ENDDO
b5f408f39d Jean*0152            ENDDO
                0153           ENDDO
5ea8ab5cf8 Jean*0154 c        ENDIF
                0155         ENDIF
                0156         IF ( saltFluxFile .NE. ' '  ) THEN
                0157          CALL READ_REC_XY_RS( saltFluxFile, saltFlux0,
                0158      &                        intime0, myIter, myThid )
                0159          CALL READ_REC_XY_RS( saltFluxFile, saltFlux1,
                0160      &                        intime1, myIter, myThid )
                0161         ENDIF
                0162         IF ( thetaClimFile .NE. ' '  ) THEN
                0163          CALL READ_REC_XY_RS( thetaClimFile, SST0,
                0164      &                        intime0, myIter, myThid )
                0165          CALL READ_REC_XY_RS( thetaClimFile, SST1,
                0166      &                        intime1, myIter, myThid )
                0167         ENDIF
                0168         IF ( saltClimFile .NE. ' '  ) THEN
                0169          CALL READ_REC_XY_RS( saltClimFile, SSS0,
                0170      &                        intime0, myIter, myThid )
                0171          CALL READ_REC_XY_RS( saltClimFile, SSS1,
                0172      &                        intime1, myIter, myThid )
                0173         ENDIF
77af23a186 Patr*0174 #ifdef SHORTWAVE_HEATING
5ea8ab5cf8 Jean*0175         IF ( surfQswFile .NE. ' '  ) THEN
                0176          CALL READ_REC_XY_RS( surfQswFile, Qsw0,
                0177      &                        intime0, myIter, myThid )
                0178          CALL READ_REC_XY_RS( surfQswFile, Qsw1,
                0179      &                        intime1, myIter, myThid )
                0180          IF ( surfQFile .NE. ' '  ) THEN
                0181 C-    Qnet is now (after c54) the net Heat Flux (including SW)
                0182           DO bj = myByLo(myThid), myByHi(myThid)
                0183            DO bi = myBxLo(myThid), myBxHi(myThid)
02d90fb24c Jean*0184             DO j=1-OLy,sNy+OLy
                0185              DO i=1-OLx,sNx+OLx
5ea8ab5cf8 Jean*0186               Qnet0(i,j,bi,bj) = Qnet0(i,j,bi,bj) + Qsw0(i,j,bi,bj)
                0187               Qnet1(i,j,bi,bj) = Qnet1(i,j,bi,bj) + Qsw1(i,j,bi,bj)
                0188              ENDDO
                0189             ENDDO
2d2cc93d4f Jean*0190            ENDDO
                0191           ENDDO
5ea8ab5cf8 Jean*0192          ENDIF
                0193         ENDIF
650cc6304d Patr*0194 #endif
8d218e2b5b suya*0195 #ifdef ALLOW_GEOTHERMAL_FLUX
                0196         IF ( geothermalFile .NE. ' '  ) THEN
566c69081d Jean*0197          CALL READ_REC_XY_RS( geothermalFile, geothFlux0,
8d218e2b5b suya*0198      &                        intime0, myIter, myThid )
566c69081d Jean*0199          CALL READ_REC_XY_RS( geothermalFile, geothFlux1,
8d218e2b5b suya*0200      &                        intime1, myIter, myThid )
566c69081d Jean*0201          _EXCH_XY_RS( geothFlux0, myThid )
                0202          _EXCH_XY_RS( geothFlux1, myThid )
8d218e2b5b suya*0203         ENDIF
                0204 #endif
650cc6304d Patr*0205 #ifdef ATMOSPHERIC_LOADING
5ea8ab5cf8 Jean*0206         IF ( pLoadFile .NE. ' '  ) THEN
                0207          CALL READ_REC_XY_RS( pLoadFile, pLoad0,
                0208      &                        intime0, myIter, myThid )
                0209          CALL READ_REC_XY_RS( pLoadFile, pLoad1,
                0210      &                        intime1, myIter, myThid )
                0211         ENDIF
77af23a186 Patr*0212 #endif
                0213 
d197c88195 Jean*0214 C-    thread synchronisation (barrier) is part of the EXCH S/R calls
5ea8ab5cf8 Jean*0215         _EXCH_XY_RS(SST0  , myThid )
                0216         _EXCH_XY_RS(SST1  , myThid )
                0217         _EXCH_XY_RS(SSS0  , myThid )
                0218         _EXCH_XY_RS(SSS1  , myThid )
                0219         CALL EXCH_UV_XY_RS(taux0,tauy0,.TRUE.,myThid)
                0220         CALL EXCH_UV_XY_RS(taux1,tauy1,.TRUE.,myThid)
                0221         _EXCH_XY_RS(Qnet0, myThid )
                0222         _EXCH_XY_RS(Qnet1, myThid )
                0223         _EXCH_XY_RS(EmPmR0, myThid )
                0224         _EXCH_XY_RS(EmPmR1, myThid )
                0225         _EXCH_XY_RS(saltFlux0, myThid )
                0226         _EXCH_XY_RS(saltFlux1, myThid )
77af23a186 Patr*0227 #ifdef SHORTWAVE_HEATING
5ea8ab5cf8 Jean*0228         _EXCH_XY_RS(Qsw0, myThid )
                0229         _EXCH_XY_RS(Qsw1, myThid )
77af23a186 Patr*0230 #endif
650cc6304d Patr*0231 #ifdef ATMOSPHERIC_LOADING
5ea8ab5cf8 Jean*0232         _EXCH_XY_RS(pLoad0, myThid )
                0233         _EXCH_XY_RS(pLoad1, myThid )
650cc6304d Patr*0234 #endif
d197c88195 Jean*0235 
5ea8ab5cf8 Jean*0236 C-    save newly loaded time-record
                0237         DO bj = myByLo(myThid), myByHi(myThid)
                0238          DO bi = myBxLo(myThid), myBxHi(myThid)
64fdb3fc13 Jean*0239            loadedRec(bi,bj) = intime1
5ea8ab5cf8 Jean*0240          ENDDO
                0241         ENDDO
                0242 
                0243 C--   end if-block for loading new time-records
77af23a186 Patr*0244       ENDIF
                0245 
650cc6304d Patr*0246 C--   Interpolate fu,fv,Qnet,EmPmR,SST,SSS,Qsw
77af23a186 Patr*0247       DO bj = myByLo(myThid), myByHi(myThid)
                0248        DO bi = myBxLo(myThid), myBxHi(myThid)
90aade6e67 Jean*0249         IF ( thetaClimFile .NE. ' '  ) THEN
02d90fb24c Jean*0250           DO j=1-OLy,sNy+OLy
                0251            DO i=1-OLx,sNx+OLx
d197c88195 Jean*0252             SST(i,j,bi,bj)   = bWght*SST0(i,j,bi,bj)
90aade6e67 Jean*0253      &                       + aWght*SST1(i,j,bi,bj)
                0254            ENDDO
                0255           ENDDO
                0256         ENDIF
                0257         IF ( saltClimFile .NE. ' '  ) THEN
02d90fb24c Jean*0258           DO j=1-OLy,sNy+OLy
                0259            DO i=1-OLx,sNx+OLx
d197c88195 Jean*0260             SSS(i,j,bi,bj)   = bWght*SSS0(i,j,bi,bj)
90aade6e67 Jean*0261      &                       + aWght*SSS1(i,j,bi,bj)
                0262            ENDDO
                0263           ENDDO
                0264         ENDIF
                0265         IF ( zonalWindFile .NE. ' '  ) THEN
02d90fb24c Jean*0266           DO j=1-OLy,sNy+OLy
                0267            DO i=1-OLx,sNx+OLx
d197c88195 Jean*0268             fu(i,j,bi,bj)    = bWght*taux0(i,j,bi,bj)
90aade6e67 Jean*0269      &                       + aWght*taux1(i,j,bi,bj)
                0270            ENDDO
                0271           ENDDO
                0272         ENDIF
                0273         IF ( meridWindFile .NE. ' '  ) THEN
02d90fb24c Jean*0274           DO j=1-OLy,sNy+OLy
                0275            DO i=1-OLx,sNx+OLx
d197c88195 Jean*0276             fv(i,j,bi,bj)    = bWght*tauy0(i,j,bi,bj)
90aade6e67 Jean*0277      &                       + aWght*tauy1(i,j,bi,bj)
                0278            ENDDO
                0279           ENDDO
                0280         ENDIF
                0281         IF ( surfQnetFile .NE. ' '
                0282      &     .OR. surfQFile .NE. ' '  ) THEN
02d90fb24c Jean*0283           DO j=1-OLy,sNy+OLy
                0284            DO i=1-OLx,sNx+OLx
90aade6e67 Jean*0285             Qnet(i,j,bi,bj)  = bWght*Qnet0(i,j,bi,bj)
                0286      &                       + aWght*Qnet1(i,j,bi,bj)
                0287            ENDDO
                0288           ENDDO
                0289         ENDIF
                0290         IF ( EmPmRfile .NE. ' '  ) THEN
02d90fb24c Jean*0291           DO j=1-OLy,sNy+OLy
                0292            DO i=1-OLx,sNx+OLx
90aade6e67 Jean*0293             EmPmR(i,j,bi,bj) = bWght*EmPmR0(i,j,bi,bj)
                0294      &                       + aWght*EmPmR1(i,j,bi,bj)
                0295            ENDDO
                0296           ENDDO
                0297         ENDIF
                0298         IF ( saltFluxFile .NE. ' '  ) THEN
02d90fb24c Jean*0299           DO j=1-OLy,sNy+OLy
                0300            DO i=1-OLx,sNx+OLx
90aade6e67 Jean*0301             saltFlux(i,j,bi,bj) = bWght*saltFlux0(i,j,bi,bj)
                0302      &                          + aWght*saltFlux1(i,j,bi,bj)
                0303            ENDDO
                0304           ENDDO
                0305         ENDIF
                0306 #ifdef SHORTWAVE_HEATING
                0307         IF ( surfQswFile .NE. ' '  ) THEN
02d90fb24c Jean*0308           DO j=1-OLy,sNy+OLy
                0309            DO i=1-OLx,sNx+OLx
90aade6e67 Jean*0310             Qsw(i,j,bi,bj)   = bWght*Qsw0(i,j,bi,bj)
                0311      &                       + aWght*Qsw1(i,j,bi,bj)
                0312            ENDDO
                0313           ENDDO
8d218e2b5b suya*0314         ENDIF
                0315 #endif
                0316 #ifdef ALLOW_GEOTHERMAL_FLUX
                0317         IF ( geothermalFile .NE. ' '  ) THEN
                0318           DO j=1-OLy,sNy+OLy
                0319            DO i=1-OLx,sNx+OLx
566c69081d Jean*0320             geothermalFlux(i,j,bi,bj) = bWght*geothFlux0(i,j,bi,bj)
                0321      &                                + aWght*geothFlux1(i,j,bi,bj)
8d218e2b5b suya*0322            ENDDO
                0323           ENDDO
90aade6e67 Jean*0324         ENDIF
                0325 #endif
                0326 #ifdef ATMOSPHERIC_LOADING
                0327         IF ( pLoadFile .NE. ' '  ) THEN
02d90fb24c Jean*0328           DO j=1-OLy,sNy+OLy
                0329            DO i=1-OLx,sNx+OLx
a8bcab80b7 Jean*0330             pLoad(i,j,bi,bj) = bWght*pLoad0(i,j,bi,bj)
                0331      &                       + aWght*pLoad1(i,j,bi,bj)
90aade6e67 Jean*0332            ENDDO
                0333           ENDDO
                0334         ENDIF
                0335 #endif
77af23a186 Patr*0336        ENDDO
                0337       ENDDO
                0338 
1e273d1bf5 Jean*0339 C-- Print for checking:
64fdb3fc13 Jean*0340 #ifdef ALLOW_DEBUG
23d1f65433 Jean*0341       IF ( debugLevel.GE.debLevC ) THEN
a6b6b84b5d Jean*0342         _BEGIN_MASTER( myThid )
64fdb3fc13 Jean*0343         WRITE(standardMessageUnit,'(A,1P4E12.4)')
                0344      &   ' EXTERNAL_FIELDS_LOAD: (fu0,1),fu,fv=',
                0345      &        taux0(1,sNy,1,1), taux1(1,sNy,1,1),
                0346      &           fu(1,sNy,1,1),    fv(1,sNy,1,1)
                0347         WRITE(standardMessageUnit,'(A,1P4E12.4)')
                0348      &   ' EXTERNAL_FIELDS_LOAD: SST,SSS,Q,E-P=',
                0349      &          SST(1,sNy,1,1),   SSS(1,sNy,1,1),
                0350      &         Qnet(1,sNy,1,1), EmPmR(1,sNy,1,1)
a6b6b84b5d Jean*0351         _END_MASTER( myThid )
150696feb5 Patr*0352       ENDIF
64fdb3fc13 Jean*0353 #endif /* ALLOW_DEBUG */
150696feb5 Patr*0354 
77af23a186 Patr*0355 C endif for periodicForcing
                0356       ENDIF
                0357 
a8bcab80b7 Jean*0358 #endif /* EXCLUDE_FFIELDS_LOAD */
650cc6304d Patr*0359 
77af23a186 Patr*0360       RETURN
                0361       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!