Back to home page

MITgcm
 
 

    

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

view on githubraw file Latest commit deacece5 on 2021-11-09 17:35:09 UTC
8ac0e9b3ce Dimi*0001 #include "EXF_OPTIONS.h"
                0002 
8a0f942cd7 Jean*0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 
30fcb891cf Jean*0005 C     !ROUTINE: EXF_SET_UV
8a0f942cd7 Jean*0006 C     !INTERFACE:
4aa4270510 Jean*0007       SUBROUTINE EXF_SET_UV(
8a0f942cd7 Jean*0008      I     uVecName, uVecFile, uVecMask,
                0009      I     uVecStartTime, uVecPeriod, uVecRepeatCycle,
                0010      I     uVec_inScale, uVec_remove_intercept, uVec_remove_slope,
                0011      U     uVec, uVec0, uVec1,
                0012      I     vVecName, vVecFile, vVecMask,
                0013      I     vVecStartTime, vVecPeriod, vVecRepeatCycle,
                0014      I     vVec_inScale, vVec_remove_intercept, vVec_remove_slope,
                0015      U     vVec, vVec0, vVec1,
4aa4270510 Jean*0016 #ifdef USE_EXF_INTERPOLATION
8a0f942cd7 Jean*0017      I     uVec_lon0, uVec_lon_inc, uVec_lat0, uVec_lat_inc,
                0018      I     uVec_nlon, uVec_nlat, u_interp_method,
                0019      I     vVec_lon0, vVec_lon_inc, vVec_lat0, vVec_lat_inc,
                0020      I     vVec_nlon, vVec_nlat, v_interp_method, uvInterp,
4aa4270510 Jean*0021 #endif /* USE_EXF_INTERPOLATION */
                0022      I     myTime, myIter, myThid )
8ac0e9b3ce Dimi*0023 
8a0f942cd7 Jean*0024 C !DESCRIPTION: \bv
                0025 C  *=================================================================*
                0026 C  | SUBROUTINE EXF_SET_UV
                0027 C  | o Read-in, interpolate, and rotate wind or wind stress vectors
                0028 C  |   from a spherical-polar input grid to an arbitrary output grid.
                0029 C  *=================================================================*
                0030 C  |   menemenlis@jpl.nasa.gov, 8-Dec-2003
                0031 C  *=================================================================*
                0032 C \ev
                0033 
                0034 C !USES:
4aa4270510 Jean*0035       IMPLICIT NONE
                0036 C     == global variables ==
8ac0e9b3ce Dimi*0037 #include "EEPARAMS.h"
                0038 #include "SIZE.h"
                0039 #include "PARAMS.h"
                0040 #include "GRID.h"
082e18c36c Jean*0041 #include "EXF_PARAM.h"
                0042 #include "EXF_CONSTANTS.h"
30fcb891cf Jean*0043 #include "EXF_INTERP_SIZE.h"
                0044 #include "EXF_INTERP_PARAM.h"
a9085e980c Jean*0045 #include "EXF_FIELDS.h"
8ac0e9b3ce Dimi*0046 
8a0f942cd7 Jean*0047 C !INPUT/OUTPUT PARAMETERS:
                0048 C     *VecName        :: vector compon. short name (to print mesg)
                0049 C     *VecFile        :: file-name for this vector compon. field
                0050 C     *VecStartTime   :: corresponding starting time (in sec) for this vec
                0051 C     *VecPeriod      :: time period (in sec) between 2 reccords
                0052 C     *VecRepeatCycle :: time duration of a repeating cycle
                0053 C     *Vec_inScale    :: input field scaling factor
                0054 C     *VecRemove_intercept ::
                0055 C     *VecRemove_slope     ::
                0056 C     *Vec            :: field array containing current time values
                0057 C     *Vec0           :: field array holding previous reccord
                0058 C     *Vec1           :: field array holding next     reccord
                0059 #ifdef USE_EXF_INTERPOLATION
                0060 C     *vec_lon0, *vec_lat0 :: longitude and latitude of SouthWest
                0061 C                          :: corner of global input grid for *vec
4aa4270510 Jean*0062 C     *vec_nlon, *vec_nlat :: input x-grid and y-grid size for *vec
a9085e980c Jean*0063 C     *_interp_method      :: select interpolation method for *vec
4aa4270510 Jean*0064 C     *vec_lon_inc         :: scalar x-grid increment for *vec
                0065 C     *vec_lat_inc         :: vector y-grid increments for *vec
8a0f942cd7 Jean*0066 #endif /* USE_EXF_INTERPOLATION */
                0067 C     myTime         :: Current time (in sec) in simulation
                0068 C     myIter         :: Current iteration number
                0069 C     myThid         :: My Thread Id number
                0070       CHARACTER*(*) uVecName
                0071       CHARACTER*(128) uVecFile
                0072       CHARACTER*1 uVecMask
                0073       _RL     uVecStartTime, uVecPeriod, uVecRepeatCycle
                0074       _RL     uVec_inScale
                0075       _RL     uVec_remove_intercept, uVec_remove_slope
                0076       _RL     uVec  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0077       _RL     uVec0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0078       _RL     uVec1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0079       CHARACTER*(*) vVecName
                0080       CHARACTER*(128) vVecFile
                0081       CHARACTER*1 vVecMask
                0082       _RL     vVecStartTime, vVecPeriod, vVecRepeatCycle
                0083       _RL     vVec_inScale
                0084       _RL     vVec_remove_intercept, vVec_remove_slope
                0085       _RL     vVec  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0086       _RL     vVec0 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0087       _RL     vVec1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
4aa4270510 Jean*0088 #ifdef USE_EXF_INTERPOLATION
8a0f942cd7 Jean*0089       _RL uVec_lon0, uVec_lon_inc
                0090       _RL uVec_lat0, uVec_lat_inc(MAX_LAT_INC)
                0091       INTEGER uVec_nlon, uVec_nlat, u_interp_method
                0092       _RL vVec_lon0, vVec_lon_inc
                0093       _RL vVec_lat0, vVec_lat_inc(MAX_LAT_INC)
                0094       INTEGER vVec_nlon, vVec_nlat, v_interp_method
78c96ec6a7 Jean*0095       LOGICAL uvInterp
4aa4270510 Jean*0096 #endif /* USE_EXF_INTERPOLATION */
                0097       _RL     myTime
                0098       INTEGER myIter
                0099       INTEGER myThid
8ac0e9b3ce Dimi*0100 
8a0f942cd7 Jean*0101 C !FUNCTIONS:
1fc1e2c3e5 Jean*0102       INTEGER  ILNBLNK
                0103       EXTERNAL ILNBLNK
                0104 
8a0f942cd7 Jean*0105 C !LOCAL VARIABLES:
353c624de2 Jean*0106       INTEGER i, j, bi, bj
                0107       _RL     tmp_u (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0108       _RL     tmp_v (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
4aa4270510 Jean*0109 #ifdef USE_EXF_INTERPOLATION
1fc1e2c3e5 Jean*0110 C     msgBuf     :: Informational/error message buffer
                0111       CHARACTER*(MAX_LEN_MBUF) msgBuf
8a0f942cd7 Jean*0112       CHARACTER*(128) uVecFile0, uVecFile1
                0113       CHARACTER*(128) vVecFile0, vVecFile1
                0114       CHARACTER*(MAX_LEN_FNAM) out_uVecFile, out_vVecFile
4aa4270510 Jean*0115       LOGICAL first, changed
95aadf3c69 Jean*0116       _RL     fac
                0117 #ifdef EXF_USE_OLD_VEC_ROTATION
                0118       _RL     x1, x2, x3, x4, y1, y2, y3, y4, dx, dy
                0119 #endif
4aa4270510 Jean*0120       INTEGER count0, count1
                0121       INTEGER year0, year1
a9085e980c Jean*0122 # ifndef EXF_INTERP_USE_DYNALLOC
                0123       _RL     bufArr1( exf_interp_bufferSize )
                0124       _RL     bufArr2( exf_interp_bufferSize )
                0125 # endif
4aa4270510 Jean*0126 #endif /* USE_EXF_INTERPOLATION */
8a0f942cd7 Jean*0127 CEOP
8ac0e9b3ce Dimi*0128 
4aa4270510 Jean*0129 #ifdef USE_EXF_INTERPOLATION
78c96ec6a7 Jean*0130       IF ( u_interp_method.GE.1 .AND. v_interp_method.GE.1 .AND.
8a0f942cd7 Jean*0131      &     uVecFile.NE.' ' .AND. vVecFile.NE.' ' .AND.
78c96ec6a7 Jean*0132      &     (usingCurvilinearGrid .OR. rotateGrid .OR. uvInterp) ) THEN
8ac0e9b3ce Dimi*0133 
454eebbe98 Jean*0134         IF ( exf_debugLev.GE.debLevD ) THEN
                0135           _BEGIN_MASTER( myThid )
8a0f942cd7 Jean*0136            i = ILNBLNK(uVecFile)
                0137            j = ILNBLNK(vVecFile)
                0138            WRITE(msgBuf,'(6A)') 'EXF_SET_UV: ',
                0139      &       'processing fields "', uVecName, '" & "', vVecName, '"'
                0140            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0141      &                         SQUEEZE_RIGHT, myThid )
                0142            WRITE(msgBuf,'(6A)') 'EXF_SET_UV: ',
                0143      &       '  files: ', uVecFile(1:i), ' & ', vVecFile(1:j)
454eebbe98 Jean*0144            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0145      &                         SQUEEZE_RIGHT, myThid )
                0146           _END_MASTER( myThid )
                0147         ENDIF
8a0f942cd7 Jean*0148         IF ( useCAL .AND. uVecPeriod .EQ. -12. ) THEN
bd3e337e2f Jean*0149 #ifdef ALLOW_CAL
d0e15cd3ab Jean*0150 C-    genperiod=-12 means input file contains 12 monthly means
                0151 C     records, corresponding to Jan. (rec=1) through Dec. (rec=12)
                0152           CALL cal_GetMonthsRec(
                0153      O             fac, first, changed,
deacece587 Oliv*0154      O             count0, count1, year0, year1,
                0155      I             myTime, myIter, myThid )
                0156 #endif /* ALLOW_CAL */
                0157         ELSEIF ( useCAL .AND. uVecPeriod .EQ. -1.) THEN
                0158 #ifdef ALLOW_CAL
                0159 C-    uVecPeriod=-1 means fields are monthly means.
                0160 C     With useExfYearlyFields=.TRUE., each yearly input file contains
                0161 C     12 monthly mean records.  Otherwise, a single input file contains
                0162 C     monthly mean records starting at the month uVecStartTime falls in.
                0163           CALL EXF_GetMonthsRec(
                0164      I             uVecStartTime, useExfYearlyFields,
                0165      O             fac, first, changed,
                0166      O             count0, count1, year0, year1,
d0e15cd3ab Jean*0167      I             myTime, myIter, myThid )
bd3e337e2f Jean*0168 #endif /* ALLOW_CAL */
8a0f942cd7 Jean*0169         ELSEIF ( uVecPeriod .LT. 0. ) THEN
                0170           j = ILNBLNK(uVecFile)
                0171           WRITE(msgBuf,'(4A,1PE16.8,2A)') 'EXF_SET_UV: ',
                0172      &      '"', uVecName, '", Invalid uVecPeriod=', uVecPeriod,
                0173      &      ' for file: ', uVecFile(1:j)
d0e15cd3ab Jean*0174           CALL PRINT_ERROR( msgBuf, myThid )
                0175           STOP 'ABNORMAL END: S/R EXF_SET_UV'
                0176         ELSE
78c96ec6a7 Jean*0177 C-    get record numbers and interpolation factor
8a0f942cd7 Jean*0178           CALL EXF_GetFFieldRec(
                0179      I             uVecStartTime, uVecPeriod, uVecRepeatCycle,
                0180      I             uVecName, useExfYearlyFields,
d0e15cd3ab Jean*0181      O             fac, first, changed,
                0182      O             count0, count1, year0, year1,
                0183      I             myTime, myIter, myThid )
                0184         ENDIF
                0185         IF ( exf_debugLev.GE.debLevD ) THEN
                0186           _BEGIN_MASTER( myThid )
8a0f942cd7 Jean*0187            WRITE(msgBuf,'(2A,I10,2I7)') 'EXF_SET_UV:  ',
d0e15cd3ab Jean*0188      &       ' myIter, count0, count1:', myIter, count0, count1
                0189            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0190      &                         SQUEEZE_RIGHT, myThid )
deacece587 Oliv*0191            WRITE(msgBuf,'(2A,2(L2,2X),F21.17)') 'EXF_SET_UV:  ',
d0e15cd3ab Jean*0192      &       ' first, changed, fac:  ', first, changed, fac
                0193            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0194      &                         SQUEEZE_RIGHT, myThid )
                0195           _END_MASTER( myThid )
                0196         ENDIF
8ac0e9b3ce Dimi*0197 
4aa4270510 Jean*0198         IF ( first ) THEN
78c96ec6a7 Jean*0199 C--   Load and interpolate a new reccord (= 1rst one of this run)
510778fc01 Mart*0200 
4aa4270510 Jean*0201           CALL exf_GetYearlyFieldName(
8a0f942cd7 Jean*0202      I         useExfYearlyFields, twoDigitYear, uVecPeriod, year0,
                0203      I         uVecFile,
                0204      O         uVecFile0,
4aa4270510 Jean*0205      I         myTime, myIter, myThid )
                0206           CALL exf_GetYearlyFieldName(
8a0f942cd7 Jean*0207      I         useExfYearlyFields, twoDigitYear, vVecPeriod, year0,
                0208      I         vVecFile,
                0209      O         vVecFile0,
4aa4270510 Jean*0210      I         myTime, myIter, myThid )
1fc1e2c3e5 Jean*0211           IF ( exf_debugLev.GE.debLevC ) THEN
                0212             _BEGIN_MASTER(myThid)
8a0f942cd7 Jean*0213             WRITE(msgBuf,'(6A,I10)') 'EXF_SET_UV: ',
                0214      &        'fields "', uVecName, '" & "', vVecName, '", it=', myIter
1fc1e2c3e5 Jean*0215             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0216      &                          SQUEEZE_RIGHT, myThid )
8a0f942cd7 Jean*0217             j = ILNBLNK(uVecFile0)
                0218             WRITE(msgBuf,'(2A,I6,3A)') 'EXF_SET_UV:   ',
                0219      &      'loading rec=', count0, ' from file: "', uVecFile0(1:j), '"'
1fc1e2c3e5 Jean*0220             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
8a0f942cd7 Jean*0221      &                          SQUEEZE_RIGHT, myThid )
                0222             j = ILNBLNK(vVecFile0)
                0223             WRITE(msgBuf,'(2A,I6,3A)') 'EXF_SET_UV:   ',
                0224      &      'loading rec=', count0, ' from file: "', vVecFile0(1:j), '"'
                0225             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0226      &                          SQUEEZE_RIGHT, myThid )
1fc1e2c3e5 Jean*0227             _END_MASTER(myThid)
                0228           ENDIF
4aa4270510 Jean*0229 
78c96ec6a7 Jean*0230           IF ( uvInterp ) THEN
                0231 C-    vector interpolation to (xC,yC) locations
                0232            CALL EXF_INTERP_UV(
8a0f942cd7 Jean*0233      I             uVecFile0, vVecFile0, exf_iprec, count0,
                0234      I             uVec_nlon, uVec_nlat,
                0235      I             uVec_lon0, uVec_lon_inc, uVec_lat0, uVec_lat_inc,
a9085e980c Jean*0236 #ifdef EXF_INTERP_USE_DYNALLOC
78c96ec6a7 Jean*0237      O             tmp_u, tmp_v,
a9085e980c Jean*0238 #else
                0239      O             tmp_u, tmp_v, bufArr1, bufArr2,
                0240 #endif
78c96ec6a7 Jean*0241      I             xC, yC,
                0242      I             u_interp_method, v_interp_method, myIter, myThid )
                0243           ELSE
                0244 C-    scalar interpolation to (xC,yC) locations
                0245            CALL EXF_INTERP(
8a0f942cd7 Jean*0246      I             uVecFile0, exf_iprec,
a9085e980c Jean*0247 #ifdef EXF_INTERP_USE_DYNALLOC
4aa4270510 Jean*0248      O             tmp_u,
a9085e980c Jean*0249 #else
                0250      O             tmp_u, bufArr1,
                0251 #endif
4aa4270510 Jean*0252      I             count0, xC, yC,
8a0f942cd7 Jean*0253      I             uVec_lon0, uVec_lon_inc, uVec_lat0, uVec_lat_inc,
                0254      I             uVec_nlon, uVec_nlat, u_interp_method,
78c96ec6a7 Jean*0255      I             myIter, myThid )
                0256            CALL EXF_INTERP(
8a0f942cd7 Jean*0257      I             vVecFile0, exf_iprec,
a9085e980c Jean*0258 #ifdef EXF_INTERP_USE_DYNALLOC
4aa4270510 Jean*0259      O             tmp_v,
a9085e980c Jean*0260 #else
                0261      O             tmp_v, bufArr2,
                0262 #endif
4aa4270510 Jean*0263      I             count0, xC, yC,
8a0f942cd7 Jean*0264      I             vVec_lon0, vVec_lon_inc, vVec_lat0, vVec_lat_inc,
                0265      I             vVec_nlon, vVec_nlat, v_interp_method,
78c96ec6a7 Jean*0266      I             myIter, myThid )
                0267           ENDIF
                0268 
353c624de2 Jean*0269 C-    apply mask: Note: done after applying scaling factor and rotation
8a0f942cd7 Jean*0270 c         CALL EXF_FILTER_RL( tmp_u, uVecMask, myThid )
                0271 c         CALL EXF_FILTER_RL( tmp_v, vVecMask, myThid )
353c624de2 Jean*0272 
                0273           IF ( exf_output_interp ) THEN
8a0f942cd7 Jean*0274            j = ILNBLNK(uVecFile0)
                0275            WRITE(out_uVecFile,'(2A)') uVecFile0(1:j), '_out'
353c624de2 Jean*0276            IF ( count0.NE.1 )
8a0f942cd7 Jean*0277      &     CALL WRITE_REC_XY_RL(out_uVecFile,tmp_u,1,myIter,myThid)
                0278            CALL WRITE_REC_XY_RL(out_uVecFile,tmp_u,count0,myIter,myThid)
                0279            j = ILNBLNK(vVecFile0)
                0280            WRITE(out_vVecFile,'(2A)') vVecFile0(1:j), '_out'
353c624de2 Jean*0281            IF ( count0.NE.1 )
8a0f942cd7 Jean*0282      &     CALL WRITE_REC_XY_RL(out_vVecFile,tmp_v,1,myIter,myThid)
                0283            CALL WRITE_REC_XY_RL(out_vVecFile,tmp_v,count0,myIter,myThid)
353c624de2 Jean*0284           ENDIF
63930fb278 Gael*0285 
353c624de2 Jean*0286 C-    scaling factor and vector rotation
78c96ec6a7 Jean*0287           IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
                0288             DO bj = myByLo(myThid),myByHi(myThid)
                0289              DO bi = myBxLo(myThid),myBxHi(myThid)
4aa4270510 Jean*0290               DO j = 1,sNy
78c96ec6a7 Jean*0291                DO i = 1,sNx
8a0f942cd7 Jean*0292                  tmp_u(i,j,bi,bj) = uVec_inScale*tmp_u(i,j,bi,bj)
                0293                  tmp_v(i,j,bi,bj) = vVec_inScale*tmp_v(i,j,bi,bj)
353c624de2 Jean*0294                ENDDO
                0295               ENDDO
                0296               DO j = 1,sNy
                0297                DO i = 1,sNx
95aadf3c69 Jean*0298 #ifdef EXF_USE_OLD_VEC_ROTATION
1e18bd6176 Dimi*0299                     x1=xG(i,j,bi,bj)
                0300                     x2=xG(i+1,j,bi,bj)
                0301                     x3=xG(i,j+1,bi,bj)
                0302                     x4=xG(i+1,j+1,bi,bj)
4aa4270510 Jean*0303                     IF ((x2-x1).GT.180) x2=x2-360
                0304                     IF ((x1-x2).GT.180) x2=x2+360
                0305                     IF ((x3-x1).GT.180) x3=x3-360
                0306                     IF ((x1-x3).GT.180) x3=x3+360
                0307                     IF ((x4-x1).GT.180) x4=x4-360
                0308                     IF ((x1-x4).GT.180) x4=x4+360
1e18bd6176 Dimi*0309                     y1=yG(i,j,bi,bj)
                0310                     y2=yG(i+1,j,bi,bj)
                0311                     y3=yG(i,j+1,bi,bj)
                0312                     y4=yG(i+1,j+1,bi,bj)
a7ceeb6957 Patr*0313                     dx=0.5*(x3+x4-x1-x2)
                0314                     dx=dx*
1e18bd6176 Dimi*0315      &                  cos(deg2rad*yC(i,j,bi,bj))
a7ceeb6957 Patr*0316                     dy=0.5*(y3+y4-y1-y2)
8a0f942cd7 Jean*0317                     vVec1(i,j,bi,bj)=
1e18bd6176 Dimi*0318      &                  (tmp_u(i,j,bi,bj)*dx+
                0319      &                  tmp_v(i,j,bi,bj)*dy)/
4aa4270510 Jean*0320      &                  SQRT(dx*dx+dy*dy)
a7ceeb6957 Patr*0321                     dx=0.5*(x2+x4-x1-x3)
                0322                     dx=dx*
1e18bd6176 Dimi*0323      &                  cos(deg2rad*yC(i,j,bi,bj))
a7ceeb6957 Patr*0324                     dy=0.5*(y2+y4-y1-y3)
8a0f942cd7 Jean*0325                     uVec1(i,j,bi,bj)=
1e18bd6176 Dimi*0326      &                  (tmp_u(i,j,bi,bj)*dx+
                0327      &                  tmp_v(i,j,bi,bj)*dy)/
4aa4270510 Jean*0328      &                  SQRT(dx*dx+dy*dy)
95aadf3c69 Jean*0329 #else /* EXF_USE_OLD_VEC_ROTATION */
8a0f942cd7 Jean*0330                  uVec1(i,j,bi,bj) =
95aadf3c69 Jean*0331      &                      angleCosC(i,j,bi,bj)*tmp_u(i,j,bi,bj)
                0332      &                     +angleSinC(i,j,bi,bj)*tmp_v(i,j,bi,bj)
8a0f942cd7 Jean*0333                  vVec1(i,j,bi,bj) =
95aadf3c69 Jean*0334      &                     -angleSinC(i,j,bi,bj)*tmp_u(i,j,bi,bj)
                0335      &                     +angleCosC(i,j,bi,bj)*tmp_v(i,j,bi,bj)
                0336 #endif /* EXF_USE_OLD_VEC_ROTATION */
78c96ec6a7 Jean*0337                ENDDO
4aa4270510 Jean*0338               ENDDO
78c96ec6a7 Jean*0339              ENDDO
4aa4270510 Jean*0340             ENDDO
78c96ec6a7 Jean*0341           ELSE
                0342             DO bj = myByLo(myThid),myByHi(myThid)
                0343              DO bi = myBxLo(myThid),myBxHi(myThid)
                0344               DO j = 1,sNy
                0345                DO i = 1,sNx
8a0f942cd7 Jean*0346                  uVec1(i,j,bi,bj) = uVec_inScale*tmp_u(i,j,bi,bj)
                0347                  vVec1(i,j,bi,bj) = vVec_inScale*tmp_v(i,j,bi,bj)
78c96ec6a7 Jean*0348                ENDDO
                0349               ENDDO
                0350              ENDDO
                0351             ENDDO
                0352           ENDIF
353c624de2 Jean*0353 C-    apply mask (after scaling factor and rotation)
8a0f942cd7 Jean*0354           CALL EXF_FILTER_RL( uVec1, uVecMask, myThid )
                0355           CALL EXF_FILTER_RL( vVec1, vVecMask, myThid )
353c624de2 Jean*0356 
                0357 C-    end if ( first ) block
4aa4270510 Jean*0358         ENDIF
                0359 
                0360         IF (  first .OR. changed ) THEN
78c96ec6a7 Jean*0361 C--   Load and interpolate a new reccord
                0362 
8a0f942cd7 Jean*0363           CALL exf_SwapFFields( uVec0, uVec1, myThid )
                0364           CALL exf_SwapFFields( vVec0, vVec1, myThid )
4aa4270510 Jean*0365 
                0366           CALL exf_GetYearlyFieldName(
8a0f942cd7 Jean*0367      I         useExfYearlyFields, twoDigitYear, uVecPeriod, year1,
                0368      I         uVecFile,
                0369      O         uVecFile1,
4aa4270510 Jean*0370      I         myTime, myIter, myThid )
                0371           CALL exf_GetYearlyFieldName(
8a0f942cd7 Jean*0372      I         useExfYearlyFields, twoDigitYear, vVecPeriod, year1,
                0373      I         vVecFile,
                0374      O         vVecFile1,
4aa4270510 Jean*0375      I         myTime, myIter, myThid )
1fc1e2c3e5 Jean*0376           IF ( exf_debugLev.GE.debLevC ) THEN
                0377             _BEGIN_MASTER(myThid)
8a0f942cd7 Jean*0378             WRITE(msgBuf,'(6A,I10)') 'EXF_SET_UV: ',
                0379      &        'fields "', uVecName, '" & "', vVecName, '", it=', myIter
1fc1e2c3e5 Jean*0380             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
8a0f942cd7 Jean*0381      &                          SQUEEZE_RIGHT, myThid )
                0382             j = ILNBLNK(uVecFile1)
                0383             WRITE(msgBuf,'(2A,I6,3A)') 'EXF_SET_UV:   ',
                0384      &      'loading rec=', count1, ' from file: "', uVecFile1(1:j), '"'
1fc1e2c3e5 Jean*0385             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
8a0f942cd7 Jean*0386      &                          SQUEEZE_RIGHT, myThid )
                0387             j = ILNBLNK(vVecFile1)
                0388             WRITE(msgBuf,'(2A,I6,3A)') 'EXF_SET_UV:   ',
                0389      &      'loading rec=', count1, ' from file: "', vVecFile1(1:j), '"'
                0390             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0391      &                          SQUEEZE_RIGHT, myThid )
1fc1e2c3e5 Jean*0392             _END_MASTER(myThid)
                0393           ENDIF
4aa4270510 Jean*0394 
78c96ec6a7 Jean*0395           IF ( uvInterp ) THEN
                0396 C-    vector interpolation to (xC,yC) locations
                0397            CALL EXF_INTERP_UV(
8a0f942cd7 Jean*0398      I             uVecFile1, vVecFile1, exf_iprec, count1,
                0399      I             uVec_nlon, uVec_nlat,
                0400      I             uVec_lon0, uVec_lon_inc, uVec_lat0, uVec_lat_inc,
a9085e980c Jean*0401 #ifdef EXF_INTERP_USE_DYNALLOC
78c96ec6a7 Jean*0402      O             tmp_u, tmp_v,
a9085e980c Jean*0403 #else
                0404      O             tmp_u, tmp_v, bufArr1, bufArr2,
                0405 #endif
78c96ec6a7 Jean*0406      I             xC, yC,
                0407      I             u_interp_method, v_interp_method, myIter, myThid )
                0408           ELSE
                0409 C-    scalar interpolation to (xC,yC) locations
4aa4270510 Jean*0410           CALL EXF_INTERP(
8a0f942cd7 Jean*0411      I             uVecFile1, exf_iprec,
a9085e980c Jean*0412 #ifdef EXF_INTERP_USE_DYNALLOC
4aa4270510 Jean*0413      O             tmp_u,
a9085e980c Jean*0414 #else
                0415      O             tmp_u, bufArr1,
                0416 #endif
4aa4270510 Jean*0417      I             count1, xC, yC,
8a0f942cd7 Jean*0418      I             uVec_lon0, uVec_lon_inc, uVec_lat0, uVec_lat_inc,
                0419      I             uVec_nlon, uVec_nlat, u_interp_method,
78c96ec6a7 Jean*0420      I             myIter, myThid )
4aa4270510 Jean*0421           CALL EXF_INTERP(
8a0f942cd7 Jean*0422      I             vVecFile1, exf_iprec,
a9085e980c Jean*0423 #ifdef EXF_INTERP_USE_DYNALLOC
4aa4270510 Jean*0424      O             tmp_v,
a9085e980c Jean*0425 #else
                0426      O             tmp_v, bufArr2,
                0427 #endif
4aa4270510 Jean*0428      I             count1, xC, yC,
8a0f942cd7 Jean*0429      I             vVec_lon0, vVec_lon_inc, vVec_lat0, vVec_lat_inc,
                0430      I             vVec_nlon, vVec_nlat, v_interp_method,
78c96ec6a7 Jean*0431      I             myIter, myThid )
                0432           ENDIF
                0433 
353c624de2 Jean*0434 C-    apply mask: Note: done after applying scaling factor and rotation
8a0f942cd7 Jean*0435 c         CALL EXF_FILTER_RL( tmp_u, uVecMask, myThid )
                0436 c         CALL EXF_FILTER_RL( tmp_v, vVecMask, myThid )
353c624de2 Jean*0437 
                0438           IF ( exf_output_interp ) THEN
8a0f942cd7 Jean*0439            j = ILNBLNK(uVecFile1)
                0440            WRITE(out_uVecFile,'(2A)') uVecFile1(1:j), '_out'
                0441            CALL WRITE_REC_XY_RL(out_uVecFile,tmp_u,count1,myIter,myThid)
                0442            j = ILNBLNK(vVecFile1)
                0443            WRITE(out_vVecFile,'(2A)') vVecFile1(1:j), '_out'
                0444            CALL WRITE_REC_XY_RL(out_vVecFile,tmp_v,count1,myIter,myThid)
353c624de2 Jean*0445           ENDIF
63930fb278 Gael*0446 
353c624de2 Jean*0447 C-    scaling factor and vector rotation
78c96ec6a7 Jean*0448           IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
                0449             DO bj = myByLo(myThid),myByHi(myThid)
                0450              DO bi = myBxLo(myThid),myBxHi(myThid)
4aa4270510 Jean*0451               DO j = 1,sNy
78c96ec6a7 Jean*0452                DO i = 1,sNx
8a0f942cd7 Jean*0453                  tmp_u(i,j,bi,bj) = uVec_inScale*tmp_u(i,j,bi,bj)
                0454                  tmp_v(i,j,bi,bj) = vVec_inScale*tmp_v(i,j,bi,bj)
353c624de2 Jean*0455                ENDDO
                0456               ENDDO
                0457               DO j = 1,sNy
                0458                DO i = 1,sNx
95aadf3c69 Jean*0459 #ifdef EXF_USE_OLD_VEC_ROTATION
1e18bd6176 Dimi*0460                     x1=xG(i,j,bi,bj)
                0461                     x2=xG(i+1,j,bi,bj)
                0462                     x3=xG(i,j+1,bi,bj)
                0463                     x4=xG(i+1,j+1,bi,bj)
4aa4270510 Jean*0464                     IF ((x2-x1).GT.180) x2=x2-360
                0465                     IF ((x1-x2).GT.180) x2=x2+360
                0466                     IF ((x3-x1).GT.180) x3=x3-360
                0467                     IF ((x1-x3).GT.180) x3=x3+360
                0468                     IF ((x4-x1).GT.180) x4=x4-360
                0469                     IF ((x1-x4).GT.180) x4=x4+360
1e18bd6176 Dimi*0470                     y1=yG(i,j,bi,bj)
                0471                     y2=yG(i+1,j,bi,bj)
                0472                     y3=yG(i,j+1,bi,bj)
                0473                     y4=yG(i+1,j+1,bi,bj)
a7ceeb6957 Patr*0474                     dx=0.5*(x3+x4-x1-x2)
                0475                     dx=dx*
1e18bd6176 Dimi*0476      &                  cos(deg2rad*yC(i,j,bi,bj))
a7ceeb6957 Patr*0477                     dy=0.5*(y3+y4-y1-y2)
8a0f942cd7 Jean*0478                     vVec1(i,j,bi,bj)=
1e18bd6176 Dimi*0479      &                  (tmp_u(i,j,bi,bj)*dx+
                0480      &                  tmp_v(i,j,bi,bj)*dy)/
4aa4270510 Jean*0481      &                  SQRT(dx*dx+dy*dy)
a7ceeb6957 Patr*0482                     dx=0.5*(x2+x4-x1-x3)
                0483                     dx=dx*
1e18bd6176 Dimi*0484      &                  cos(deg2rad*yC(i,j,bi,bj))
a7ceeb6957 Patr*0485                     dy=0.5*(y2+y4-y1-y3)
8a0f942cd7 Jean*0486                     uVec1(i,j,bi,bj)=
1e18bd6176 Dimi*0487      &                  (tmp_u(i,j,bi,bj)*dx+
                0488      &                  tmp_v(i,j,bi,bj)*dy)/
4aa4270510 Jean*0489      &                  SQRT(dx*dx+dy*dy)
95aadf3c69 Jean*0490 #else /* EXF_USE_OLD_VEC_ROTATION */
8a0f942cd7 Jean*0491                  uVec1(i,j,bi,bj) =
95aadf3c69 Jean*0492      &                      angleCosC(i,j,bi,bj)*tmp_u(i,j,bi,bj)
                0493      &                     +angleSinC(i,j,bi,bj)*tmp_v(i,j,bi,bj)
8a0f942cd7 Jean*0494                  vVec1(i,j,bi,bj) =
95aadf3c69 Jean*0495      &                     -angleSinC(i,j,bi,bj)*tmp_u(i,j,bi,bj)
                0496      &                     +angleCosC(i,j,bi,bj)*tmp_v(i,j,bi,bj)
                0497 #endif /* EXF_USE_OLD_VEC_ROTATION */
78c96ec6a7 Jean*0498                ENDDO
4aa4270510 Jean*0499               ENDDO
78c96ec6a7 Jean*0500              ENDDO
4aa4270510 Jean*0501             ENDDO
78c96ec6a7 Jean*0502           ELSE
                0503             DO bj = myByLo(myThid),myByHi(myThid)
                0504              DO bi = myBxLo(myThid),myBxHi(myThid)
                0505               DO j = 1,sNy
                0506                DO i = 1,sNx
8a0f942cd7 Jean*0507                  uVec1(i,j,bi,bj) = uVec_inScale*tmp_u(i,j,bi,bj)
                0508                  vVec1(i,j,bi,bj) = vVec_inScale*tmp_v(i,j,bi,bj)
78c96ec6a7 Jean*0509                ENDDO
                0510               ENDDO
                0511              ENDDO
                0512             ENDDO
                0513           ENDIF
353c624de2 Jean*0514 C-    apply mask (after scaling factor and rotation)
8a0f942cd7 Jean*0515           CALL EXF_FILTER_RL( uVec1, uVecMask, myThid )
                0516           CALL EXF_FILTER_RL( vVec1, vVecMask, myThid )
353c624de2 Jean*0517 
                0518 C-    end if ( first or changed ) block
4aa4270510 Jean*0519         ENDIF
                0520 
78c96ec6a7 Jean*0521 C--   Interpolate linearly onto the current time.
4aa4270510 Jean*0522         DO bj = myByLo(myThid),myByHi(myThid)
                0523           DO bi = myBxLo(myThid),myBxHi(myThid)
                0524             DO j = 1,sNy
                0525               DO i = 1,sNx
8a0f942cd7 Jean*0526                 uVec(i,j,bi,bj) = fac * uVec0(i,j,bi,bj)
                0527      &               + (exf_one - fac)* uVec1(i,j,bi,bj)
                0528                 vVec(i,j,bi,bj) = fac * vVec0(i,j,bi,bj)
                0529      &               + (exf_one - fac)* vVec1(i,j,bi,bj)
4aa4270510 Jean*0530               ENDDO
                0531             ENDDO
                0532           ENDDO
                0533         ENDDO
8ac0e9b3ce Dimi*0534 
                0535       ELSE
78c96ec6a7 Jean*0536 C     case no-interpolation
                0537 C     or ( .NOT.usingCurvilinearGrid & .NOT.rotateGrid & .NOT.uvInterp )
4aa4270510 Jean*0538 #else  /* USE_EXF_INTERPOLATION */
                0539       IF ( .TRUE. ) THEN
                0540 #endif /* USE_EXF_INTERPOLATION */
8ac0e9b3ce Dimi*0541 
8a0f942cd7 Jean*0542         CALL EXF_SET_FLD(
                0543      I      uVecName, uVecFile, uVecMask,
                0544      I      uVecStartTime, uVecPeriod, uVecRepeatCycle,
                0545      I      uVec_inScale, uVec_remove_intercept, uVec_remove_slope,
                0546      U      uVec, uVec0, uVec1,
4aa4270510 Jean*0547 #ifdef USE_EXF_INTERPOLATION
8a0f942cd7 Jean*0548      I      uVec_lon0, uVec_lon_inc, uVec_lat0, uVec_lat_inc,
                0549      I      uVec_nlon, uVec_nlat, xC, yC, u_interp_method,
4aa4270510 Jean*0550 #endif /* USE_EXF_INTERPOLATION */
8a0f942cd7 Jean*0551      I      myTime, myIter, myThid )
4aa4270510 Jean*0552 
8a0f942cd7 Jean*0553         CALL EXF_SET_FLD(
                0554      I      vVecName, vVecFile, vVecMask,
                0555      I      vVecStartTime, vVecPeriod, vVecRepeatCycle,
                0556      I      vVec_inScale, vVec_remove_intercept, vVec_remove_slope,
                0557      U      vVec, vVec0, vVec1,
4aa4270510 Jean*0558 #ifdef USE_EXF_INTERPOLATION
8a0f942cd7 Jean*0559      I      vVec_lon0, vVec_lon_inc, vVec_lat0, vVec_lat_inc,
                0560      I      vVec_nlon, vVec_nlat, xC, yC, v_interp_method,
4aa4270510 Jean*0561 #endif /* USE_EXF_INTERPOLATION */
8a0f942cd7 Jean*0562      I      myTime, myIter, myThid )
b04d738fef Jean*0563 
63930fb278 Gael*0564 C-    vector rotation
                0565           IF ( rotateStressOnAgrid ) THEN
                0566             DO bj = myByLo(myThid),myByHi(myThid)
                0567              DO bi = myBxLo(myThid),myBxHi(myThid)
                0568               DO j = 1,sNy
                0569                DO i = 1,sNx
8a0f942cd7 Jean*0570                  tmp_u(i,j,bi,bj) = uVec(i,j,bi,bj)
                0571                  tmp_v(i,j,bi,bj) = vVec(i,j,bi,bj)
63930fb278 Gael*0572                ENDDO
                0573               ENDDO
                0574              ENDDO
                0575             ENDDO
                0576             DO bj = myByLo(myThid),myByHi(myThid)
                0577              DO bi = myBxLo(myThid),myBxHi(myThid)
                0578               DO j = 1,sNy
                0579                DO i = 1,sNx
8a0f942cd7 Jean*0580                  uVec(i,j,bi,bj) =
63930fb278 Gael*0581      &                      angleCosC(i,j,bi,bj)*tmp_u(i,j,bi,bj)
                0582      &                     +angleSinC(i,j,bi,bj)*tmp_v(i,j,bi,bj)
8a0f942cd7 Jean*0583                  vVec(i,j,bi,bj) =
63930fb278 Gael*0584      &                     -angleSinC(i,j,bi,bj)*tmp_u(i,j,bi,bj)
                0585      &                     +angleCosC(i,j,bi,bj)*tmp_v(i,j,bi,bj)
                0586                ENDDO
                0587               ENDDO
                0588              ENDDO
                0589             ENDDO
                0590           ENDIF
                0591 
8ac0e9b3ce Dimi*0592       ENDIF
                0593 
4aa4270510 Jean*0594       RETURN
                0595       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!