pkg/thsice/thsice_balance_frw.F

de836be2bc Jean*0001 #include "THSICE_OPTIONS.h"
a85293d087 Mart*0002 #ifdef ALLOW_AUTODIFF
                0003 # include "AUTODIFF_OPTIONS.h"
                0004 #endif
de836be2bc Jean*0005
                0006 CBOP
                0007 C     !ROUTINE: THSICE_BALANCE_FRW
                0008 C     !INTERFACE:
                0009       SUBROUTINE THSICE_BALANCE_FRW(
                0010      I                          iMin, iMax, jMin, jMax,
                0011      I                          prcAtm, myTime, myIter, myThid )
                0012
                0013 C     !DESCRIPTION: \bv
                0014 C     *==========================================================*
                0015 C     | SUBROUTINE THSICE_BALANCE_FRW
                0016 C     | o Correct ocean fresh-water forcing for global imbalance
                0017 C     |   of Atmos+Land fresh-water flux
                0018 C     *==========================================================*
                0019 C     \ev
                0020 C     !USES:
                0021       IMPLICIT NONE
                0022
                0023 C     === Global variables ===
                0024 #include "SIZE.h"
                0025 #include "EEPARAMS.h"
                0026 #include "PARAMS.h"
                0027 #include "GRID.h"
                0028 #include "FFIELDS.h"
                0029 #include "THSICE_SIZE.h"
                0030 #include "THSICE_PARAMS.h"
                0031 #include "THSICE_VARS.h"
a85293d087 Mart*0032 #ifdef ALLOW_AUTODIFF_TAMC
                0033 # include "tamc.h"
                0034 #endif
de836be2bc Jean*0035
                0036 C     !INPUT/OUTPUT PARAMETERS:
                0037 C     iMin,iMax :: computation domain: 1rst index range
                0038 C     jMin,jMax :: computation domain: 2nd  index range
                0039 C     prcAtm    :: precip (+RunOff) from Atmos+Land
                0040 C     myTime    :: Current time in simulation (s)
                0041 C     myIter    :: Current iteration number
                0042 C     myThid    :: My Thread Id. number
                0043       INTEGER iMin, iMax
                0044       INTEGER jMin, jMax
                0045       _RL prcAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0046       _RL     myTime
                0047       INTEGER myIter
                0048       INTEGER myThid
                0049 CEOP
                0050
                0051 #ifdef ALLOW_BALANCE_FLUXES
                0052 C     !LOCAL VARIABLES:
                0053 C     bi,bj     :: Tile indices
                0054 C     i, j      :: loop indices
                0055       INTEGER bi,bj
                0056       INTEGER i, j
                0057       _RL sumPrc, sumTilePrc(nSx,nSy)
                0058       _RL sumFrW, sumTileFrW(nSx,nSy)
                0059       _RL tmpFac, tmpVar
                0060
                0061 C--   Calculate and global-mean precip (+RunOff)
                0062 C     and global-mean imbalance of net Atmos Fresh-Water flux
a85293d087 Mart*0063 #ifdef ALLOW_AUTODIFF_TAMC
                0064 C     It is important to store these fields here so that in s/r
                0065 C     thsice_main_ad the entire timestep does not get recomputed just to
                0066 C     produce these two fields.
                0067 CADJ STORE icFrwAtm = comlev1, key = ikey_dynamics, kind = isbyte
                0068 CADJ STORE prcAtm   = comlev1, key = ikey_dynamics, kind = isbyte
                0069 #endif
de836be2bc Jean*0070       IF ( thSIceBalanceAtmFW.NE.0 ) THEN
                0071
                0072         DO bj=myByLo(myThid),myByHi(myThid)
                0073          DO bi=myBxLo(myThid),myBxHi(myThid)
                0074           sumTilePrc(bi,bj) = 0. _d 0
                0075           sumTileFrW(bi,bj) = 0. _d 0
                0076           DO j = 1,sNy
                0077            DO i = 1,sNx
                0078             sumTilePrc(bi,bj) = sumTilePrc(bi,bj)
                0079      &                        + MAX( prcAtm(i,j,bi,bj), zeroRL )
                0080      &                         *rA(i,j,bi,bj)*maskInC(i,j,bi,bj)
                0081             sumTileFrW(bi,bj) = sumTileFrW(bi,bj)
                0082      &                        + icFrwAtm(i,j,bi,bj)
                0083      &                         *rA(i,j,bi,bj)*maskInC(i,j,bi,bj)
                0084            ENDDO
                0085           ENDDO
                0086          ENDDO
                0087         ENDDO
                0088         sumPrc = 0. _d 0
                0089         IF ( thSIceBalanceAtmFW.EQ.2 )
                0090      &  CALL GLOBAL_SUM_TILE_RL( sumTilePrc, sumPrc, myThid )
                0091         CALL GLOBAL_SUM_TILE_RL( sumTileFrW, sumFrW, myThid )
                0092
                0093         IF ( globalArea.GT.0. _d 0 ) THEN
                0094           sumPrc = sumPrc / globalArea
                0095           sumFrW = sumFrW / globalArea
                0096         ENDIF
                0097
                0098 C-    save amount of correction (for diagnostics)
                0099         _BEGIN_MASTER(myThid)
                0100         adjustFrW = -sumFrW
                0101         _END_MASTER(myThid)
                0102
                0103       ENDIF
                0104
                0105       IF     ( thSIceBalanceAtmFW.EQ.1 ) THEN
                0106 C--   Apply uniform correction to Ocean FW Forcing (+ Atm-Flux, for diagnostics)
                0107         DO bj=myByLo(myThid),myByHi(myThid)
                0108          DO bi=myBxLo(myThid),myBxHi(myThid)
                0109           DO j = jMin,jMax
                0110            DO i = iMin,iMax
                0111              icFrwAtm(i,j,bi,bj) = icFrwAtm(i,j,bi,bj)
                0112      &                           - sumFrW*maskInC(i,j,bi,bj)
                0113              EmPmR(i,j,bi,bj)    = EmPmR(i,j,bi,bj)
                0114      &                           - sumFrW*maskInC(i,j,bi,bj)
                0115            ENDDO
                0116           ENDDO
                0117          ENDDO
                0118         ENDDO
                0119
                0120       ELSEIF ( thSIceBalanceAtmFW.EQ.2 ) THEN
                0121 C--   Scale correction by local precip and apply it to Ocean FW Forcing
                0122 C      (+ Atm-Flux, for diagnostics)
                0123         IF ( sumPrc.GT.0. _d 0 ) THEN
                0124           tmpFac = sumFrW / sumPrc
                0125         ELSE
                0126           tmpFac = 0.
                0127           _BEGIN_MASTER(myThid)
                0128           adjustFrW = 0. _d 0
                0129           _END_MASTER(myThid)
                0130         ENDIF
                0131         DO bj=myByLo(myThid),myByHi(myThid)
                0132          DO bi=myBxLo(myThid),myBxHi(myThid)
                0133           DO j = jMin,jMax
                0134            DO i = iMin,iMax
                0135              tmpVar = tmpFac*MAX( prcAtm(i,j,bi,bj), zeroRL )
                0136      &                      *maskInC(i,j,bi,bj)
                0137              icFrwAtm(i,j,bi,bj) = icFrwAtm(i,j,bi,bj) - tmpVar
                0138              EmPmR(i,j,bi,bj)    = EmPmR(i,j,bi,bj)    - tmpVar
                0139            ENDDO
                0140           ENDDO
                0141          ENDDO
                0142         ENDDO
                0143
                0144       ELSEIF ( thSIceBalanceAtmFW.NE.0 ) THEN
                0145         STOP
                0146      &  'ABNORMAL END: THSICE_BALANCE_FRW: invalid thSIceBalanceAtmFW'
                0147       ENDIF
                0148
                0149 #endif /* ALLOW_BALANCE_FLUXES */
                0150
                0151       RETURN
                0152       END