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