1 |
C $Header: /u/gcmpack/MITgcm/pkg/atm2d/calc_1dto2d.F,v 1.4 2007/11/19 22:57:31 jscott Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "ctrparam.h" |
5 |
#include "ATM2D_OPTIONS.h" |
6 |
|
7 |
C !INTERFACE: |
8 |
SUBROUTINE CALC_1DTO2D( myThid ) |
9 |
C *==========================================================* |
10 |
C | - Takes 1D atmos data, regrid to 2D ocean grid. This | |
11 |
C | involves totalling runoff into bands and redistributing| |
12 |
C | and using derivates dF/dT and dH/dT to compute | |
13 |
C | local variations in evap and heat flux. | |
14 |
C *==========================================================* |
15 |
IMPLICIT NONE |
16 |
|
17 |
#include "ATMSIZE.h" |
18 |
#include "SIZE.h" |
19 |
#include "GRID.h" |
20 |
#include "EEPARAMS.h" |
21 |
|
22 |
C === Global SeaIce Variables === |
23 |
#include "THSICE_VARS.h" |
24 |
|
25 |
C === Atmos/Ocean/Seaice Interface Variables === |
26 |
#include "ATM2D_VARS.h" |
27 |
|
28 |
C !INPUT/OUTPUT PARAMETERS: |
29 |
C === Routine arguments === |
30 |
C myThid - Thread no. that called this routine. |
31 |
INTEGER myThid |
32 |
|
33 |
C LOCAL VARIABLES: |
34 |
INTEGER i,j ! loop counters across ocean grid |
35 |
INTEGER ib,ibj1,ibj2 ! runoff band variables |
36 |
_RL run_b(sNy) ! total runoff in a band |
37 |
_RL fv_toC ! meridional wind stress for ocean C-grid pt |
38 |
|
39 |
CALL INIT_2DFLD(myThid) |
40 |
|
41 |
C Accumulate runoff into bands (runoff bands are on the ocean grid) |
42 |
DO ib=1,numBands |
43 |
ibj1=1 |
44 |
IF (ib.GT.1) ibj1= rband(ib-1)+1 |
45 |
ibj2=sNy |
46 |
IF (ib.LT.numBands) ibj2= rband(ib) |
47 |
run_b(ib)=0. _d 0 |
48 |
DO j=ibj1,ibj2 |
49 |
run_b(ib)=run_b(ib) + |
50 |
& atm_runoff(atm_oc_ind(j))*atm_oc_frac1(j) + |
51 |
& atm_runoff(atm_oc_ind(j)+1)*atm_oc_frac2(j) |
52 |
ENDDO |
53 |
ENDDO |
54 |
|
55 |
DO j=1,sNy |
56 |
|
57 |
C do a linear interpolation from atmos data to get tauv |
58 |
fv_toC = atm_tauv(tauv_jpt(j)) * tauv_jwght(j) + |
59 |
& atm_tauv(tauv_jpt(j)+1) * (1. _d 0 - tauv_jwght(j)) |
60 |
|
61 |
DO i=1,sNx |
62 |
|
63 |
IF (maskC(i,j,1,1,1).EQ.1.) THEN |
64 |
|
65 |
runoff_2D(i,j) = run_b(runIndex(j)) * |
66 |
& runoffVal(i,j)/rA(i,j,1,1) |
67 |
|
68 |
CALL CALC_WGHT2D(i,j,atm_oc_ind(j),atm_oc_wgt(j)) |
69 |
|
70 |
IF (atm_oc_wgt(j).LT.1. _d 0) |
71 |
& CALL CALC_WGHT2D(i, j, atm_oc_ind(j)+1, |
72 |
& 1. _d 0-atm_oc_wgt(j)) |
73 |
|
74 |
fv_2D(i,j) = fv_toC |
75 |
|
76 |
C Tabulate following diagnostic fluxes from atmos model only |
77 |
qnet_atm(i,j)= qnet_atm(i,j) + |
78 |
& qneti_2D(i,j)*dtatmo*iceMask(i,j,1,1) + |
79 |
& qneto_2D(i,j)*dtatmo*(1. _d 0-iceMask(i,j,1,1)) |
80 |
evap_atm(i,j)= evap_atm(i,j) + |
81 |
& evapi_2D(i,j)*dtatmo*iceMask(i,j,1,1) + |
82 |
& evapo_2D(i,j)*dtatmo*(1. _d 0-iceMask(i,j,1,1)) |
83 |
precip_atm(i,j)= precip_atm(i,j) + |
84 |
& precipi_2D(i,j)*dtatmo*iceMask(i,j,1,1) + |
85 |
& precipo_2D(i,j)*dtatmo*(1. _d 0-iceMask(i,j,1,1)) |
86 |
runoff_atm(i,j)= runoff_atm(i,j) + |
87 |
& runoff_2D(i,j)*dtatmo |
88 |
ENDIF |
89 |
|
90 |
ENDDO |
91 |
ENDDO |
92 |
|
93 |
RETURN |
94 |
END |
95 |
|
96 |
|
97 |
C-------------------------------------------------------------------------- |
98 |
|
99 |
#include "ctrparam.h" |
100 |
#include "ATM2D_OPTIONS.h" |
101 |
|
102 |
C !INTERFACE: |
103 |
SUBROUTINE CALC_WGHT2D( i, j, ind, wgt) |
104 |
C *==========================================================* |
105 |
C | Use atmos grid cell 1D value and weight to convert to 2D.| |
106 |
C | Variations from zonal mean computed used derivative dH/dT| |
107 |
C | and dF/dT for heat flux and evap terms. | |
108 |
C | | |
109 |
C | Fluxes/values over seaice computed only if seaice present| |
110 |
C *==========================================================* |
111 |
IMPLICIT NONE |
112 |
|
113 |
#include "ATMSIZE.h" |
114 |
#include "SIZE.h" |
115 |
#include "EEPARAMS.h" |
116 |
|
117 |
C === Global SeaIce Variables === |
118 |
#include "THSICE_VARS.h" |
119 |
|
120 |
C === Atmos/Ocean/Seaice Interface Variables === |
121 |
#include "ATM2D_VARS.h" |
122 |
|
123 |
C !INPUT/OUTPUT PARAMETERS: |
124 |
C === Routine arguments === |
125 |
C i,j - coordinates of point on ocean grid |
126 |
C ind - index into the atmos grid array |
127 |
C wght - weight of this atmos cell for total |
128 |
INTEGER i, j |
129 |
INTEGER ind |
130 |
_RL wgt |
131 |
|
132 |
precipo_2D(i,j)= precipo_2D(i,j) + atm_precip(ind)*wgt |
133 |
solarnet_ocn_2D(i,j)=solarnet_ocn_2D(i,j) + atm_solar_ocn(ind)*wgt |
134 |
slp_2D(i,j)= slp_2D(i,j) + atm_slp(ind)*wgt |
135 |
pCO2_2D(i,j)= pCO2_2D(i,j) + atm_pco2(ind)*wgt |
136 |
wspeed_2D(i,j)= wspeed_2D(i,j) + atm_windspeed(ind)*wgt |
137 |
fu_2D(i,j)= fu_2D(i,j) + atm_tauu(ind)*wgt |
138 |
|
139 |
qneto_2D(i,j)= qneto_2D(i,j) + atm_qnet_ocn(ind)*wgt |
140 |
evapo_2D(i,j)= evapo_2D(i,j) + atm_evap_ocn(ind)*wgt |
141 |
IF (evapo_2D(i,j).GT.0. _d 0) THEN !convert negative evap. to precip |
142 |
precipo_2D(i,j)= precipo_2D(i,j) - evapo_2D(i,j) |
143 |
evapo_2D(i,j)=0. _d 0 |
144 |
ENDIF |
145 |
|
146 |
IF (iceMask(i,j,1,1) .GT. 0. _d 0) THEN |
147 |
qneti_2D(i,j)= qneti_2D(i,j) + atm_qnet_ice(ind)*wgt |
148 |
precipi_2D(i,j)= precipi_2D(i,j) + atm_precip(ind)*wgt |
149 |
evapi_2D(i,j)= evapi_2D(i,j) + atm_evap_ice(ind)*wgt |
150 |
IF (evapi_2D(i,j).GT.0. _d 0) THEN !convert negative evap. to precip |
151 |
precipi_2D(i,j)= precipi_2D(i,j) - evapi_2D(i,j) |
152 |
evapi_2D(i,j)=0. _d 0 |
153 |
ENDIF |
154 |
dFdT_ice_2D(i,j)= dFdT_ice_2D(i,j) + atm_dFdT_ice(ind)*wgt |
155 |
Tair_2D(i,j)= Tair_2D(i,j) + atm_Tair(ind)*wgt |
156 |
solarinc_2D(i,j)= solarinc_2D(i,j) + atm_solarinc(ind)*wgt |
157 |
ENDIF |
158 |
|
159 |
IF (useAltDeriv) THEN |
160 |
qneto_2D(i,j)= qneto_2D(i,j) + atm_dFdt_ocnq(ind)* |
161 |
& (sstFromOcn(i,j)-ctocn(ind))*wgt |
162 |
evapo_2D(i,j)= evapo_2D(i,j) + atm_dLdt_ocnq(ind)* |
163 |
& (sstFromOcn(i,j)-ctocn(ind))*wgt |
164 |
IF (iceMask(i,j,1,1) .GT. 0. _d 0) THEN |
165 |
qneti_2D(i,j)=qneti_2D(i,j)+atm_dFdt_iceq(ind)* |
166 |
& (Tsrf(i,j,1,1)-ctice(ind))*wgt |
167 |
evapi_2D(i,j)=evapi_2D(i,j)+atm_dLdt_iceq(ind)* |
168 |
& (Tsrf(i,j,1,1)-ctice(ind))*wgt |
169 |
ENDIF |
170 |
ELSE |
171 |
qneto_2D(i,j)= qneto_2D(i,j) + atm_dFdt_ocn(ind)* |
172 |
& (sstFromOcn(i,j)-ctocn(ind))*wgt |
173 |
evapo_2D(i,j)= evapo_2D(i,j) + atm_dLdt_ocn(ind)* |
174 |
& (sstFromOcn(i,j)-ctocn(ind))*wgt |
175 |
IF (iceMask(i,j,1,1) .GT. 0. _d 0) THEN |
176 |
qneti_2D(i,j)= qneti_2D(i,j) + atm_dFdt_ice(ind)* |
177 |
& (Tsrf(i,j,1,1)-ctice(ind))*wgt |
178 |
evapi_2D(i,j)= evapi_2D(i,j)+atm_dLdt_ice(ind)* |
179 |
& (Tsrf(i,j,1,1)-ctice(ind))*wgt |
180 |
ENDIF |
181 |
ENDIF |
182 |
|
183 |
|
184 |
RETURN |
185 |
END |
186 |
|
187 |
C-------------------------------------------------------------------------- |
188 |
|
189 |
#include "ctrparam.h" |
190 |
#include "ATM2D_OPTIONS.h" |
191 |
|
192 |
C !INTERFACE: |
193 |
SUBROUTINE INIT_2DFLD( myThid) |
194 |
C *==========================================================* |
195 |
C | Zero out the 2D fields; called prior to doing any of the | |
196 |
C | 1D->2D calculation. | |
197 |
C *==========================================================* |
198 |
IMPLICIT NONE |
199 |
|
200 |
#include "ATMSIZE.h" |
201 |
#include "SIZE.h" |
202 |
#include "EEPARAMS.h" |
203 |
#include "ATM2D_VARS.h" |
204 |
|
205 |
C !INPUT/OUTPUT PARAMETERS: |
206 |
C === Routine arguments === |
207 |
C myThid - Thread no. that called this routine. |
208 |
INTEGER myThid |
209 |
|
210 |
C LOCAL VARIABLES: |
211 |
INTEGER i,j |
212 |
|
213 |
DO i=1,sNx |
214 |
DO j=1,sNy |
215 |
|
216 |
precipo_2D(i,j)= 0. _d 0 |
217 |
precipi_2D(i,j)= 0. _d 0 |
218 |
solarnet_ocn_2D(i,j)= 0. _d 0 |
219 |
slp_2D(i,j)= 0. _d 0 |
220 |
pCO2_2D(i,j)= 0. _d 0 |
221 |
wspeed_2D(i,j)= 0. _d 0 |
222 |
fu_2D(i,j)= 0. _d 0 |
223 |
fv_2D(i,j)= 0. _d 0 |
224 |
qneto_2D(i,j)= 0. _d 0 |
225 |
evapo_2D(i,j)= 0. _d 0 |
226 |
qneti_2D(i,j)= 0. _d 0 |
227 |
evapi_2D(i,j)= 0. _d 0 |
228 |
dFdT_ice_2D(i,j)= 0. _d 0 |
229 |
Tair_2D(i,j)= 0. _d 0 |
230 |
solarinc_2D(i,j)= 0. _d 0 |
231 |
runoff_2D(i,j)= 0. _d 0 |
232 |
|
233 |
ENDDO |
234 |
ENDDO |
235 |
|
236 |
RETURN |
237 |
END |