pkg/oasim/oasim_set_fld.F

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