File indexing completed on 2023-10-13 05:10:15 UTC
view on githubraw file Latest commit edcd27be on 2023-10-12 20:00:12 UTC
7bd66d7dc3 Patr*0001 #include "CTRL_OPTIONS.h"
0002
0003
0004
0005
0006 SUBROUTINE CTRL_MAP_GENTIM2D(
0007 I myTime, myIter, myThid )
0008
0009
0010
0011
a78204c019 Mart*0012
7bd66d7dc3 Patr*0013
0014
0015 IMPLICIT NONE
0016
0017
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 #ifdef ALLOW_AUTODIFF
0027 #include "AUTODIFF_MYFIELDS.h"
0028 #endif
0029
0030
0031
a78204c019 Mart*0032
0033
0034
7bd66d7dc3 Patr*0035 _RL myTime
0036 INTEGER myIter
0037 INTEGER myThid
0038
7c50f07931 Mart*0039 #ifdef ALLOW_GENTIM2D_CONTROL
7bd66d7dc3 Patr*0040
0041
a78204c019 Mart*0042 INTEGER bi, bj
0043 INTEGER i, j
0044 INTEGER iarr
0045 _RL xx_gentim2d_loc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0046 _RS mask2D (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
a87570e2e8 Gael*0047 CHARACTER*(MAX_LEN_MBUF) msgBuf
a78204c019 Mart*0048 _RL LOCsumTile(nSx,nSy), LOCsumGlob
7bd66d7dc3 Patr*0049
0050
0051
0052
0053
a78204c019 Mart*0054 DO iarr = 1, maxCtrlTim2D
0055
0056 IF (xx_gentim2d_weight(iarr).NE.' ') THEN
0057
0058 DO bj = myByLo(myThid),myByHi(myThid)
0059 DO bi = myBxLo(myThid),myBxHi(myThid)
0060 DO j = 1-OLy,sNy+OLy
0061 DO i = 1-OLx,sNx+OLx
0062 xx_gentim2d_loc(i,j,bi,bj) = 0. _d 0
0063 ENDDO
0064 ENDDO
0065 ENDDO
0066 ENDDO
0067
0068 CALL CTRL_GET_MASK2D( xx_gentim2d_file(iarr), mask2D, myThid )
7b8b86ab99 Timo*0069 CALL CTRL_GET_GEN (
a78204c019 Mart*0070 I xx_gentim2d_file(iarr),
f7e062a48e Jean*0071 I xx_gentim2d_startdate(1,iarr),
7bd66d7dc3 Patr*0072 I xx_gentim2d_period(iarr),
7b8b86ab99 Timo*0073 I mask2D,
f7e062a48e Jean*0074 O xx_gentim2d_loc,
a78204c019 Mart*0075 I xx_gentim2d0(1-OLx,1-OLy,1,1,iarr),
0076 I xx_gentim2d1(1-OLx,1-OLy,1,1,iarr),
7bd66d7dc3 Patr*0077 I xx_gentim2d_dummy(iarr),
f7e062a48e Jean*0078 I zeroRL, zeroRL,
a78204c019 Mart*0079 I wgentim2d(1-OLx,1-OLy,1,1,iarr),
0080 I myTime, myIter, myThid )
0081
0082 IF (xx_gentim2d_cumsum(iarr)) THEN
0083 DO bj=myByLo(myThid),myByHi(myThid)
0084 DO bi=myBxLo(myThid),myBxHi(myThid)
0085 DO j = 1,sNy
0086 DO i = 1,sNx
0087 xx_gentim2d(i,j,bi,bj,iarr)=xx_gentim2d(i,j,bi,bj,iarr)
0088 & + xx_gentim2d_loc(i,j,bi,bj)
0089 ENDDO
0090 ENDDO
0091 ENDDO
0092 ENDDO
0093 ELSE
0094 DO bj=myByLo(myThid),myByHi(myThid)
0095 DO bi=myBxLo(myThid),myBxHi(myThid)
0096 DO j = 1,sNy
0097 DO i = 1,sNx
0098 xx_gentim2d(i,j,bi,bj,iarr)=xx_gentim2d_loc(i,j,bi,bj)
0099 ENDDO
0100 ENDDO
0101 ENDDO
0102 ENDDO
0103 ENDIF
0104
0105 IF (xx_gentim2d_glosum(iarr)) THEN
0106
0107 DO bj=myByLo(myThid),myByHi(myThid)
0108 DO bi=myBxLo(myThid),myBxHi(myThid)
0109 LOCsumTile(bi,bj)=0. _d 0
0110 DO j = 1,sNy
0111 DO i = 1,sNx
0112 LOCsumTile(bi,bj) = LOCsumTile(bi,bj)
0113 & + xx_gentim2d(i,j,bi,bj,iarr)*rA(i,j,bi,bj)
0114 & *maskC(i,j,1,bi,bj)*maskInC(i,j,bi,bj)
0115 ENDDO
0116 ENDDO
0117 ENDDO
0118 ENDDO
0119
0120 CALL GLOBAL_SUM_TILE_RL( LOCsumTile, LOCsumGlob, myThid )
0121
0122 LOCsumGlob = LOCsumGlob/globalArea
0123 DO bj = myByLo(myThid),myByHi(myThid)
0124 DO bi = myBxLo(myThid),myBxHi(myThid)
0125 DO j = 1-OLy,sNy+OLy
0126 DO i = 1-OLx,sNx+OLx
0127 xx_gentim2d(i,j,bi,bj,iarr) =
0128 & LOCsumGlob*maskC(i,j,1,bi,bj)
0129 ENDDO
0130 ENDDO
0131 ENDDO
0132 ENDDO
0133
0134 IF (xx_gentim2d_file(iarr).EQ.'xx_gen_precip') THEN
0135
0136 WRITE(msgBuf,'(A,I6,A,1PE21.14)')
0137 & ' iter=', myIter, ' ; genprecipGloH= ',
0138 & LOCsumGlob*rhoConstFresh*recip_rhoConst*deltaTClock
0139 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
0140 & SQUEEZE_RIGHT, myThid )
0141
0142 ENDIF
0143
0144 ENDIF
0145
0146 ENDIF
0147
0148 ENDDO
7bd66d7dc3 Patr*0149
0150 #endif /* ALLOW_GENTIM2D_CONTROL */
0151
0152 RETURN
0153 END
