C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_set_fld.F,v 1.2 2017/03/10 00:16:11 jmc Exp $
C $Name: $
#include "EXF_OPTIONS.h"
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C !ROUTINE: EXF_SET_FLD
C !INTERFACE:
SUBROUTINE EXF_SET_FLD(
I fldName, fldFile, fldMask,
I fldStartTime, fldPeriod, fldRepeatCycle,
I fld_inScale, fldRemove_intercept, fldRemove_slope,
U fldArr, fld0, fld1,
#ifdef USE_EXF_INTERPOLATION
I fld_lon0, fld_lon_inc, fld_lat0, fld_lat_inc,
I fld_nlon, fld_nlat, fld_xout, fld_yout, interp_method,
#endif
I myTime, myIter, myThid )
C !DESCRIPTION: \bv
C *=================================================================*
C | SUBROUTINE EXF_SET_FLD
C | o Set value of one generic external forcing field
C *=================================================================*
C | started: Ralf.Giering@FastOpt.de 25-Mai-2000
C | changed: heimbach@mit.edu 10-Jan-02
C | 20-Dec-02: mods for pkg/seaice, menemenlis@jpl.nasa.gov
C | heimbach@mit.edu: totally re-organized exf_set_...
C | replaced all routines by one generic routine
C | 5-Aug-03: added USE_EXF_INTERPOLATION for arbitrary
C | input grid capability
C | 11-Dec-06 added time-mean and monthly-mean climatology options
C | fldPeriod=0 means input file is one time-constant field
C | fldPeriod=-12 means input file contains 12 monthly means
C *=================================================================*
C \ev
C !USES:
IMPLICIT NONE
C == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
#include "EXF_INTERP_SIZE.h"
#include "EXF_PARAM.h"
#include "EXF_CONSTANTS.h"
C !INPUT/OUTPUT PARAMETERS:
C fldName :: field short name (to print mesg)
C fldFile :: file-name for this field
C fldStartTime :: corresponding starting time (in sec) for this field
C fldPeriod :: time period (in sec) between 2 reccords
C fldRepeatCycle :: time duration of a repeating cycle
C fld_inScale :: input field scaling factor
C fldRemove_intercept ::
C fldRemove_slope ::
C fldArr :: field array containing current time values
C fld0 :: field array holding previous reccord
C fld1 :: field array holding next reccord
#ifdef USE_EXF_INTERPOLATION
C fld_lon0, fld_lat0 :: longitude and latitude of SouthWest
C :: corner of global input grid
C fld_nlon, fld_nlat :: input x-grid and y-grid size
C fld_lon_inc :: scalar x-grid increment
C fld_lat_inc :: vector y-grid increments
C fld_xout, fld_yout :: coordinates for output grid
C fld_xout, fld_yout :: coordinates for output grid
C interp_method :: select interpolation method (integer)
#endif /* USE_EXF_INTERPOLATION */
C myTime :: Current time (in sec) in simulation
C myIter :: Current iteration number
C myThid :: My Thread Id number
CHARACTER*(*) fldName
CHARACTER*(128) fldFile
CHARACTER*1 fldMask
_RL fldStartTime, fldPeriod, fldRepeatCycle
_RL fld_inScale
_RL fldRemove_intercept, fldRemove_slope
_RL fldArr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
_RL fld0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
_RL fld1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
#ifdef USE_EXF_INTERPOLATION
_RL fld_lon0, fld_lon_inc
_RL fld_lat0, fld_lat_inc(MAX_LAT_INC)
INTEGER fld_nlon, fld_nlat
_RS fld_xout (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
_RS fld_yout (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
INTEGER interp_method
#endif /* USE_EXF_INTERPOLATION */
_RL myTime
INTEGER myIter
INTEGER myThid
C !FUNCTIONS:
INTEGER ILNBLNK
EXTERNAL
C !LOCAL VARIABLES:
C msgBuf :: Informational/error message buffer
CHARACTER*(MAX_LEN_MBUF) msgBuf
LOGICAL first, changed
INTEGER count0, count1
INTEGER year0, year1
INTEGER bi, bj, i, j
_RL fac
CHARACTER*(128) locFile0, locFile1
#ifdef USE_EXF_INTERPOLATION
CHARACTER*(MAX_LEN_FNAM) out_file
# ifndef EXF_INTERP_USE_DYNALLOC
_RL bufArr( exf_interp_bufferSize )
# endif
#endif /* USE_EXF_INTERPOLATION */
CEOP
IF ( fldFile .NE. ' ' .AND. fldPeriod .NE. 0. ) THEN
IF ( exf_debugLev.GE.debLevD ) THEN
_BEGIN_MASTER( myThid )
j = ILNBLNK(fldFile)
WRITE(msgBuf,'(5A)') 'EXF_SET_FLD: ',
& 'processing field "', fldName, '", file: ', fldFile(1:j)
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
_END_MASTER( myThid )
ENDIF
IF ( useCAL .AND. fldPeriod .EQ. -12. ) THEN
#ifdef ALLOW_CAL
C- fldPeriod=-12 means input file contains 12 monthly means
C records, corresponding to Jan. (rec=1) through Dec. (rec=12)
CALL CAL_GETMONTHSREC(
O fac, first, changed,
O count0, count1,
I myTime, myIter, myThid )
#endif /* ALLOW_CAL */
ELSEIF ( fldPeriod .LT. 0. ) THEN
j = ILNBLNK(fldFile)
WRITE(msgBuf,'(4A,1PE16.8,2A)') 'EXF_SET_FLD: ',
& '"', fldName, '", Invalid fldPeriod=', fldPeriod,
& ' for file: ', fldFile(1:j)
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R EXF_SET_FLD'
ELSE
C- get record numbers and interpolation factor for this field
CALL EXF_GETFFIELDREC(
I fldStartTime, fldPeriod, fldRepeatCycle,
I fldName, useExfYearlyFields,
O fac, first, changed,
O count0, count1, year0, year1,
I myTime, myIter, myThid )
ENDIF
IF ( exf_debugLev.GE.debLevD ) THEN
_BEGIN_MASTER( myThid )
WRITE(msgBuf,'(2A,I10,2I7)') 'EXF_SET_FLD: ',
& ' myIter, count0, count1:', myIter, count0, count1
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(2A,2(L2,2X),E16.9)') 'EXF_SET_FLD: ',
& ' first, changed, fac: ', first, changed, fac
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
_END_MASTER( myThid )
ENDIF
IF ( first ) THEN
CALL EXF_GETYEARLYFIELDNAME(
I useExfYearlyFields, twoDigitYear, fldPeriod, year0,
I fldFile,
O locFile0,
I myTime, myIter, myThid )
IF ( exf_debugLev.GE.debLevC ) THEN
_BEGIN_MASTER(myThid)
j = ILNBLNK(locFile0)
WRITE(msgBuf,'(4A,I10,A,I6)') 'EXF_SET_FLD: ',
& 'field "', fldName, '", it=', myIter,
& ', loading rec=', count0
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(4A)') 'EXF_SET_FLD: ',
& ' from file: "', locFile0(1:j), '"'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
_END_MASTER(myThid)
ENDIF
#ifdef USE_EXF_INTERPOLATION
IF ( interp_method.GE.1 ) THEN
CALL EXF_INTERP(
I locFile0, exf_iprec,
#ifdef EXF_INTERP_USE_DYNALLOC
O fld1,
#else
O fld1, bufArr,
#endif
I count0, fld_xout, fld_yout,
I fld_lon0, fld_lon_inc, fld_lat0, fld_lat_inc,
I fld_nlon, fld_nlat, interp_method, myIter, myThid )
ELSE
#endif /* USE_EXF_INTERPOLATION */
CALL READ_REC_3D_RL( locFile0, exf_iprec, 1,
& fld1, count0, myIter, myThid )
#ifdef USE_EXF_INTERPOLATION
ENDIF
#endif /* USE_EXF_INTERPOLATION */
#ifdef USE_EXF_INTERPOLATION
IF ( exf_output_interp ) THEN
j = ILNBLNK(locFile0)
WRITE(out_file,'(2A)') locFile0(1:j), '_out'
IF ( count0.NE.1 )
& CALL WRITE_REC_XY_RL( out_file, fld1, 1, myIter, myThid )
CALL WRITE_REC_XY_RL( out_file,fld1,count0,myIter,myThid )
ENDIF
#endif /* USE_EXF_INTERPOLATION */
C- apply mask
CALL EXF_FILTER_RL( fld1, fldMask, myThid )
C- end if ( first ) block
ENDIF
IF ( first .OR. changed ) THEN
CALL EXF_SWAPFFIELDS( fld0, fld1, myThid )
CALL EXF_GETYEARLYFIELDNAME(
I useExfYearlyFields, twoDigitYear, fldPeriod, year1,
I fldFile,
O locFile1,
I myTime, myIter, myThid )
IF ( exf_debugLev.GE.debLevC ) THEN
_BEGIN_MASTER(myThid)
j = ILNBLNK(locFile1)
WRITE(msgBuf,'(4A,I10,A,I6)') 'EXF_SET_FLD: ',
& 'field "', fldName, '", it=', myIter,
& ', loading rec=', count1
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(4A)') 'EXF_SET_FLD: ',
& ' from file: "', locFile1(1:j), '"'
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
_END_MASTER(myThid)
ENDIF
#ifdef USE_EXF_INTERPOLATION
IF ( interp_method.GE.1 ) THEN
CALL EXF_INTERP(
I locFile1, exf_iprec,
#ifdef EXF_INTERP_USE_DYNALLOC
O fld1,
#else
O fld1, bufArr,
#endif
I count1, fld_xout, fld_yout,
I fld_lon0, fld_lon_inc, fld_lat0, fld_lat_inc,
I fld_nlon, fld_nlat, interp_method, myIter, myThid )
ELSE
#endif /* USE_EXF_INTERPOLATION */
CALL READ_REC_3D_RL( locFile1, exf_iprec, 1,
& fld1, count1, myIter, myThid )
#ifdef USE_EXF_INTERPOLATION
ENDIF
#endif /* USE_EXF_INTERPOLATION */
#ifdef USE_EXF_INTERPOLATION
IF ( exf_output_interp ) THEN
j = ILNBLNK(locFile1)
WRITE(out_file,'(2A)') locFile1(1:j), '_out'
CALL WRITE_REC_XY_RL( out_file,fld1,count1,myIter,myThid )
ENDIF
#endif /* USE_EXF_INTERPOLATION */
C- apply mask
CALL EXF_FILTER_RL( fld1, fldMask, myThid )
C- end if ( first or changed ) block
ENDIF
C Loop over tiles.
DO bj = myByLo(myThid),myByHi(myThid)
DO bi = myBxLo(myThid),mybxhi(myThid)
DO j = 1,sNy
DO i = 1,sNx
C Interpolate linearly onto the time.
fldArr(i,j,bi,bj) = fld_inScale * (
& fac * fld0(i,j,bi,bj)
& + (exf_one - fac)* fld1(i,j,bi,bj) )
fldArr(i,j,bi,bj) = fldArr(i,j,bi,bj)
& - fld_inScale*( fldRemove_intercept
& + fldRemove_slope*(myTime-startTime) )
ENDDO
ENDDO
ENDDO
ENDDO
ENDIF
RETURN
END