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