Back to home page

MITgcm
 
 

    

File indexing completed on 2020-07-25 05:10:56 UTC

view on githubraw file Latest commit a2844551 on 2020-07-25 02:56:46 UTC
c0d1c06c15 Matt*0001 #include "BLING_OPTIONS.h"
ad31d92a39 Jean*0002 #ifdef ALLOW_EXF
                0003 # include "EXF_OPTIONS.h"
                0004 #endif
c0d1c06c15 Matt*0005 
                0006 CBOP
be72e7ae9e Jean*0007       SUBROUTINE BLING_FIELDS_LOAD (
9f0da36f91 Jean*0008      I           myTime, myIter, myThid )
c0d1c06c15 Matt*0009 
be72e7ae9e Jean*0010 C     *========================================================*
c0d1c06c15 Matt*0011 C     | subroutine bling_fields_load
be72e7ae9e Jean*0012 C     | o Read in fields needed for CO2, O2 flux terms, silica
c0d1c06c15 Matt*0013 C     |   for pH calculation
e0f9a7ba0b Matt*0014 C     | o Update fields from EXF package
be72e7ae9e Jean*0015 C     *========================================================*
c0d1c06c15 Matt*0016 
e0f9a7ba0b Matt*0017       IMPLICIT NONE
be72e7ae9e Jean*0018 
c0d1c06c15 Matt*0019 C     === Global variables ===
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "GRID.h"
63d2feffb8 Matt*0024 #ifdef ALLOW_EXF
                0025 # include "EXF_PARAM.h"
9f0da36f91 Jean*0026 # include "EXF_INTERP_SIZE.h"
63d2feffb8 Matt*0027 # include "EXF_FIELDS.h"
                0028 #endif
c0d1c06c15 Matt*0029 #include "BLING_VARS.h"
                0030 #include "BLING_LOAD.h"
                0031 #ifdef ALLOW_THSICE
                0032 # include "THSICE_VARS.h"
                0033 #endif
                0034 #ifdef ALLOW_SEAICE
                0035 # include "SEAICE_SIZE.h"
                0036 # include "SEAICE.h"
                0037 #endif
                0038 
                0039 C !INPUT PARAMETERS: ===================================================
                0040 C  myThid               :: thread number
                0041 C  myIter               :: current timestep
                0042 C  myTime               :: current time
                0043       INTEGER myIter
                0044       _RL myTime
                0045       INTEGER myThid
                0046 
                0047 #ifdef ALLOW_BLING
                0048 
be72e7ae9e Jean*0049 C !LOCAL VARIABLES: ===================================================
c0d1c06c15 Matt*0050       INTEGER bi, bj, i, j
                0051       INTEGER intimeP, intime0, intime1
                0052       _RL aWght,bWght
                0053 CEOP
                0054 
                0055       IF (  BLING_forcingCycle.gt.0. _d 0 ) THEN
                0056 
                0057 C--   Now calculate whether it is time to update the forcing arrays
                0058        CALL GET_PERIODIC_INTERVAL(
                0059      O                   intimeP, intime0, intime1, bWght, aWght,
                0060      I                   BLING_forcingCycle, BLING_forcingPeriod,
be72e7ae9e Jean*0061      I                   deltaTClock, myTime, myThid )
c0d1c06c15 Matt*0062 
                0063        bi = myBxLo(myThid)
                0064        bj = myByLo(myThid)
                0065 #ifdef ALLOW_DEBUG
                0066        IF ( debugLevel.GE.debLevB ) THEN
                0067         _BEGIN_MASTER(myThid)
                0068         WRITE(standardMessageUnit,'(A,I10,A,4I5,A,2F14.10)')
                0069      &   ' BLING_FIELDS_LOAD,', myIter,
                0070      &   ' : iP,iLd,i0,i1=', intimeP,BLING_ldRec(bi,bj), intime0,
                0071      &                       intime1,
                0072      &   ' ; Wght=', bWght, aWght
                0073         _END_MASTER(myThid)
                0074        ENDIF
                0075 #endif /* ALLOW_DEBUG */
                0076 
                0077 #ifdef ALLOW_AUTODIFF
                0078 C-    assuming that we call S/R BLING_FIELDS_LOAD at each time-step and
                0079 C     with increasing time, this will catch when we need to load new records;
                0080 C     But with Adjoint run, this is not always the case => might end-up using
                0081 C     the wrong time-records
                0082        IF ( intime0.NE.intimeP .OR. myIter.EQ.nIter0 ) THEN
                0083 #else /* ALLOW_AUTODIFF */
                0084 C-    Make no assumption on sequence of calls to BLING_FIELDS_LOAD ;
                0085 C     This is the correct formulation (works in Adjoint run).
                0086 C     Unfortunatly, produces many recomputations <== not used until it is fixed
                0087        IF ( intime1.NE.BLING_ldRec(bi,bj) ) THEN
                0088 #endif /* ALLOW_AUTODIFF */
                0089 
                0090 C--   If the above condition is met then we need to read in
                0091 C     data for the period ahead and the period behind myTime.
                0092         IF ( debugLevel.GE.debLevZero ) THEN
                0093          _BEGIN_MASTER(myThid)
                0094          WRITE(standardMessageUnit,'(A,I10,A,2(2I5,A))')
                0095      &    ' BLING_FIELDS_LOAD, it=', myIter,
                0096      &    ' : Reading new data, i0,i1=', intime0, intime1,
                0097      &    ' (prev=', intimeP, BLING_ldRec(bi,bj), ' )'
                0098          _END_MASTER(myThid)
                0099         ENDIF
                0100 
                0101         _BARRIER
                0102 
                0103         IF ( BLING_windFile .NE. ' '  ) THEN
                0104          CALL READ_REC_XY_RS( BLING_windFile,dicwind0,intime0,
                0105      &        myIter,myThid )
                0106          CALL READ_REC_XY_RS( BLING_windFile,dicwind1,intime1,
                0107      &        myIter,myThid )
                0108         ENDIF
                0109         IF ( BLING_atmospFile .NE. ' '  ) THEN
                0110          CALL READ_REC_XY_RS( BLING_atmospFile,atmosp0,intime0,
                0111      &        myIter,myThid )
                0112          CALL READ_REC_XY_RS( BLING_atmospFile,atmosp1,intime1,
                0113      &        myIter,myThid )
                0114         ENDIF
                0115         IF ( BLING_silicaFile .NE. ' '  ) THEN
                0116          CALL READ_REC_XY_RS( BLING_silicaFile,silica0,intime0,
                0117      &        myIter,myThid )
                0118          CALL READ_REC_XY_RS( BLING_silicaFile,silica1,intime1,
                0119      &        myIter,myThid )
                0120         ENDIF
                0121         IF ( BLING_iceFile .NE. ' '  ) THEN
                0122          CALL READ_REC_XY_RS( BLING_iceFile,ice0,intime0,
                0123      &       myIter,myThid )
                0124          CALL READ_REC_XY_RS( BLING_iceFile,ice1,intime1,
                0125      &       myIter,myThid )
                0126         ENDIF
                0127         IF ( BLING_ironFile .NE. ' '  ) THEN
                0128          CALL READ_REC_XY_RS( BLING_ironFile,feinput0,intime0,
                0129      &       myIter,myThid )
                0130          CALL READ_REC_XY_RS( BLING_ironFile,feinput1,intime1,
                0131      &       myIter,myThid )
                0132         ENDIF
                0133 
                0134 C--   fill-in overlap after loading temp arrays:
                0135         _EXCH_XY_RS(dicwind0, myThid )
                0136         _EXCH_XY_RS(dicwind1, myThid )
                0137         _EXCH_XY_RS(atmosp0, myThid )
                0138         _EXCH_XY_RS(atmosp1, myThid )
                0139         _EXCH_XY_RS(ice0, myThid )
                0140         _EXCH_XY_RS(ice1, myThid )
                0141         _EXCH_XY_RS(feinput0, myThid )
                0142         _EXCH_XY_RS(feinput1, myThid )
e0f9a7ba0b Matt*0143         _EXCH_XY_RS(silica0, myThid )
                0144         _EXCH_XY_RS(silica1, myThid )
c0d1c06c15 Matt*0145 
                0146 C-    save newly loaded time-record
                0147         DO bj = myByLo(myThid), myByHi(myThid)
                0148          DO bi = myBxLo(myThid), myBxHi(myThid)
                0149            BLING_ldRec(bi,bj) = intime1
                0150          ENDDO
                0151         ENDDO
                0152 
                0153 C-     end if-bloc (time to load new fields)
                0154        ENDIF
                0155 
                0156        DO bj = myByLo(myThid), myByHi(myThid)
                0157         DO bi = myBxLo(myThid), myBxHi(myThid)
                0158          IF ( BLING_windFile .NE. ' '  ) THEN
                0159            DO j=1-OLy,sNy+OLy
                0160             DO i=1-OLx,sNx+OLx
e0f9a7ba0b Matt*0161              wind(i,j,bi,bj) = bWght*dicwind0(i,j,bi,bj)
c0d1c06c15 Matt*0162      &                       + aWght*dicwind1(i,j,bi,bj)
                0163             ENDDO
                0164            ENDDO
                0165          ENDIF
e0f9a7ba0b Matt*0166 
c0d1c06c15 Matt*0167          IF ( BLING_atmospFile .NE. ' '  ) THEN
                0168            DO j=1-OLy,sNy+OLy
                0169             DO i=1-OLx,sNx+OLx
e0f9a7ba0b Matt*0170              atmosP(i,j,bi,bj) = bWght*atmosp0(i,j,bi,bj)
c0d1c06c15 Matt*0171      &                         + aWght*atmosp1(i,j,bi,bj)
                0172             ENDDO
                0173            ENDDO
                0174          ENDIF
e0f9a7ba0b Matt*0175 
c0d1c06c15 Matt*0176          IF ( BLING_silicaFile .NE. ' '  ) THEN
                0177            DO j=1-OLy,sNy+OLy
                0178             DO i=1-OLx,sNx+OLx
e0f9a7ba0b Matt*0179              silica(i,j,bi,bj) = bWght*silica0(i,j,bi,bj)
c0d1c06c15 Matt*0180      &                         + aWght*silica1(i,j,bi,bj)
                0181             ENDDO
                0182            ENDDO
                0183          ENDIF
e0f9a7ba0b Matt*0184 
c0d1c06c15 Matt*0185          IF ( BLING_iceFile .NE. ' '  ) THEN
                0186            DO j=1-OLy,sNy+OLy
                0187             DO i=1-OLx,sNx+OLx
e0f9a7ba0b Matt*0188              fIce(i,j,bi,bj) = bWght*ice0(i,j,bi,bj)
c0d1c06c15 Matt*0189      &                       + aWght*ice1(i,j,bi,bj)
                0190             ENDDO
                0191            ENDDO
                0192          ENDIF
                0193 
                0194          IF ( BLING_ironFile .NE. ' '  ) THEN
                0195            DO j=1-OLy,sNy+OLy
                0196             DO i=1-OLx,sNx+OLx
                0197              InputFe(i,j,bi,bj) = bWght*feinput0(i,j,bi,bj)
                0198      &                          + aWght*feinput1(i,j,bi,bj)
                0199             ENDDO
                0200            ENDDO
                0201          ENDIF
                0202         ENDDO
                0203        ENDDO
                0204 
                0205 C endif for BLING_forcingCycle
                0206       ENDIF
                0207 
e0f9a7ba0b Matt*0208 C-----------------------------------------------------------
                0209 C Get ice fraction from PKG/SEAICE or PKG/THSICE
c0d1c06c15 Matt*0210       DO bj = myByLo(myThid), myByHi(myThid)
                0211        DO bi = myBxLo(myThid), myBxHi(myThid)
                0212 #ifdef ALLOW_SEAICE
                0213          IF ( useSEAICE ) THEN
                0214            DO j=1-OLy,sNy+OLy
                0215             DO i=1-OLx,sNx+OLx
e0f9a7ba0b Matt*0216              fIce(i,j,bi,bj) = AREA(i,j,bi,bj)
c0d1c06c15 Matt*0217             ENDDO
                0218            ENDDO
                0219          ENDIF
                0220 #endif
                0221 #ifdef ALLOW_THSICE
                0222          IF ( useThSIce ) THEN
                0223            DO j=1-OLy,sNy+OLy
                0224             DO i=1-OLx,sNx+OLx
e0f9a7ba0b Matt*0225              fIce(i,j,bi,bj) = iceMask(i,j,bi,bj)
c0d1c06c15 Matt*0226             ENDDO
                0227            ENDDO
                0228          ENDIF
                0229 #endif
                0230        ENDDO
                0231       ENDDO
                0232 
be72e7ae9e Jean*0233 C-----------------------------------------------------------
e0f9a7ba0b Matt*0234 C Get winds from PKG/EXF
                0235       DO bj = myByLo(myThid), myByHi(myThid)
                0236        DO bi = myBxLo(myThid), myBxHi(myThid)
                0237 #ifdef ALLOW_EXF
                0238          IF ( useEXF ) THEN
                0239           IF ( uwindfile .NE. ' '  ) THEN
                0240           IF ( vwindfile .NE. ' '  ) THEN
                0241            DO j=1-OLy,sNy+OLy
                0242             DO i=1-OLx,sNx+OLx
                0243              wind(i,j,bi,bj) = wspeed(i,j,bi,bj)
                0244             ENDDO
                0245            ENDDO
                0246           ENDIF
                0247           ENDIF
                0248          ENDIF
                0249 #endif
                0250        ENDDO
                0251       ENDDO
                0252 
                0253 C-----------------------------------------------------------
                0254 C Get atmospheric pressure from PKG/EXF
                0255       DO bj = myByLo(myThid), myByHi(myThid)
                0256        DO bi = myBxLo(myThid), myBxHi(myThid)
                0257 #ifdef ALLOW_EXF
                0258          IF ( useEXF ) THEN
                0259           IF ( apressurefile .NE. ' '  ) THEN
                0260            DO j=1-OLy,sNy+OLy
                0261             DO i=1-OLx,sNx+OLx
                0262 C Atm pressure in Pascals, convert to atm
                0263              AtmosP(i,j,bi,bj) = apressure(i,j,bi,bj)/Pa2atm
                0264             ENDDO
                0265            ENDDO
                0266           ENDIF
                0267          ENDIF
                0268 #endif
                0269        ENDDO
                0270       ENDDO
                0271 
                0272 C-----------------------------------------------------------
be72e7ae9e Jean*0273 C Get Atmospheric carbon dioxide concentration from PKG/EXF
e0f9a7ba0b Matt*0274 #ifdef ALLOW_EXF
be72e7ae9e Jean*0275 C     Atmospheric carbon dioxide concentration
e0f9a7ba0b Matt*0276       IF ( useEXF ) THEN
                0277        IF ( apco2file .NE. ' '  ) THEN
                0278         CALL EXF_SET_FLD(
ad31d92a39 Jean*0279      I     'apco2', apco2file, apco2mask,
                0280      I     apco2StartTime, apco2period, apco2RepCycle,
                0281      I     exf_inscal_apco2,
                0282      I     apco2_exfremo_intercept, apco2_exfremo_slope,
a284455135 Matt*0283      U     apco2, apco20, apco21,
5ce0e21f13 Matt*0284 # ifdef USE_EXF_INTERPOLATION
ad31d92a39 Jean*0285      I     apco2_lon0, apco2_lon_inc, apco2_lat0, apco2_lat_inc,
                0286      I     apco2_nlon, apco2_nlat, xC, yC, apco2_interpMethod,
5ce0e21f13 Matt*0287 # endif
ad31d92a39 Jean*0288      I     myTime, myIter, myThid )
e0f9a7ba0b Matt*0289        ENDIF
                0290       ENDIF
                0291 #endif
5ce0e21f13 Matt*0292 
c0d1c06c15 Matt*0293 #endif /* ALLOW_BLING */
                0294       RETURN
                0295       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!