pkg/atm_compon_interf/atm_store_aim_wndstr.F

3fd4b811ee Jean*0001 #include "ATM_CPL_OPTIONS.h"
12983a4149 Jean*0002 #ifdef ALLOW_AIM
                0003 # include "AIM_OPTIONS.h"
                0004 #endif
                0005
                0006 CBOP
                0007 C     !ROUTINE: ATM_STORE_AIM_WNDSTR
                0008 C     !INTERFACE:
                0009       SUBROUTINE ATM_STORE_AIM_WNDSTR(
                0010      I                     bi, bj,
                0011      I                     myTime, myIter, myThid )
                0012
                0013 C     !DESCRIPTION: \bv
                0014 C     *==========================================================*
                0015 C     | SUBROUTINE ATM_STORE_AIM_WNDSTR
                0016 C     | o Routine for saving AIM surface wind-stress fields
                0017 C     |   for export to coupling layer.
                0018 C     *==========================================================*
                0019 C     | This version interfaces to the AIM package.
                0020 C     *==========================================================*
                0021
                0022 C     !USES:
                0023       IMPLICIT NONE
                0024
                0025 C     == Global variables ==
                0026 #ifdef ALLOW_AIM
                0027 # include "AIM_SIZE.h"
                0028 #else
                0029 # include "SIZE.h"
                0030 #endif
                0031
                0032 #include "EEPARAMS.h"
                0033 #include "PARAMS.h"
                0034 #include "CPL_PARAMS.h"
                0035 #include "GRID.h"
                0036 #include "DYNVARS.h"
                0037 #ifdef ALLOW_AIM
                0038 # include "AIM2DYN.h"
                0039 c #include "AIM_FFIELDS.h"
                0040 #endif
                0041 #ifdef ALLOW_THSICE
                0042 # include "THSICE_PARAMS.h"
                0043 # include "THSICE_VARS.h"
                0044 #endif
                0045 C     == Global variables for coupling interface ==
                0046 #include "ATMCPL.h"
                0047
                0048 C     !INPUT/OUTPUT PARAMETERS:
                0049 C     bi, bj    :: Tile indices
                0050 C     myTime    :: Current time in simulation (s)
                0051 C     myIter    :: Current iteration number
                0052 C     myThid    :: My Thread Id. number
                0053       INTEGER bi, bj
                0054       _RL     myTime
                0055       INTEGER myIter
                0056       INTEGER myThid
                0057 CEOP
                0058
                0059 #ifdef ALLOW_AIM
                0060 C     !LOCAL VARIABLES:
                0061 C     i, j      :: Loop counters
                0062 C     ks        :: surface level index
                0063       INTEGER i, j, ks
                0064       _RL cplTimeFraction
                0065       _RL uStr_tmp, vStr_tmp
                0066
                0067 C     o Accumulate momentum surface flux that will be exported to the
                0068 C       coupling layer. Momentum flux is in N/m^2 with same sign as the wind.
                0069        cplTimeFraction = 1. _d 0 / DFLOAT(cplSendFrq_iter)
                0070        ks = 1
                0071
                0072        tauXTime(bi,bj) = tauXTime(bi,bj) + cplTimeFraction
                0073        tauYTime(bi,bj) = tauYTime(bi,bj) + cplTimeFraction
                0074 #ifdef ALLOW_THSICE
                0075       IF ( useThSIce .AND. stressReduction.GT. 0. _d 0 ) THEN
                0076 C--   Reduce wind stress applied to ocean where sea-ice is present
                0077        DO j=1,sNy
                0078         DO i=1,sNx
                0079 c         IF ( aim_landFr(i-1,j,bi,bj)*aim_landFr(i,j,bi,bj) .NE. 1. ) THEN
                0080           IF ( hFacW(i,j,ks,bi,bj) .NE. 0. ) THEN
                0081            uStr_tmp =
                0082      &      ( aim_drag(i-1,j,bi,bj)
                0083      &       *(1. _d 0 - iceMask(i-1,j,bi,bj)*stressReduction)
                0084      &      + aim_drag( i ,j,bi,bj)
                0085      &       *(1. _d 0 - iceMask( i ,j,bi,bj)*stressReduction)
                0086      &      )* 0.5 _d 0 * uVel(i,j,ks,bi,bj)
                0087            tauX(i,j,bi,bj) = tauX(i,j,bi,bj)
                0088      &                     + uStr_tmp*cplTimeFraction
                0089           ENDIF
                0090         ENDDO
                0091        ENDDO
                0092        DO j=1,sNy
                0093         DO i=1,sNx
                0094 c         IF ( aim_landFr(i,j-1,bi,bj)*aim_landFr(i,j,bi,bj) .NE. 1. ) THEN
                0095           IF ( hFacS(i,j,ks,bi,bj) .NE. 0. ) THEN
                0096            vStr_tmp =
                0097      &      ( aim_drag(i,j-1,bi,bj)
                0098      &       *(1. _d 0 - iceMask(i,j-1,bi,bj)*stressReduction)
                0099      &      + aim_drag(i, j ,bi,bj)
                0100      &       *(1. _d 0 - iceMask(i, j ,bi,bj)*stressReduction)
                0101      &      )* 0.5 _d 0 * vVel(i,j,ks,bi,bj)
                0102            tauY(i,j,bi,bj) = tauY(i,j,bi,bj)
                0103      &                     + vStr_tmp*cplTimeFraction
                0104           ENDIF
                0105         ENDDO
                0106        ENDDO
                0107       ELSE
                0108 #else  /*ALLOW_THSICE*/
                0109       IF (.TRUE.) THEN
                0110 #endif  /*ALLOW_THSICE*/
                0111        DO j=1,sNy
                0112         DO i=1,sNx
                0113 c         IF ( aim_landFr(i-1,j,bi,bj)*aim_landFr(i,j,bi,bj) .NE. 1. ) THEN
                0114           IF ( hFacW(i,j,ks,bi,bj) .NE. 0. ) THEN
                0115            uStr_tmp =
                0116      &      ( aim_drag(i-1,j,bi,bj)+aim_drag(i,j,bi,bj) )
                0117      &       * 0.5 _d 0 * uVel(i,j,ks,bi,bj)
                0118            tauX(i,j,bi,bj) = tauX(i,j,bi,bj)
                0119      &                     + uStr_tmp*cplTimeFraction
                0120           ENDIF
                0121         ENDDO
                0122        ENDDO
                0123        DO j=1,sNy
                0124         DO i=1,sNx
                0125 c         IF ( aim_landFr(i,j-1,bi,bj)*aim_landFr(i,j,bi,bj) .NE. 1. ) THEN
                0126           IF ( hFacS(i,j,ks,bi,bj) .NE. 0. ) THEN
                0127            vStr_tmp =
                0128      &      ( aim_drag(i,j-1,bi,bj)+aim_drag(i,j,bi,bj) )
                0129      &       * 0.5 _d 0 * vVel(i,j,ks,bi,bj)
                0130            tauY(i,j,bi,bj) = tauY(i,j,bi,bj)
                0131      &                     + vStr_tmp*cplTimeFraction
                0132           ENDIF
                0133         ENDDO
                0134        ENDDO
                0135       ENDIF
                0136
                0137 #endif /* ALLOW_AIM */
                0138
                0139       RETURN
                0140       END