pkg/offline/offline_get_diffus.F

3d0bd4bc5c Jean*0001 #include "OFFLINE_OPTIONS.h"
                0002 #ifdef ALLOW_DIC
23606e3448 Jean*0003 # include "DIC_OPTIONS.h"
3d0bd4bc5c Jean*0004 #endif
                0005 #ifdef ALLOW_DARWIN
23606e3448 Jean*0006 # include "DARWIN_OPTIONS.h"
                0007 #endif
                0008 #ifdef ALLOW_GMREDI
                0009 # include "GMREDI_OPTIONS.h"
3d0bd4bc5c Jean*0010 #endif
                0011
                0012 CBOP
                0013 C     !ROUTINE: OFFLINE_GET_SURFFORCING
                0014 C     !INTERFACE:
                0015       SUBROUTINE OFFLINE_GET_DIFFUS( myTime, myIter, myThid )
                0016
                0017 C     !DESCRIPTION: \bv
                0018 C     *==========================================================*
                0019 C     | SUBROUTINE OFFLINE_GET_DIFFUS
                0020 C     | o Interpolate in time diffusivity fields that have
                0021 C     |   been loaded from file
                0022 C     *==========================================================*
                0023 C     *==========================================================*
                0024 C     \ev
                0025
                0026 C     !USES:
                0027       IMPLICIT NONE
                0028 C     === Global variables ===
                0029 #include "SIZE.h"
                0030 #include "EEPARAMS.h"
                0031 #include "PARAMS.h"
                0032 #include "DYNVARS.h"
                0033 #include "FFIELDS.h"
                0034 #include "OFFLINE.h"
                0035 #include "OFFLINE_SWITCH.h"
                0036 #ifdef ALLOW_GMREDI
                0037 # include "GMREDI.h"
                0038 #endif
                0039 #ifdef ALLOW_KPP
                0040 # include "KPP.h"
                0041 #endif
                0042
                0043 C     !INPUT/OUTPUT PARAMETERS:
                0044 C     === Routine arguments ===
                0045 C     myTime  :: current time in simulation
                0046 C     myIter  :: current iteration number in simulation
                0047 C     myThid  :: my Thread Id number
                0048       _RL     myTime
                0049       INTEGER myIter
                0050       INTEGER myThid
                0051 CEOP
                0052
                0053 C     !LOCAL VARIABLES:
                0054       INTEGER i,j,k
                0055       INTEGER bi,bj
                0056       _RL aWght, bWght
                0057 #ifdef ALLOW_AUTODIFF
                0058       _RL locTime
                0059       INTEGER intimeP, intime0, intime1
                0060 #endif /* ALLOW_AUTODIFF */
                0061
                0062 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0063
                0064 #ifdef ALLOW_AUTODIFF
                0065 C--   Re-compute the weights (bWght, aWght) to simplify dependencies
                0066 C     (since they are not stored on tapes)
                0067       locTime = myTime - offlineTimeOffset
                0068       CALL GET_PERIODIC_INTERVAL(
                0069      O                  intimeP, intime0, intime1, bWght, aWght,
                0070      I                  offlineForcingCycle, offlineForcingPeriod,
                0071      I                  deltaToffline, locTime, myThid )
                0072 #endif /* ALLOW_AUTODIFF */
                0073
                0074 C--   Interpolate Diffusivity Components:
                0075       DO bj = myByLo(myThid), myByHi(myThid)
                0076        DO bi = myBxLo(myThid), myBxHi(myThid)
                0077 #ifndef ALLOW_AUTODIFF
                0078         bWght = offline_Wght(1,bi,bj)
                0079         aWght = offline_Wght(2,bi,bj)
                0080 #endif /* ndef ALLOW_AUTODIFF */
                0081
84599ea301 Jean*0082         IF ( Wvelfile .NE. ' '  .AND. myIter.EQ.nIter0 ) THEN
                0083          DO k=1,Nr
                0084           DO j=1-OLy,sNy+OLy
                0085            DO i=1-OLx,sNx+OLx
                0086             wVel(i,j,k,bi,bj) = bWght*wvel0(i,j,k,bi,bj)
                0087      &                        + aWght*wvel1(i,j,k,bi,bj)
                0088            ENDDO
                0089           ENDDO
                0090          ENDDO
                0091         ENDIF
3d0bd4bc5c Jean*0092         IF ( offlineLoadConvec ) THEN
                0093          DO k=1,Nr
                0094           DO j=1-OLy,sNy+OLy
                0095            DO i=1-OLx,sNx+OLx
                0096             IVDConvCount(i,j,k,bi,bj) = bWght*conv0(i,j,k,bi,bj)
                0097      &                                + aWght*conv1(i,j,k,bi,bj)
                0098            ENDDO
                0099           ENDDO
                0100          ENDDO
                0101         ENDIF
                0102 #ifdef ALLOW_GMREDI
                0103         IF ( offlineLoadGMRedi ) THEN
                0104          DO k=1,Nr
                0105           DO j=1-OLy,sNy+OLy
                0106            DO i=1-OLx,sNx+OLx
                0107             Kwx(i,j,k,bi,bj)  = bWght*gmkx0(i,j,k,bi,bj)
                0108      &                        + aWght*gmkx1(i,j,k,bi,bj)
                0109             Kwy(i,j,k,bi,bj)  = bWght*gmky0(i,j,k,bi,bj)
                0110      &                        + aWght*gmky1(i,j,k,bi,bj)
                0111             Kwz(i,j,k,bi,bj)  = bWght*gmkz0(i,j,k,bi,bj)
                0112      &                        + aWght*gmkz1(i,j,k,bi,bj)
23606e3448 Jean*0113 #ifndef GM_NON_UNITY_DIAGONAL
                0114             Kux(i,j,k,bi,bj) = GM_isopycK
                0115             Kvy(i,j,k,bi,bj) = GM_isopycK
                0116 #endif
3d0bd4bc5c Jean*0117            ENDDO
                0118           ENDDO
                0119          ENDDO
                0120         ENDIF
23606e3448 Jean*0121 #endif /* ALLOW_GMREDI */
3d0bd4bc5c Jean*0122 #ifdef ALLOW_KPP
                0123         IF ( offlineLoadKPP ) THEN
                0124          DO k=1,Nr
                0125           DO j=1-OLy,sNy+OLy
                0126            DO i=1-OLx,sNx+OLx
                0127             KPPdiffKzS(i,j,k,bi,bj) = bWght*kdfs0(i,j,k,bi,bj)
                0128      &                              + aWght*kdfs1(i,j,k,bi,bj)
                0129 C-- Note: for convenience, the array KPPghat will contain
                0130 C         the product ghat*diffKzS (and not ghat alone).
                0131             KPPghat(i,j,k,bi,bj) = bWght*kght0(i,j,k,bi,bj)
                0132      &                           + aWght*kght1(i,j,k,bi,bj)
                0133            ENDDO
                0134           ENDDO
                0135          ENDDO
                0136         ENDIF
23606e3448 Jean*0137 #endif /* ALLOW_KPP */
3d0bd4bc5c Jean*0138
                0139 C--   Interpolate surface forcing
                0140 #if ( (defined ALLOW_DIC) || (defined ALLOW_DARWIN) )
                0141 #ifdef ALLOW_OLD_VIRTUALFLUX
                0142         IF ( SFluxFile.NE.' ' ) THEN
                0143           DO j=1-OLy,sNy+OLy
                0144            DO i=1-OLx,sNx+OLx
                0145             surfaceForcingS(i,j,bi,bj) = bWght*sflx0(i,j,bi,bj)
                0146      &                                 + aWght*sflx1(i,j,bi,bj)
                0147             surfaceForcingS(i,j,bi,bj) = surfaceForcingS(i,j,bi,bj)
                0148      &                                  *mass2rUnit
                0149            ENDDO
                0150           ENDDO
                0151         ENDIF
                0152 #endif /* ALLOW_OLD_VIRTUALFLUX */
                0153 #endif /* ALLOW_DIC or ALLOW_DARWIN */
                0154
                0155 C--    kept from older version:
                0156 c           surfaceForcingT(i,j,bi,bj) = bWght*hflx0(i,j,bi,bj)
                0157 c    &                                 + aWght*hflx1(i,j,bi,bj)
                0158 c           surfaceForcingT(i,j,bi,bj) = surfaceForcingT(i,j,bi,bj)
                0159 c    &                         *recip_Cp*mass2rUnit
                0160 c           ICEM(i,j,bi,bj) = bWght*icem0(i,j,bi,bj)
                0161 c    &                      + aWght*icem1(i,j,bi,bj)
                0162
                0163 C--   end bi,bj loops
                0164        ENDDO
                0165       ENDDO
                0166
                0167       RETURN
                0168       END