pkg/exf/exf_init_fld.F

8a0f942cd7 Jean*0001 #include "EXF_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004
                0005 CBOP
                0006 C     !ROUTINE: EXF_INIT_FLD
                0007 C     !INTERFACE:
                0008       SUBROUTINE EXF_INIT_FLD (
                0009      I     fldName, fldFile, fldMask,
                0010      I     fldPeriod, fld_inScale, fldConst,
                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     myThid )
                0017
                0018 C !DESCRIPTION: \bv
                0019 C  *=================================================================*
                0020 C  | SUBROUTINE EXF_INIT_FLD
                0021 C  *=================================================================*
                0022 C  |  started: Ralf.Giering@FastOpt.de 25-Mai-2000
                0023 C  |  changed: heimbach@mit.edu 10-Jan-2002
                0024 C  |           heimbach@mit.edu: totally re-organized exf_set_...
                0025 C  |           replaced all routines by one generic routine
                0026 C  *=================================================================*
                0027 C \ev
                0028
                0029 C !USES:
                0030       IMPLICIT NONE
                0031 C     == global variables ==
                0032 #include "EEPARAMS.h"
                0033 #include "SIZE.h"
                0034 #include "EXF_PARAM.h"
30fcb891cf Jean*0035 #include "EXF_INTERP_SIZE.h"
8a0f942cd7 Jean*0036
                0037 C !INPUT/OUTPUT PARAMETERS:
                0038 C     fldName        :: field short name (to print mesg)
                0039 C     fldFile        :: file-name for this field
                0040 C     fldPeriod      :: time period (in sec) between 2 reccords
                0041 C     fld_inScale    :: input field scaling factor
                0042 C     fldConst       :: uniform default field value
                0043 C     fldArr         :: field array containing current time values
                0044 C     fld0           :: field array holding previous reccord
                0045 C     fld1           :: field array holding next     reccord
                0046 C     myThid         :: My Thread Id number
                0047       CHARACTER*(*) fldName
                0048       CHARACTER*(128) fldFile
                0049       CHARACTER*1 fldMask
                0050       _RL fldPeriod, fld_inScale, fldConst
                0051       _RL fldArr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0052       _RL fld0  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0053       _RL fld1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0054       INTEGER myThid
                0055
                0056 #ifdef USE_EXF_INTERPOLATION
                0057 C     fld_lon0, fld_lat0   :: longitude and latitude of SouthWest
                0058 C                             corner of global input grid
                0059 C     fld_nlon, fld_nlat   :: input x-grid and y-grid size
                0060 C     fld_lon_inc          :: scalar x-grid increment
                0061 C     fld_lat_inc          :: vector y-grid increments
                0062 C     fld_xout, fld_yout   :: coordinates for output grid
                0063       _RL fld_lon0, fld_lon_inc
                0064       _RL fld_lat0, fld_lat_inc(MAX_LAT_INC)
                0065       INTEGER fld_nlon, fld_nlat
                0066       _RS fld_xout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0067       _RS fld_yout  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0068       INTEGER interp_method
                0069 #endif /* USE_EXF_INTERPOLATION */
                0070
                0071 C !FUNCTIONS:
                0072       INTEGER  ILNBLNK
                0073       EXTERNAL ILNBLNK
                0074
                0075 C !LOCAL VARIABLES:
                0076 C     msgBuf     :: Informational/error message buffer
                0077       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0078       INTEGER bi, bj, i, j, count
a9085e980c Jean*0079 #ifdef USE_EXF_INTERPOLATION
                0080 # ifndef EXF_INTERP_USE_DYNALLOC
                0081       _RL     bufArr( exf_interp_bufferSize )
                0082 # endif
                0083 #endif /* USE_EXF_INTERPOLATION */
8a0f942cd7 Jean*0084 CEOP
                0085
                0086       DO bj = myByLo(myThid), myByHi(myThid)
edf9251fd4 Jean*0087         DO bi = myBxLo(myThid), myBxHi(myThid)
8a0f942cd7 Jean*0088           DO j = 1-OLy, sNy+OLy
                0089             DO i = 1-OLx, sNx+OLx
                0090               fldArr(i,j,bi,bj)  = fldConst
                0091               fld0(i,j,bi,bj)    = fldConst
                0092               fld1(i,j,bi,bj)    = fldConst
                0093             ENDDO
                0094           ENDDO
                0095         ENDDO
                0096       ENDDO
                0097
                0098       IF ( fldFile .NE. ' ' .AND. fldPeriod .EQ. 0. ) THEN
                0099          count = 1
                0100          IF ( exf_debugLev.GE.debLevC ) THEN
                0101            _BEGIN_MASTER(myThid)
                0102            j = ILNBLNK(fldFile)
                0103            WRITE(msgBuf,'(4A,I3,2A)') 'EXF_INIT_FLD: ',
                0104      &         'field "', fldName,
                0105      &         '", loading rec=', count, ' from: ', fldFile(1:j)
                0106            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0107      &                         SQUEEZE_RIGHT, myThid )
                0108            _END_MASTER(myThid)
                0109          ENDIF
                0110
                0111 #ifdef USE_EXF_INTERPOLATION
                0112          IF ( interp_method.GE.1 ) THEN
                0113               CALL EXF_INTERP(
                0114      I             fldFile, exf_iprec,
a9085e980c Jean*0115 #ifdef EXF_INTERP_USE_DYNALLOC
8a0f942cd7 Jean*0116      O             fldArr,
a9085e980c Jean*0117 #else
                0118      O             fldArr, bufArr,
                0119 #endif
8a0f942cd7 Jean*0120      I             count, fld_xout, fld_yout,
                0121      I             fld_lon0, fld_lon_inc, fld_lat0, fld_lat_inc,
                0122      I             fld_nlon, fld_nlat, interp_method, 0, myThid )
                0123          ELSE
                0124 #endif /* USE_EXF_INTERPOLATION */
                0125             CALL READ_REC_3D_RL( fldFile, exf_iprec, 1,
                0126      &                           fldArr, count, 0, myThid )
                0127 #ifdef USE_EXF_INTERPOLATION
                0128          ENDIF
                0129 #endif /* USE_EXF_INTERPOLATION */
                0130
                0131 C-    apply mask
                0132          CALL EXF_FILTER_RL( fldArr, fldMask, myThid )
                0133
                0134 C     Loop over tiles and scale fldArr
                0135          DO bj = myByLo(myThid),myByHi(myThid)
edf9251fd4 Jean*0136           DO bi = myBxLo(myThid),myBxHi(myThid)
8a0f942cd7 Jean*0137            DO j = 1,sNy
                0138             DO i = 1,sNx
                0139               fldArr(i,j,bi,bj) = fld_inScale*fldArr(i,j,bi,bj)
                0140             ENDDO
                0141            ENDDO
                0142           ENDDO
                0143          ENDDO
                0144
                0145       ENDIF
                0146
                0147       RETURN
                0148       END