pkg/ctrl/ctrl_map_gentim2d.F

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