hs94.1x64x5/code_ad/ctrl_map_gentim2d.F

0f07f7e728 Gael*0001 #include "CTRL_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: CTRL_MAP_GENTIM2D
                0005 C     !INTERFACE:
                0006       SUBROUTINE CTRL_MAP_GENTIM2D(
                0007      I                        myTime, myIter, myThid )
                0008 C     !DESCRIPTION: \bv
                0009 C     *=============================================================*
                0010 C     | S/R  CTRL_MAP_GENTIM2D
                0011 C     *=============================================================*
a78204c019 Mart*0012 C     \ev
0f07f7e728 Gael*0013
                0014 C     !USES:
                0015       IMPLICIT NONE
                0016
                0017 C     === Global variables ===
                0018 #include "SIZE.h"
                0019 #include "EEPARAMS.h"
                0020 #include "PARAMS.h"
                0021 #include "GRID.h"
a78204c019 Mart*0022 #include "DYNVARS.h"
0f07f7e728 Gael*0023 #include "CTRL_SIZE.h"
4d72283393 Mart*0024 #include "CTRL.h"
0f07f7e728 Gael*0025 #include "CTRL_GENARR.h"
edcd27be69 Mart*0026 #include "CTRL_DUMMY.h"
0f07f7e728 Gael*0027 #ifdef ALLOW_AUTODIFF
                0028 #include "AUTODIFF_MYFIELDS.h"
                0029 #endif
                0030
                0031 C     !INPUT/OUTPUT PARAMETERS:
                0032 C     === Routine arguments ===
a78204c019 Mart*0033 C     myTime    :: Current time in simulation
                0034 C     myIter    :: Current iteration number
                0035 C     myThid    :: my Thread Id number
0f07f7e728 Gael*0036       _RL  myTime
                0037       INTEGER myIter
                0038       INTEGER myThid
                0039
a78204c019 Mart*0040 #ifdef ALLOW_GENTIM2D_CONTROL
0f07f7e728 Gael*0041 C     !LOCAL VARIABLES:
                0042 C     == Local variables ==
a78204c019 Mart*0043       INTEGER bi, bj
                0044       INTEGER i, j
                0045       INTEGER iarr
                0046       _RL xx_gentim2d_loc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0047       _RS mask2D         (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
a87570e2e8 Gael*0048       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0049       _RL LOCsumTile(nSx,nSy), LOCsumGlob
0f07f7e728 Gael*0050 CEOP
                0051
                0052 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0053
                0054 C--   generic - user-defined control vars
                0055       DO iarr = 1, maxCtrlTim2D
                0056
a78204c019 Mart*0057        IF (xx_gentim2d_weight(iarr).NE.' ') THEN
                0058
                0059         DO bj = myByLo(myThid),myByHi(myThid)
                0060          DO bi = myBxLo(myThid),myBxHi(myThid)
                0061           DO j = 1-OLy,sNy+OLy
                0062            DO i = 1-OLx,sNx+OLx
                0063             xx_gentim2d_loc(i,j,bi,bj) = 0. _d 0
                0064            ENDDO
0f07f7e728 Gael*0065           ENDDO
                0066          ENDDO
                0067         ENDDO
a78204c019 Mart*0068
                0069         CALL CTRL_GET_MASK2D( xx_gentim2d_file(iarr), mask2D, myThid )
                0070         CALL CTRL_GET_GEN (
48ef8ad28f Patr*0071      I      xx_gentim2d_file(iarr),
0f07f7e728 Gael*0072      I      xx_gentim2d_startdate(1,iarr),
                0073      I      xx_gentim2d_period(iarr),
a78204c019 Mart*0074      I      mask2D,
0f07f7e728 Gael*0075      O      xx_gentim2d_loc,
a78204c019 Mart*0076      I      xx_gentim2d0(1-OLx,1-OLy,1,1,iarr),
                0077      I      xx_gentim2d1(1-OLx,1-OLy,1,1,iarr),
0f07f7e728 Gael*0078      I      xx_gentim2d_dummy(iarr),
                0079      I      zeroRL, zeroRL,
a78204c019 Mart*0080      I      wgentim2d(1-OLx,1-OLy,1,1,iarr),
                0081      I      myTime, myIter, myThid )
                0082
                0083         IF (xx_gentim2d_cumsum(iarr)) THEN
                0084          DO bj=myByLo(myThid),myByHi(myThid)
                0085           DO bi=myBxLo(myThid),myBxHi(myThid)
                0086            DO j = 1,sNy
                0087             DO i = 1,sNx
                0088              xx_gentim2d(i,j,bi,bj,iarr)=xx_gentim2d(i,j,bi,bj,iarr)
                0089      &            + xx_gentim2d_loc(i,j,bi,bj)
                0090             ENDDO
                0091            ENDDO
a87570e2e8 Gael*0092           ENDDO
                0093          ENDDO
a78204c019 Mart*0094         ELSE
                0095          DO bj=myByLo(myThid),myByHi(myThid)
                0096           DO bi=myBxLo(myThid),myBxHi(myThid)
                0097            DO j = 1,sNy
                0098             DO i = 1,sNx
                0099              xx_gentim2d(i,j,bi,bj,iarr)=xx_gentim2d_loc(i,j,bi,bj)
                0100             ENDDO
                0101            ENDDO
                0102           ENDDO
                0103          ENDDO
                0104         ENDIF
                0105
                0106         IF (xx_gentim2d_glosum(iarr)) THEN
                0107
                0108          DO bj=myByLo(myThid),myByHi(myThid)
                0109           DO bi=myBxLo(myThid),myBxHi(myThid)
                0110            LOCsumTile(bi,bj)=0. _d 0
                0111            DO j = 1,sNy
                0112             DO i = 1,sNx
                0113              LOCsumTile(bi,bj) = LOCsumTile(bi,bj)
                0114      &          + xx_gentim2d(i,j,bi,bj,iarr)*rA(i,j,bi,bj)
                0115      &           *maskC(i,j,1,bi,bj)*maskInC(i,j,bi,bj)
                0116             ENDDO
                0117            ENDDO
                0118           ENDDO
                0119          ENDDO
                0120
                0121          CALL GLOBAL_SUM_TILE_RL( LOCsumTile, LOCsumGlob, myThid )
                0122
                0123          LOCsumGlob = LOCsumGlob/globalArea
                0124          DO bj = myByLo(myThid),myByHi(myThid)
                0125           DO bi = myBxLo(myThid),myBxHi(myThid)
                0126            DO j = 1-OLy,sNy+OLy
                0127             DO i = 1-OLx,sNx+OLx
                0128              xx_gentim2d(i,j,bi,bj,iarr) =
                0129      &                   LOCsumGlob*maskC(i,j,1,bi,bj)
                0130             ENDDO
                0131            ENDDO
                0132           ENDDO
                0133          ENDDO
                0134
                0135          IF (xx_gentim2d_file(iarr).EQ.'xx_gen_precip') THEN
                0136
                0137           WRITE(msgBuf,'(A,I6,A,1PE21.14)')
                0138      &         ' iter=', myIter, ' ; genprecipGloH= ',
                0139      &         LOCsumGlob*rhoConstFresh*recip_rhoConst*deltaTClock
                0140           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0141      &                        SQUEEZE_RIGHT, myThid )
a87570e2e8 Gael*0142
a78204c019 Mart*0143          ENDIF !IF (xx_gentim2d_file(iarr).EQ.'xx_gen_precip') THEN
                0144
                0145 C---  begin customized code for experiment hs94.1x64x5:
a87570e2e8 Gael*0146          WRITE(msgBuf,'(A,I6,A,I6,A,1PE21.14)') ' xx_gentim2d ',
a78204c019 Mart*0147      &    iarr,' : iter=', myIter, ' ; global sum = ', LOCsumGlob
a87570e2e8 Gael*0148          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0149      &                       SQUEEZE_RIGHT, myThid )
a78204c019 Mart*0150 C---  end customized code
                0151
                0152         ENDIF !IF (xx_gentim2d_glosum(iarr)) THEN
                0153
                0154 C---  begin customized code for experiment hs94.1x64x5:
                0155         IF (iarr.EQ.1) THEN
                0156          DO bj = myByLo(myThid), myByHi(myThid)
                0157           DO bi = myBxLo(myThid), myBxHi(myThid)
                0158            DO j = 1-OLy,sNy+OLy
                0159             DO i = 1-OLx,sNx+OLx
                0160              theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
                0161      &                          + xx_gentim2d(i,j,bi,bj,iarr)
                0162             ENDDO
                0163            ENDDO
0f07f7e728 Gael*0164           ENDDO
                0165          ENDDO
a78204c019 Mart*0166         ENDIF
                0167 C---  end customized code
                0168
                0169        ENDIF !IF (xx_gentim2d_weight(iarr).NE.' ') THEN
0f07f7e728 Gael*0170
a78204c019 Mart*0171       ENDDO !DO iarr = 1, maxCtrlTim2D
0f07f7e728 Gael*0172
                0173 #endif /* ALLOW_GENTIM2D_CONTROL */
                0174
                0175       RETURN
                0176       END