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