Back to home page

MITgcm
 
 

    

File indexing completed on 2021-11-10 06:15:38 UTC

view on githubraw file Latest commit deacece5 on 2021-11-09 17:35:09 UTC
8a0f942cd7 Jean*0001 #include "EXF_OPTIONS.h"
                0002 
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 
                0005 C     !ROUTINE: EXF_SET_FLD
                0006 C     !INTERFACE:
                0007       SUBROUTINE EXF_SET_FLD(
                0008      I     fldName, fldFile, fldMask,
                0009      I     fldStartTime, fldPeriod, fldRepeatCycle,
                0010      I     fld_inScale, fldRemove_intercept, fldRemove_slope,
                0011      U     fldArr, fld0, fld1,
                0012 #ifdef USE_EXF_INTERPOLATION
                0013      I     fld_lon0, fld_lon_inc, fld_lat0, fld_lat_inc,
                0014      I     fld_nlon, fld_nlat, fld_xout, fld_yout, interp_method,
                0015 #endif
                0016      I     myTime, myIter, myThid )
                0017 
                0018 C !DESCRIPTION: \bv
                0019 C  *=================================================================*
                0020 C  | SUBROUTINE EXF_SET_FLD
                0021 C  | o Set value of one generic external forcing field
                0022 C  *=================================================================*
                0023 C  |  started: Ralf.Giering@FastOpt.de 25-Mai-2000
                0024 C  |  changed: heimbach@mit.edu 10-Jan-02
                0025 C  |        20-Dec-02: mods for pkg/seaice, menemenlis@jpl.nasa.gov
                0026 C  |           heimbach@mit.edu: totally re-organized exf_set_...
                0027 C  |           replaced all routines by one generic routine
                0028 C  |        5-Aug-03: added USE_EXF_INTERPOLATION for arbitrary
                0029 C  |                    input grid capability
                0030 C  |  11-Dec-06 added time-mean and monthly-mean climatology options
                0031 C  |     fldPeriod=0 means input file is one time-constant field
                0032 C  |     fldPeriod=-12 means input file contains 12 monthly means
                0033 C  *=================================================================*
                0034 C \ev
                0035 
                0036 C !USES:
                0037       IMPLICIT NONE
                0038 C     == global variables ==
                0039 #include "EEPARAMS.h"
                0040 #include "SIZE.h"
                0041 #include "PARAMS.h"
                0042 #include "EXF_PARAM.h"
                0043 #include "EXF_CONSTANTS.h"
30fcb891cf Jean*0044 #include "EXF_INTERP_SIZE.h"
                0045 #include "EXF_INTERP_PARAM.h"
8a0f942cd7 Jean*0046 
                0047 C !INPUT/OUTPUT PARAMETERS:
                0048 C     fldName        :: field short name (to print mesg)
                0049 C     fldFile        :: file-name for this field
                0050 C     fldStartTime   :: corresponding starting time (in sec) for this field
                0051 C     fldPeriod      :: time period (in sec) between 2 reccords
                0052 C     fldRepeatCycle :: time duration of a repeating cycle
                0053 C     fld_inScale    :: input field scaling factor
                0054 C     fldRemove_intercept  ::
                0055 C     fldRemove_slope      ::
                0056 C     fldArr         :: field array containing current time values
                0057 C     fld0           :: field array holding previous reccord
                0058 C     fld1           :: field array holding next     reccord
                0059 #ifdef USE_EXF_INTERPOLATION
                0060 C     fld_lon0, fld_lat0   :: longitude and latitude of SouthWest
                0061 C                          :: corner of global input grid
                0062 C     fld_nlon, fld_nlat   :: input x-grid and y-grid size
                0063 C     fld_lon_inc          :: scalar x-grid increment
                0064 C     fld_lat_inc          :: vector y-grid increments
                0065 C     fld_xout, fld_yout   :: coordinates for output grid
a9085e980c Jean*0066 C     fld_xout, fld_yout   :: coordinates for output grid
                0067 C     interp_method        :: select interpolation method (integer)
8a0f942cd7 Jean*0068 #endif /* USE_EXF_INTERPOLATION */
                0069 C     myTime         :: Current time (in sec) in simulation
                0070 C     myIter         :: Current iteration number
                0071 C     myThid         :: My Thread Id number
                0072       CHARACTER*(*) fldName
                0073       CHARACTER*(128) fldFile
                0074       CHARACTER*1 fldMask
                0075       _RL fldStartTime, fldPeriod, fldRepeatCycle
                0076       _RL fld_inScale
                0077       _RL fldRemove_intercept, fldRemove_slope
                0078       _RL fldArr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0079       _RL fld0  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0080       _RL fld1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0081 #ifdef USE_EXF_INTERPOLATION
                0082       _RL fld_lon0, fld_lon_inc
                0083       _RL fld_lat0, fld_lat_inc(MAX_LAT_INC)
                0084       INTEGER fld_nlon, fld_nlat
                0085       _RS fld_xout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0086       _RS fld_yout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0087       INTEGER interp_method
                0088 #endif /* USE_EXF_INTERPOLATION */
                0089       _RL     myTime
                0090       INTEGER myIter
                0091       INTEGER myThid
                0092 
                0093 C !FUNCTIONS:
                0094       INTEGER  ILNBLNK
                0095       EXTERNAL ILNBLNK
                0096 
                0097 C !LOCAL VARIABLES:
                0098 C     msgBuf     :: Informational/error message buffer
                0099       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0100       LOGICAL first, changed
                0101       INTEGER count0, count1
                0102       INTEGER year0, year1
                0103       INTEGER bi, bj, i, j
                0104       _RL     fac
                0105       CHARACTER*(128) locFile0, locFile1
                0106 #ifdef USE_EXF_INTERPOLATION
                0107       CHARACTER*(MAX_LEN_FNAM) out_file
a9085e980c Jean*0108 # ifndef EXF_INTERP_USE_DYNALLOC
                0109       _RL     bufArr( exf_interp_bufferSize )
                0110 # endif
                0111 #endif /* USE_EXF_INTERPOLATION */
8a0f942cd7 Jean*0112 CEOP
                0113 
                0114       IF ( fldFile .NE. ' ' .AND. fldPeriod .NE. 0. ) THEN
                0115 
                0116          IF ( exf_debugLev.GE.debLevD ) THEN
                0117            _BEGIN_MASTER( myThid )
                0118            j = ILNBLNK(fldFile)
                0119            WRITE(msgBuf,'(5A)') 'EXF_SET_FLD: ',
                0120      &       'processing field "', fldName, '",  file: ', fldFile(1:j)
                0121            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0122      &                         SQUEEZE_RIGHT, myThid )
                0123            _END_MASTER( myThid )
                0124          ENDIF
                0125 
                0126          IF ( useCAL .AND. fldPeriod .EQ. -12. ) THEN
                0127 #ifdef ALLOW_CAL
                0128 C-    fldPeriod=-12 means input file contains 12 monthly means
                0129 C     records, corresponding to Jan. (rec=1) through Dec. (rec=12)
                0130             CALL cal_GetMonthsRec(
                0131      O           fac, first, changed,
deacece587 Oliv*0132      O           count0, count1, year0, year1,
                0133      I           myTime, myIter, myThid )
                0134 #endif /* ALLOW_CAL */
                0135          ELSEIF ( useCal .AND. fldperiod .EQ. -1.) THEN
                0136 C-    fldPeriod=-1 means fields are monthly means.
                0137 C     With useExfYearlyFields=.TRUE., each yearly input file contains
                0138 C     12 monthly mean records.  Otherwise, a single input file contains
                0139 C     monthly mean records starting at the month fldStartTime falls in.
                0140 #ifdef ALLOW_CAL
                0141             CALL EXF_GetMonthsRec(
                0142      I           fldStartTime, useExfYearlyFields,
                0143      O           fac, first, changed,
                0144      O           count0, count1, year0, year1,
8a0f942cd7 Jean*0145      I           myTime, myIter, myThid )
                0146 #endif /* ALLOW_CAL */
                0147          ELSEIF ( fldPeriod .LT. 0. ) THEN
                0148            j = ILNBLNK(fldFile)
                0149            WRITE(msgBuf,'(4A,1PE16.8,2A)') 'EXF_SET_FLD: ',
                0150      &       '"', fldName, '", Invalid fldPeriod=', fldPeriod,
                0151      &       ' for file: ', fldFile(1:j)
                0152            CALL PRINT_ERROR( msgBuf, myThid )
                0153            STOP 'ABNORMAL END: S/R EXF_SET_FLD'
                0154          ELSE
                0155 C-    get record numbers and interpolation factor for this field
                0156             CALL EXF_GetFFieldRec(
                0157      I           fldStartTime, fldPeriod, fldRepeatCycle,
                0158      I           fldName, useExfYearlyFields,
                0159      O           fac, first, changed,
                0160      O           count0, count1, year0, year1,
                0161      I           myTime, myIter, myThid )
                0162 
                0163          ENDIF
                0164          IF ( exf_debugLev.GE.debLevD ) THEN
                0165            _BEGIN_MASTER( myThid )
                0166            WRITE(msgBuf,'(2A,I10,2I7)') 'EXF_SET_FLD: ',
                0167      &       '  myIter, count0, count1:', myIter, count0, count1
                0168            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0169      &                         SQUEEZE_RIGHT, myThid )
deacece587 Oliv*0170            WRITE(msgBuf,'(2A,2(L2,2X),F21.17)') 'EXF_SET_FLD: ',
8a0f942cd7 Jean*0171      &       '  first, changed, fac:  ', first, changed, fac
                0172            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0173      &                         SQUEEZE_RIGHT, myThid )
                0174            _END_MASTER( myThid )
                0175          ENDIF
                0176 
                0177          IF ( first ) THEN
                0178             CALL exf_GetYearlyFieldName(
                0179      I         useExfYearlyFields, twoDigitYear, fldPeriod, year0,
                0180      I         fldFile,
                0181      O         locFile0,
                0182      I         myTime, myIter, myThid )
                0183             IF ( exf_debugLev.GE.debLevC ) THEN
                0184               _BEGIN_MASTER(myThid)
                0185               j = ILNBLNK(locFile0)
                0186               WRITE(msgBuf,'(4A,I10,A,I6)') 'EXF_SET_FLD: ',
                0187      &          'field "', fldName, '", it=', myIter,
                0188      &          ', loading rec=', count0
                0189               CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0190      &                            SQUEEZE_RIGHT, myThid )
                0191               WRITE(msgBuf,'(4A)') 'EXF_SET_FLD: ',
                0192      &          '  from file: "', locFile0(1:j), '"'
                0193               CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0194      &                            SQUEEZE_RIGHT, myThid )
                0195               _END_MASTER(myThid)
                0196             ENDIF
                0197 
                0198 #ifdef USE_EXF_INTERPOLATION
                0199             IF ( interp_method.GE.1 ) THEN
                0200               CALL EXF_INTERP(
                0201      I             locFile0, exf_iprec,
a9085e980c Jean*0202 #ifdef EXF_INTERP_USE_DYNALLOC
8a0f942cd7 Jean*0203      O             fld1,
a9085e980c Jean*0204 #else
                0205      O             fld1, bufArr,
                0206 #endif
8a0f942cd7 Jean*0207      I             count0, fld_xout, fld_yout,
                0208      I             fld_lon0, fld_lon_inc, fld_lat0, fld_lat_inc,
                0209      I             fld_nlon, fld_nlat, interp_method, myIter, myThid )
1f565392ef Jean*0210 
                0211               IF ( exf_output_interp ) THEN
                0212                j = ILNBLNK(locFile0)
                0213                WRITE(out_file,'(2A)') locFile0(1:j), '_out'
                0214                IF ( count0.NE.1 )
                0215      &         CALL WRITE_REC_XY_RL( out_file, fld1, 1,
                0216      &                                         myIter, myThid )
                0217                CALL WRITE_REC_XY_RL( out_file, fld1, count0,
                0218      &                                         myIter, myThid )
                0219               ENDIF
                0220 
8a0f942cd7 Jean*0221             ELSE
                0222 #endif /* USE_EXF_INTERPOLATION */
                0223               CALL READ_REC_3D_RL( locFile0, exf_iprec, 1,
                0224      &                             fld1, count0, myIter, myThid )
                0225 #ifdef USE_EXF_INTERPOLATION
                0226             ENDIF
                0227 #endif /* USE_EXF_INTERPOLATION */
                0228 
                0229 C-    apply mask
                0230             CALL EXF_FILTER_RL( fld1, fldMask, myThid )
                0231 
                0232 C-    end if ( first ) block
                0233          ENDIF
                0234 
                0235          IF ( first .OR. changed ) THEN
                0236             CALL exf_SwapFFields( fld0, fld1, myThid )
                0237 
                0238             CALL exf_GetYearlyFieldName(
                0239      I         useExfYearlyFields, twoDigitYear, fldPeriod, year1,
                0240      I         fldFile,
                0241      O         locFile1,
                0242      I         myTime, myIter, myThid )
                0243             IF ( exf_debugLev.GE.debLevC ) THEN
                0244               _BEGIN_MASTER(myThid)
                0245               j = ILNBLNK(locFile1)
                0246               WRITE(msgBuf,'(4A,I10,A,I6)') 'EXF_SET_FLD: ',
                0247      &          'field "', fldName, '", it=', myIter,
                0248      &          ', loading rec=', count1
                0249               CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0250      &                            SQUEEZE_RIGHT, myThid )
                0251               WRITE(msgBuf,'(4A)') 'EXF_SET_FLD: ',
                0252      &          '  from file: "', locFile1(1:j), '"'
                0253               CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0254      &                            SQUEEZE_RIGHT, myThid )
                0255               _END_MASTER(myThid)
                0256             ENDIF
                0257 
                0258 #ifdef USE_EXF_INTERPOLATION
                0259             IF ( interp_method.GE.1 ) THEN
                0260               CALL EXF_INTERP(
                0261      I             locFile1, exf_iprec,
a9085e980c Jean*0262 #ifdef EXF_INTERP_USE_DYNALLOC
8a0f942cd7 Jean*0263      O             fld1,
a9085e980c Jean*0264 #else
                0265      O             fld1, bufArr,
                0266 #endif
8a0f942cd7 Jean*0267      I             count1, fld_xout, fld_yout,
                0268      I             fld_lon0, fld_lon_inc, fld_lat0, fld_lat_inc,
                0269      I             fld_nlon, fld_nlat, interp_method, myIter, myThid )
1f565392ef Jean*0270 
                0271               IF ( exf_output_interp ) THEN
                0272                j = ILNBLNK(locFile1)
                0273                WRITE(out_file,'(2A)') locFile1(1:j), '_out'
                0274                CALL WRITE_REC_XY_RL( out_file, fld1, count1,
                0275      &                                         myIter, myThid )
                0276               ENDIF
                0277 
8a0f942cd7 Jean*0278             ELSE
                0279 #endif /* USE_EXF_INTERPOLATION */
                0280               CALL READ_REC_3D_RL( locFile1, exf_iprec, 1,
                0281      &                             fld1, count1, myIter, myThid )
                0282 #ifdef USE_EXF_INTERPOLATION
                0283             ENDIF
                0284 #endif /* USE_EXF_INTERPOLATION */
                0285 
                0286 C-    apply mask
                0287             CALL EXF_FILTER_RL( fld1, fldMask, myThid )
                0288 
                0289 C-    end if ( first or changed ) block
                0290          ENDIF
                0291 
                0292 C     Loop over tiles.
                0293          DO bj = myByLo(myThid),myByHi(myThid)
1f565392ef Jean*0294           DO bi = myBxLo(myThid),myBxHi(myThid)
8a0f942cd7 Jean*0295            DO j = 1,sNy
                0296             DO i = 1,sNx
                0297 C     Interpolate linearly onto the  time.
                0298              fldArr(i,j,bi,bj) =     fld_inScale * (
                0299      &                       fac * fld0(i,j,bi,bj)
                0300      &          + (exf_one - fac)* fld1(i,j,bi,bj) )
                0301              fldArr(i,j,bi,bj) = fldArr(i,j,bi,bj)
                0302      &         - fld_inScale*( fldRemove_intercept
                0303      &                         + fldRemove_slope*(myTime-startTime) )
                0304             ENDDO
                0305            ENDDO
                0306           ENDDO
                0307          ENDDO
                0308 
                0309       ENDIF
                0310 
                0311       RETURN
                0312       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!