pkg/ebm/ebm_area_t.F

d8206d87ee Patr*0001 #include "EBM_OPTIONS.h"
4e4ad91a39 Jean*0002 #ifdef ALLOW_AUTODIFF
                0003 # include "AUTODIFF_OPTIONS.h"
                0004 #endif
d8206d87ee Patr*0005
b57c3ad53e Jean*0006 CBOP 0
                0007 C !ROUTINE: EBM_AREA_T
                0008
                0009 C !INTERFACE:
d8206d87ee Patr*0010       SUBROUTINE EBM_AREA_T( myTime, myIter, myThid )
                0011
b57c3ad53e Jean*0012 C     !DESCRIPTION:
                0013 C     *==========================================================*
                0014 C     | CALCULATE MEAN TEMPERATURE OVER 4 LAT. BAND
                0015 C     *==========================================================*
d8206d87ee Patr*0016
b57c3ad53e Jean*0017 C     !USES:
                0018       IMPLICIT NONE
d8206d87ee Patr*0019 C     === Global variables ===
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "GRID.h"
b57c3ad53e Jean*0024 #include "DYNVARS.h"
                0025 #include "FFIELDS.h"
d8206d87ee Patr*0026 #ifdef ALLOW_EBM
                0027 # include "EBM.h"
                0028 #endif
b08554040b Patr*0029 #ifdef ALLOW_AUTODIFF_TAMC
                0030 # include "tamc.h"
                0031 #endif
d8206d87ee Patr*0032
b57c3ad53e Jean*0033 C     !INPUT PARAMETERS:
                0034 C     myThid     :: my Thread Id number
d8206d87ee Patr*0035       _RL myTime
b57c3ad53e Jean*0036       INTEGER myIter
                0037       INTEGER myThid
                0038 CEOP
d8206d87ee Patr*0039
                0040 #ifdef ALLOW_EBM
b57c3ad53e Jean*0041 C     !LOCAL VARIABLES:
                0042 C     i, j, k  :: Loop counters
d8206d87ee Patr*0043       INTEGER i, j, k, bi, bj
                0044       _RL TmlS_tile(nSx, nSy)
                0045       _RL TmlN_tile(nSx, nSy)
                0046       _RL TtS_tile(nSx, nSy)
                0047       _RL TtN_tile(nSx, nSy)
                0048       _RL CountmlS_tile(nSx, nSy)
                0049       _RL CountmlN_tile(nSx, nSy)
                0050       _RL CounttS_tile(nSx, nSy)
                0051       _RL CounttN_tile(nSx, nSy)
                0052       _RL CountmlS
                0053       _RL CountmlN
                0054       _RL CounttS
                0055       _RL CounttN
                0056
                0057 C--   Top layer only
                0058       k = 1
                0059
                0060       DO bj=myByLo(myThid),myByHi(myThid)
                0061        DO bi=myBxLo(myThid),myBxHi(myThid)
                0062
b57c3ad53e Jean*0063         TmlS_tile(bi,bj) = 0.
                0064         TmlN_tile(bi,bj) = 0.
                0065         TtS_tile(bi,bj) = 0.
                0066         TtN_tile(bi,bj) = 0.
                0067         CountmlS_tile(bi,bj) = 0.
                0068         CountmlN_tile(bi,bj) = 0.
                0069         CounttS_tile(bi,bj) = 0.
                0070         CounttN_tile(bi,bj) = 0.
                0071
d8206d87ee Patr*0072 C--   Calculate sum of temperatures over each tile
                0073         DO j = 1,sNy
                0074          DO i = 1, sNx
b57c3ad53e Jean*0075           IF ( yC(i,j,bi,bj) .GE. -latBnd(3) .AND.
                0076      &         yC(i,j,bi,bj) .LE. -latBnd(2) ) THEN
                0077             TmlS_tile(bi,bj) = TmlS_tile(bi,bj)
                0078      &                       + maskC(i,j,k,bi,bj)*theta(i,j,k,bi,bj)
                0079             CountmlS_tile(bi,bj) = CountmlS_tile(bi,bj)
                0080      &                       + maskC(i,j,k,bi,bj)
                0081           ELSEIF ( yC(i,j,bi,bj) .GT. -latBnd(2) .AND.
                0082      &             yC(i,j,bi,bj) .LT. -latBnd(1) ) THEN
                0083             TtS_tile(bi,bj) = TtS_tile(bi,bj)
                0084      &                       + maskC(i,j,k,bi,bj)*theta(i,j,k,bi,bj)
                0085             CounttS_tile(bi,bj) = CounttS_tile(bi,bj)
                0086      &                       + maskC(i,j,k,bi,bj)
                0087           ELSEIF ( yC(i,j,bi,bj) .GT. latBnd(1) .AND.
                0088      &             yC(i,j,bi,bj) .LT. latBnd(2) ) THEN
                0089             TtN_tile(bi,bj) = TtN_tile(bi,bj)
                0090      &                       + maskC(i,j,k,bi,bj)*theta(i,j,k,bi,bj)
                0091             CounttN_tile(bi,bj) = CounttN_tile(bi,bj)
                0092      &                       + maskC(i,j,k,bi,bj)
                0093           ELSEIF ( yC(i,j,bi,bj) .GE. latBnd(2) .AND.
                0094      &             yC(i,j,bi,bj) .LT. latBnd(3) ) THEN
                0095             TmlN_tile(bi,bj) = TmlN_tile(bi,bj)
                0096      &                       + maskC(i,j,k,bi,bj)*theta(i,j,k,bi,bj)
                0097             CountmlN_tile(bi,bj) = CountmlN_tile(bi,bj)
                0098      &                       + maskC(i,j,k,bi,bj)
                0099           ENDIF
d8206d87ee Patr*0100          ENDDO
                0101         ENDDO
                0102
                0103        ENDDO
                0104       ENDDO
                0105
b57c3ad53e Jean*0106       CALL GLOBAL_SUM_TILE_RL( TmlS_tile, TmlS, myThid )
                0107       CALL GLOBAL_SUM_TILE_RL( TmlN_tile, TmlN, myThid )
                0108       CALL GLOBAL_SUM_TILE_RL( TtS_tile,  TtS,  myThid )
                0109       CALL GLOBAL_SUM_TILE_RL( TtN_tile,  TtN,  myThid )
                0110
                0111       CALL GLOBAL_SUM_TILE_RL( CountmlS_tile, CountmlS, myThid )
                0112       CALL GLOBAL_SUM_TILE_RL( CountmlN_tile, CountmlN, myThid )
                0113       CALL GLOBAL_SUM_TILE_RL( CounttS_tile,  CounttS,  myThid )
                0114       CALL GLOBAL_SUM_TILE_RL( CounttN_tile,  CounttN,  myThid )
4e8c9bded2 Patr*0115
b08554040b Patr*0116 #ifdef ALLOW_AUTODIFF_TAMC
                0117 CADJ STORE CountmlS = comlev1, key = ikey_dynamics
                0118 CADJ STORE CountmlN = comlev1, key = ikey_dynamics
                0119 CADJ STORE CounttS  = comlev1, key = ikey_dynamics
                0120 CADJ STORE CounttN  = comlev1, key = ikey_dynamics
                0121 #endif
b57c3ad53e Jean*0122       _BEGIN_MASTER(myThid)
                0123       IF ( CountmlS .NE. 0.) TmlS = TmlS/CountmlS
                0124       IF ( CountmlN .NE. 0.) TmlN = TmlN/CountmlN
                0125       IF ( CounttS  .NE. 0.) TtS  = TtS /CounttS
                0126       IF ( CounttN  .NE. 0.) TtN  = TtN /CounttN
                0127       TmlS = TmlS + t_mlt
                0128       TmlN = TmlN + t_mlt
                0129       TtS  = TtS  + t_mlt
                0130       TtN  = TtN  + t_mlt
                0131       _END_MASTER(myThid)
                0132       _BARRIER
4e8c9bded2 Patr*0133
d8206d87ee Patr*0134 #endif /* ALLOW_EBM */
                0135
                0136       RETURN
                0137       END