1 |
C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_balance_frw.F,v 1.1 2012/08/01 18:22:41 jmc Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "THSICE_OPTIONS.h" |
5 |
|
6 |
CBOP |
7 |
C !ROUTINE: THSICE_BALANCE_FRW |
8 |
C !INTERFACE: |
9 |
SUBROUTINE THSICE_BALANCE_FRW( |
10 |
I iMin, iMax, jMin, jMax, |
11 |
I prcAtm, myTime, myIter, myThid ) |
12 |
|
13 |
C !DESCRIPTION: \bv |
14 |
C *==========================================================* |
15 |
C | SUBROUTINE THSICE_BALANCE_FRW |
16 |
C | o Correct ocean fresh-water forcing for global imbalance |
17 |
C | of Atmos+Land fresh-water flux |
18 |
C *==========================================================* |
19 |
C \ev |
20 |
C !USES: |
21 |
IMPLICIT NONE |
22 |
|
23 |
C === Global variables === |
24 |
#include "SIZE.h" |
25 |
#include "EEPARAMS.h" |
26 |
#include "PARAMS.h" |
27 |
#include "GRID.h" |
28 |
#include "FFIELDS.h" |
29 |
#include "THSICE_SIZE.h" |
30 |
#include "THSICE_PARAMS.h" |
31 |
#include "THSICE_VARS.h" |
32 |
|
33 |
C !INPUT/OUTPUT PARAMETERS: |
34 |
C iMin,iMax :: computation domain: 1rst index range |
35 |
C jMin,jMax :: computation domain: 2nd index range |
36 |
C prcAtm :: precip (+RunOff) from Atmos+Land |
37 |
C myTime :: Current time in simulation (s) |
38 |
C myIter :: Current iteration number |
39 |
C myThid :: My Thread Id. number |
40 |
INTEGER iMin, iMax |
41 |
INTEGER jMin, jMax |
42 |
_RL prcAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
43 |
_RL myTime |
44 |
INTEGER myIter |
45 |
INTEGER myThid |
46 |
CEOP |
47 |
|
48 |
#ifdef ALLOW_BALANCE_FLUXES |
49 |
C !LOCAL VARIABLES: |
50 |
C bi,bj :: Tile indices |
51 |
C i, j :: loop indices |
52 |
INTEGER bi,bj |
53 |
INTEGER i, j |
54 |
_RL sumPrc, sumTilePrc(nSx,nSy) |
55 |
_RL sumFrW, sumTileFrW(nSx,nSy) |
56 |
_RL tmpFac, tmpVar |
57 |
|
58 |
C-- Calculate and global-mean precip (+RunOff) |
59 |
C and global-mean imbalance of net Atmos Fresh-Water flux |
60 |
IF ( thSIceBalanceAtmFW.NE.0 ) THEN |
61 |
|
62 |
DO bj=myByLo(myThid),myByHi(myThid) |
63 |
DO bi=myBxLo(myThid),myBxHi(myThid) |
64 |
sumTilePrc(bi,bj) = 0. _d 0 |
65 |
sumTileFrW(bi,bj) = 0. _d 0 |
66 |
DO j = 1,sNy |
67 |
DO i = 1,sNx |
68 |
sumTilePrc(bi,bj) = sumTilePrc(bi,bj) |
69 |
& + MAX( prcAtm(i,j,bi,bj), zeroRL ) |
70 |
& *rA(i,j,bi,bj)*maskInC(i,j,bi,bj) |
71 |
sumTileFrW(bi,bj) = sumTileFrW(bi,bj) |
72 |
& + icFrwAtm(i,j,bi,bj) |
73 |
& *rA(i,j,bi,bj)*maskInC(i,j,bi,bj) |
74 |
ENDDO |
75 |
ENDDO |
76 |
ENDDO |
77 |
ENDDO |
78 |
sumPrc = 0. _d 0 |
79 |
IF ( thSIceBalanceAtmFW.EQ.2 ) |
80 |
& CALL GLOBAL_SUM_TILE_RL( sumTilePrc, sumPrc, myThid ) |
81 |
CALL GLOBAL_SUM_TILE_RL( sumTileFrW, sumFrW, myThid ) |
82 |
|
83 |
IF ( globalArea.GT.0. _d 0 ) THEN |
84 |
sumPrc = sumPrc / globalArea |
85 |
sumFrW = sumFrW / globalArea |
86 |
ENDIF |
87 |
|
88 |
C- save amount of correction (for diagnostics) |
89 |
_BEGIN_MASTER(myThid) |
90 |
adjustFrW = -sumFrW |
91 |
_END_MASTER(myThid) |
92 |
|
93 |
ENDIF |
94 |
|
95 |
IF ( thSIceBalanceAtmFW.EQ.1 ) THEN |
96 |
C-- Apply uniform correction to Ocean FW Forcing (+ Atm-Flux, for diagnostics) |
97 |
DO bj=myByLo(myThid),myByHi(myThid) |
98 |
DO bi=myBxLo(myThid),myBxHi(myThid) |
99 |
DO j = jMin,jMax |
100 |
DO i = iMin,iMax |
101 |
icFrwAtm(i,j,bi,bj) = icFrwAtm(i,j,bi,bj) |
102 |
& - sumFrW*maskInC(i,j,bi,bj) |
103 |
EmPmR(i,j,bi,bj) = EmPmR(i,j,bi,bj) |
104 |
& - sumFrW*maskInC(i,j,bi,bj) |
105 |
ENDDO |
106 |
ENDDO |
107 |
ENDDO |
108 |
ENDDO |
109 |
|
110 |
ELSEIF ( thSIceBalanceAtmFW.EQ.2 ) THEN |
111 |
C-- Scale correction by local precip and apply it to Ocean FW Forcing |
112 |
C (+ Atm-Flux, for diagnostics) |
113 |
IF ( sumPrc.GT.0. _d 0 ) THEN |
114 |
tmpFac = sumFrW / sumPrc |
115 |
ELSE |
116 |
tmpFac = 0. |
117 |
_BEGIN_MASTER(myThid) |
118 |
adjustFrW = 0. _d 0 |
119 |
_END_MASTER(myThid) |
120 |
ENDIF |
121 |
DO bj=myByLo(myThid),myByHi(myThid) |
122 |
DO bi=myBxLo(myThid),myBxHi(myThid) |
123 |
DO j = jMin,jMax |
124 |
DO i = iMin,iMax |
125 |
tmpVar = tmpFac*MAX( prcAtm(i,j,bi,bj), zeroRL ) |
126 |
& *maskInC(i,j,bi,bj) |
127 |
icFrwAtm(i,j,bi,bj) = icFrwAtm(i,j,bi,bj) - tmpVar |
128 |
EmPmR(i,j,bi,bj) = EmPmR(i,j,bi,bj) - tmpVar |
129 |
ENDDO |
130 |
ENDDO |
131 |
ENDDO |
132 |
ENDDO |
133 |
|
134 |
ELSEIF ( thSIceBalanceAtmFW.NE.0 ) THEN |
135 |
STOP |
136 |
& 'ABNORMAL END: THSICE_BALANCE_FRW: invalid thSIceBalanceAtmFW' |
137 |
ENDIF |
138 |
|
139 |
#endif /* ALLOW_BALANCE_FLUXES */ |
140 |
|
141 |
RETURN |
142 |
END |