Line |
Branch |
Exec |
Source |
1 |
|
|
! |
2 |
|
|
MODULE cpl_mod |
3 |
|
|
! |
4 |
|
|
! This module excahanges and transforms all fields that should be recieved or sent to |
5 |
|
|
! coupler. The transformation of the fields are done from the grid 1D-array in phylmd |
6 |
|
|
! to the regular 2D grid accepted by the coupler. Cumulation of the fields for each |
7 |
|
|
! timestep is done in here. |
8 |
|
|
! |
9 |
|
|
! Each type of surface that recevie fields from the coupler have a subroutine named |
10 |
|
|
! cpl_receive_XXX_fields and each surface that have fields to be sent to the coupler |
11 |
|
|
! have a subroutine named cpl_send_XXX_fields. |
12 |
|
|
! |
13 |
|
|
!************************************************************************************* |
14 |
|
|
|
15 |
|
|
! Use statements |
16 |
|
|
!************************************************************************************* |
17 |
|
|
USE dimphy, ONLY : klon |
18 |
|
|
USE mod_phys_lmdz_para |
19 |
|
|
USE ioipsl |
20 |
|
|
USE iophy |
21 |
|
|
|
22 |
|
|
! The module oasis is always used. Without the cpp key CPP_COUPLE only the parameters |
23 |
|
|
! in the module are compiled and not the subroutines. |
24 |
|
|
USE oasis |
25 |
|
|
USE write_field_phy |
26 |
|
|
USE time_phylmdz_mod, ONLY: day_step_phy |
27 |
|
|
|
28 |
|
|
! Global attributes |
29 |
|
|
!************************************************************************************* |
30 |
|
|
IMPLICIT NONE |
31 |
|
|
PRIVATE |
32 |
|
|
|
33 |
|
|
! All subroutine are public except cpl_send_all |
34 |
|
|
PUBLIC :: cpl_init, cpl_receive_frac, cpl_receive_ocean_fields, cpl_receive_seaice_fields, & |
35 |
|
|
cpl_send_ocean_fields, cpl_send_seaice_fields, cpl_send_land_fields, & |
36 |
|
|
cpl_send_landice_fields, gath2cpl |
37 |
|
|
|
38 |
|
|
|
39 |
|
|
! Declaration of module variables |
40 |
|
|
!************************************************************************************* |
41 |
|
|
! variable for coupling period |
42 |
|
|
INTEGER, SAVE :: nexca |
43 |
|
|
!$OMP THREADPRIVATE(nexca) |
44 |
|
|
|
45 |
|
|
! variables for cumulating fields during a coupling periode : |
46 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_sols, cpl_nsol, cpl_rain |
47 |
|
|
!$OMP THREADPRIVATE(cpl_sols,cpl_nsol,cpl_rain) |
48 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_snow, cpl_evap, cpl_tsol |
49 |
|
|
!$OMP THREADPRIVATE(cpl_snow,cpl_evap,cpl_tsol) |
50 |
|
|
|
51 |
|
|
REAL, ALLOCATABLE, SAVE:: cpl_delta_sst(:), cpl_delta_sal(:) |
52 |
|
|
!$OMP THREADPRIVATE(cpl_delta_sst, cpl_delta_sal) |
53 |
|
|
|
54 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_fder, cpl_albe, cpl_taux, cpl_tauy |
55 |
|
|
!$OMP THREADPRIVATE(cpl_fder,cpl_albe,cpl_taux,cpl_tauy) |
56 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_windsp |
57 |
|
|
!$OMP THREADPRIVATE(cpl_windsp) |
58 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_sens_rain, cpl_sens_snow |
59 |
|
|
!$OMP THREADPRIVATE(cpl_sens_rain, cpl_sens_snow) |
60 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_taumod |
61 |
|
|
!$OMP THREADPRIVATE(cpl_taumod) |
62 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_atm_co2 |
63 |
|
|
!$OMP THREADPRIVATE(cpl_atm_co2) |
64 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_rriv2D, cpl_rcoa2D, cpl_rlic2D |
65 |
|
|
!$OMP THREADPRIVATE(cpl_rriv2D,cpl_rcoa2D,cpl_rlic2D) |
66 |
|
|
|
67 |
|
|
! variables read from coupler : |
68 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sst ! sea surface temperature |
69 |
|
|
!$OMP THREADPRIVATE(read_sst) |
70 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sit ! sea ice temperature |
71 |
|
|
!$OMP THREADPRIVATE(read_sit) |
72 |
|
|
|
73 |
|
|
REAL, ALLOCATABLE, SAVE:: read_sss(:, :) |
74 |
|
|
! bulk salinity of the surface layer of the ocean, in ppt |
75 |
|
|
!$OMP THREADPRIVATE(read_sss) |
76 |
|
|
|
77 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sic ! sea ice fraction |
78 |
|
|
!$OMP THREADPRIVATE(read_sic) |
79 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_alb_sic ! albedo at sea ice |
80 |
|
|
!$OMP THREADPRIVATE(read_alb_sic) |
81 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_u0, read_v0 ! ocean surface current |
82 |
|
|
!$OMP THREADPRIVATE(read_u0,read_v0) |
83 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_co2 ! ocean co2 flux |
84 |
|
|
!$OMP THREADPRIVATE(read_co2) |
85 |
|
|
INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: unity |
86 |
|
|
!$OMP THREADPRIVATE(unity) |
87 |
|
|
INTEGER, SAVE :: nidct, nidcs |
88 |
|
|
!$OMP THREADPRIVATE(nidct,nidcs) |
89 |
|
|
|
90 |
|
|
! variables to be sent to the coupler |
91 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_sols2D, cpl_nsol2D, cpl_rain2D |
92 |
|
|
!$OMP THREADPRIVATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D) |
93 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_snow2D, cpl_evap2D, cpl_tsol2D |
94 |
|
|
!$OMP THREADPRIVATE(cpl_snow2D, cpl_evap2D, cpl_tsol2D) |
95 |
|
|
|
96 |
|
|
REAL, ALLOCATABLE, SAVE:: cpl_delta_sst_2D(:,:), cpl_delta_sal_2D(:,:) |
97 |
|
|
!$OMP THREADPRIVATE(cpl_delta_sst_2D, cpl_delta_sal_2D) |
98 |
|
|
|
99 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_fder2D, cpl_albe2D |
100 |
|
|
!$OMP THREADPRIVATE(cpl_fder2D, cpl_albe2D) |
101 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taux2D, cpl_tauy2D |
102 |
|
|
!$OMP THREADPRIVATE(cpl_taux2D, cpl_tauy2D) |
103 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taumod2D |
104 |
|
|
!$OMP THREADPRIVATE(cpl_taumod2D) |
105 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_windsp2D |
106 |
|
|
!$OMP THREADPRIVATE(cpl_windsp2D) |
107 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_sens_rain2D, cpl_sens_snow2D |
108 |
|
|
!$OMP THREADPRIVATE(cpl_sens_rain2D, cpl_sens_snow2D) |
109 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_atm_co22D |
110 |
|
|
!$OMP THREADPRIVATE(cpl_atm_co22D) |
111 |
|
|
|
112 |
|
|
!!!!!!!!!! variable for calving |
113 |
|
|
INTEGER, PARAMETER :: nb_zone_calving = 3 |
114 |
|
|
REAL,ALLOCATABLE, DIMENSION(:,:,:),SAVE :: area_calving |
115 |
|
|
!$OMP THREADPRIVATE(area_calving) |
116 |
|
|
REAL,ALLOCATABLE, DIMENSION(:,:),SAVE :: cell_area2D |
117 |
|
|
!$OMP THREADPRIVATE(cell_area2D) |
118 |
|
|
INTEGER, SAVE :: ind_calving(nb_zone_calving) |
119 |
|
|
!$OMP THREADPRIVATE(ind_calving) |
120 |
|
|
|
121 |
|
|
LOGICAL,SAVE :: cpl_old_calving |
122 |
|
|
!$OMP THREADPRIVATE(cpl_old_calving) |
123 |
|
|
|
124 |
|
|
CONTAINS |
125 |
|
|
! |
126 |
|
|
!************************************************************************************ |
127 |
|
|
! |
128 |
|
✗ |
SUBROUTINE cpl_init(dtime, rlon, rlat) |
129 |
|
|
USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day |
130 |
|
|
USE surface_data |
131 |
|
|
USE indice_sol_mod |
132 |
|
|
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dTo2d_glo, klon_glo, grid_type, unstructured, regular_lonlat |
133 |
|
|
USE time_phylmdz_mod, ONLY: annee_ref, day_ini, itau_phy, itaufin_phy |
134 |
|
|
USE print_control_mod, ONLY: lunout |
135 |
|
|
USE geometry_mod, ONLY : longitude_deg, latitude_deg, ind_cell_glo, cell_area |
136 |
|
|
USE ioipsl_getin_p_mod, ONLY: getin_p |
137 |
|
|
use config_ocean_skin_m, only: activate_ocean_skin |
138 |
|
|
|
139 |
|
|
! Input arguments |
140 |
|
|
!************************************************************************************* |
141 |
|
|
REAL, INTENT(IN) :: dtime |
142 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat |
143 |
|
|
|
144 |
|
|
! Local variables |
145 |
|
|
!************************************************************************************* |
146 |
|
|
INTEGER :: error, sum_error, ig, i |
147 |
|
|
INTEGER :: jf, nhoridct |
148 |
|
|
INTEGER :: nhoridcs |
149 |
|
|
INTEGER :: idtime |
150 |
|
|
INTEGER :: idayref |
151 |
|
|
INTEGER :: npas ! only for OASIS2 |
152 |
|
|
REAL :: zjulian |
153 |
|
✗ |
REAL, DIMENSION(nbp_lon,nbp_lat) :: zx_lon, zx_lat |
154 |
|
|
CHARACTER(len = 20) :: modname = 'cpl_init' |
155 |
|
|
CHARACTER(len = 80) :: abort_message |
156 |
|
|
CHARACTER(len=80) :: clintocplnam, clfromcplnam |
157 |
|
✗ |
REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi, cell_area_mpi |
158 |
|
✗ |
INTEGER, DIMENSION(klon_mpi) :: ind_cell_glo_mpi |
159 |
|
✗ |
REAL, DIMENSION(nbp_lon,jj_nb) :: lon2D, lat2D |
160 |
|
✗ |
INTEGER :: mask_calving(nbp_lon,jj_nb,nb_zone_calving) |
161 |
|
|
REAL :: pos |
162 |
|
|
|
163 |
|
|
!*************************************** |
164 |
|
|
! Use old calving or not (default new calving method) |
165 |
|
|
! New calving method should be used with DYNAMICO and when using new coupling |
166 |
|
|
! weights. |
167 |
|
✗ |
cpl_old_calving=.FALSE. |
168 |
|
✗ |
CALL getin_p("cpl_old_calving",cpl_old_calving) |
169 |
|
✗ |
WRITE(lunout,*)' cpl_old_calving = ', cpl_old_calving |
170 |
|
|
|
171 |
|
|
|
172 |
|
|
!************************************************************************************* |
173 |
|
|
! Calculate coupling period |
174 |
|
|
! |
175 |
|
|
!************************************************************************************* |
176 |
|
|
|
177 |
|
✗ |
npas = itaufin_phy |
178 |
|
|
! nexca = 86400 / dtime |
179 |
|
✗ |
nexca = t_coupl / dtime |
180 |
|
✗ |
WRITE(lunout,*)' ##### Ocean couple #####' |
181 |
|
✗ |
WRITE(lunout,*)' Valeurs des pas de temps' |
182 |
|
✗ |
WRITE(lunout,*)' npas = ', npas |
183 |
|
✗ |
WRITE(lunout,*)' nexca = ', nexca |
184 |
|
|
|
185 |
|
|
!************************************************************************************* |
186 |
|
|
! Allocate variables |
187 |
|
|
! |
188 |
|
|
!************************************************************************************* |
189 |
|
|
error = 0 |
190 |
|
|
sum_error = 0 |
191 |
|
|
|
192 |
|
✗ |
ALLOCATE(unity(klon), stat = error) |
193 |
|
|
sum_error = sum_error + error |
194 |
|
✗ |
ALLOCATE(cpl_sols(klon,2), stat = error) |
195 |
|
✗ |
sum_error = sum_error + error |
196 |
|
✗ |
ALLOCATE(cpl_nsol(klon,2), stat = error) |
197 |
|
✗ |
sum_error = sum_error + error |
198 |
|
✗ |
ALLOCATE(cpl_rain(klon,2), stat = error) |
199 |
|
✗ |
sum_error = sum_error + error |
200 |
|
✗ |
ALLOCATE(cpl_snow(klon,2), stat = error) |
201 |
|
✗ |
sum_error = sum_error + error |
202 |
|
✗ |
ALLOCATE(cpl_evap(klon,2), stat = error) |
203 |
|
✗ |
sum_error = sum_error + error |
204 |
|
✗ |
ALLOCATE(cpl_tsol(klon,2), stat = error) |
205 |
|
✗ |
sum_error = sum_error + error |
206 |
|
✗ |
ALLOCATE(cpl_fder(klon,2), stat = error) |
207 |
|
✗ |
sum_error = sum_error + error |
208 |
|
✗ |
ALLOCATE(cpl_albe(klon,2), stat = error) |
209 |
|
✗ |
sum_error = sum_error + error |
210 |
|
✗ |
ALLOCATE(cpl_taux(klon,2), stat = error) |
211 |
|
✗ |
sum_error = sum_error + error |
212 |
|
✗ |
ALLOCATE(cpl_tauy(klon,2), stat = error) |
213 |
|
✗ |
sum_error = sum_error + error |
214 |
|
✗ |
ALLOCATE(cpl_windsp(klon,2), stat = error) |
215 |
|
✗ |
sum_error = sum_error + error |
216 |
|
✗ |
ALLOCATE(cpl_taumod(klon,2), stat = error) |
217 |
|
✗ |
sum_error = sum_error + error |
218 |
|
✗ |
ALLOCATE(cpl_sens_rain(klon,2), stat = error) |
219 |
|
✗ |
sum_error = sum_error + error |
220 |
|
✗ |
ALLOCATE(cpl_sens_snow(klon,2), stat = error) |
221 |
|
✗ |
sum_error = sum_error + error |
222 |
|
✗ |
ALLOCATE(cpl_rriv2D(nbp_lon,jj_nb), stat=error) |
223 |
|
✗ |
sum_error = sum_error + error |
224 |
|
✗ |
ALLOCATE(cpl_rcoa2D(nbp_lon,jj_nb), stat=error) |
225 |
|
✗ |
sum_error = sum_error + error |
226 |
|
✗ |
ALLOCATE(cpl_rlic2D(nbp_lon,jj_nb), stat=error) |
227 |
|
✗ |
sum_error = sum_error + error |
228 |
|
✗ |
ALLOCATE(read_sst(nbp_lon, jj_nb), stat = error) |
229 |
|
✗ |
sum_error = sum_error + error |
230 |
|
✗ |
ALLOCATE(read_sic(nbp_lon, jj_nb), stat = error) |
231 |
|
✗ |
sum_error = sum_error + error |
232 |
|
✗ |
ALLOCATE(read_sit(nbp_lon, jj_nb), stat = error) |
233 |
|
✗ |
sum_error = sum_error + error |
234 |
|
|
|
235 |
|
✗ |
if (activate_ocean_skin >= 1) then |
236 |
|
✗ |
ALLOCATE(read_sss(nbp_lon, jj_nb), stat = error) |
237 |
|
✗ |
sum_error = sum_error + error |
238 |
|
|
|
239 |
|
✗ |
if (activate_ocean_skin == 2) then |
240 |
|
✗ |
ALLOCATE(cpl_delta_sst(klon), cpl_delta_sal(klon), stat = error) |
241 |
|
✗ |
sum_error = sum_error + error |
242 |
|
|
end if |
243 |
|
|
end if |
244 |
|
|
|
245 |
|
✗ |
ALLOCATE(read_alb_sic(nbp_lon, jj_nb), stat = error) |
246 |
|
✗ |
sum_error = sum_error + error |
247 |
|
✗ |
ALLOCATE(read_u0(nbp_lon, jj_nb), stat = error) |
248 |
|
✗ |
sum_error = sum_error + error |
249 |
|
✗ |
ALLOCATE(read_v0(nbp_lon, jj_nb), stat = error) |
250 |
|
✗ |
sum_error = sum_error + error |
251 |
|
|
|
252 |
|
✗ |
IF (carbon_cycle_cpl) THEN |
253 |
|
✗ |
ALLOCATE(read_co2(nbp_lon, jj_nb), stat = error) |
254 |
|
✗ |
sum_error = sum_error + error |
255 |
|
✗ |
ALLOCATE(cpl_atm_co2(klon,2), stat = error) |
256 |
|
✗ |
sum_error = sum_error + error |
257 |
|
|
|
258 |
|
|
! Allocate variable in carbon_cycle_mod |
259 |
|
✗ |
IF (.NOT.ALLOCATED(fco2_ocn_day)) ALLOCATE(fco2_ocn_day(klon), stat = error) |
260 |
|
✗ |
sum_error = sum_error + error |
261 |
|
|
ENDIF |
262 |
|
|
|
263 |
|
|
! calving initialization |
264 |
|
✗ |
ALLOCATE(area_calving(nbp_lon, jj_nb, nb_zone_calving), stat = error) |
265 |
|
✗ |
sum_error = sum_error + error |
266 |
|
✗ |
ALLOCATE(cell_area2D(nbp_lon, jj_nb), stat = error) |
267 |
|
✗ |
sum_error = sum_error + error |
268 |
|
|
|
269 |
|
✗ |
CALL gather_omp(longitude_deg,rlon_mpi) |
270 |
|
✗ |
CALL gather_omp(latitude_deg,rlat_mpi) |
271 |
|
✗ |
CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi) |
272 |
|
✗ |
CALL gather_omp(cell_area,cell_area_mpi) |
273 |
|
|
|
274 |
|
✗ |
IF (is_omp_master) THEN |
275 |
|
✗ |
CALL Grid1DTo2D_mpi(rlon_mpi,lon2D) |
276 |
|
✗ |
CALL Grid1DTo2D_mpi(rlat_mpi,lat2D) |
277 |
|
✗ |
CALL Grid1DTo2D_mpi(cell_area_mpi,cell_area2D) |
278 |
|
|
!--the next line is required for lat-lon grid and should have no impact |
279 |
|
|
!--for an unstructured grid for which nbp_lon=1 |
280 |
|
|
!--if north pole in process mpi then divide cell area of pole cell by number of replicates |
281 |
|
✗ |
IF (is_north_pole_dyn) cell_area2D(:,1)=cell_area2D(:,1)/FLOAT(nbp_lon) |
282 |
|
|
!--if south pole in process mpi then divide cell area of pole cell by number of replicates |
283 |
|
✗ |
IF (is_south_pole_dyn) cell_area2D(:,jj_nb)=cell_area2D(:,jj_nb)/FLOAT(nbp_lon) |
284 |
|
✗ |
mask_calving(:,:,:) = 0 |
285 |
|
✗ |
WHERE ( lat2D >= 40) mask_calving(:,:,1) = 1 |
286 |
|
✗ |
WHERE ( lat2D < 40 .AND. lat2D > -50) mask_calving(:,:,2) = 1 |
287 |
|
✗ |
WHERE ( lat2D <= -50) mask_calving(:,:,3) = 1 |
288 |
|
|
|
289 |
|
|
|
290 |
|
✗ |
DO i=1,nb_zone_calving |
291 |
|
✗ |
area_calving(:,:,i)=mask_calving(:,:,i)*cell_area2D(:,:) |
292 |
|
|
pos=1 |
293 |
|
✗ |
IF (i>1) pos = 1 + ((nbp_lon*nbp_lat-1)*(i-1))/(nb_zone_calving-1) |
294 |
|
|
|
295 |
|
✗ |
ind_calving(i)=0 |
296 |
|
✗ |
IF (grid_type==unstructured) THEN |
297 |
|
|
|
298 |
|
✗ |
DO ig=1,klon_mpi |
299 |
|
✗ |
IF (ind_cell_glo_mpi(ig)==pos) ind_calving(i)=ig |
300 |
|
|
ENDDO |
301 |
|
|
|
302 |
|
✗ |
ELSE IF (grid_type==regular_lonlat) THEN |
303 |
|
✗ |
IF ((ij_begin<=pos .AND. ij_end>=pos) .OR. (ij_begin<=pos .AND. is_south_pole_dyn )) THEN |
304 |
|
✗ |
ind_calving(i)=pos-(jj_begin-1)*nbp_lon |
305 |
|
|
ENDIF |
306 |
|
|
ENDIF |
307 |
|
|
|
308 |
|
|
ENDDO |
309 |
|
|
ENDIF |
310 |
|
|
|
311 |
|
✗ |
IF (sum_error /= 0) THEN |
312 |
|
✗ |
abort_message='Pb allocation variables couplees' |
313 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
314 |
|
|
ENDIF |
315 |
|
|
!************************************************************************************* |
316 |
|
|
! Initialize the allocated varaibles |
317 |
|
|
! |
318 |
|
|
!************************************************************************************* |
319 |
|
✗ |
DO ig = 1, klon |
320 |
|
✗ |
unity(ig) = ig |
321 |
|
|
ENDDO |
322 |
|
|
|
323 |
|
|
!************************************************************************************* |
324 |
|
|
! Initialize coupling |
325 |
|
|
! |
326 |
|
|
!************************************************************************************* |
327 |
|
|
idtime = INT(dtime) |
328 |
|
|
|
329 |
|
|
!************************************************************************************* |
330 |
|
|
! initialize NetCDF output |
331 |
|
|
! |
332 |
|
|
!************************************************************************************* |
333 |
|
✗ |
IF (is_sequential) THEN |
334 |
|
✗ |
idayref = day_ini |
335 |
|
✗ |
CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) |
336 |
|
✗ |
CALL grid1dTo2d_glo(rlon,zx_lon) |
337 |
|
✗ |
DO i = 1, nbp_lon |
338 |
|
✗ |
zx_lon(i,1) = rlon(i+1) |
339 |
|
✗ |
zx_lon(i,nbp_lat) = rlon(i+1) |
340 |
|
|
ENDDO |
341 |
|
✗ |
CALL grid1dTo2d_glo(rlat,zx_lat) |
342 |
|
✗ |
clintocplnam="cpl_atm_tauflx" |
343 |
|
|
CALL histbeg(clintocplnam,nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:),& |
344 |
|
✗ |
1,nbp_lon,1,nbp_lat, itau_phy,zjulian,dtime,nhoridct,nidct) |
345 |
|
|
! no vertical axis |
346 |
|
|
CALL histdef(nidct, 'tauxe','tauxe', & |
347 |
|
✗ |
"-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) |
348 |
|
|
CALL histdef(nidct, 'tauyn','tauyn', & |
349 |
|
✗ |
"-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) |
350 |
|
|
CALL histdef(nidct, 'tmp_lon','tmp_lon', & |
351 |
|
✗ |
"-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) |
352 |
|
|
CALL histdef(nidct, 'tmp_lat','tmp_lat', & |
353 |
|
✗ |
"-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) |
354 |
|
✗ |
DO jf=1,maxsend |
355 |
|
✗ |
IF (infosend(i)%action) THEN |
356 |
|
|
CALL histdef(nidct, infosend(i)%name ,infosend(i)%name , & |
357 |
|
✗ |
"-",nbp_lon,nbp_lat,nhoridct,1,1,1,-99,32,"inst",dtime,dtime) |
358 |
|
|
ENDIF |
359 |
|
|
ENDDO |
360 |
|
✗ |
CALL histend(nidct) |
361 |
|
✗ |
CALL histsync(nidct) |
362 |
|
|
|
363 |
|
✗ |
clfromcplnam="cpl_atm_sst" |
364 |
|
|
CALL histbeg(clfromcplnam,nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:),1,nbp_lon,1,nbp_lat, & |
365 |
|
✗ |
0,zjulian,dtime,nhoridcs,nidcs) |
366 |
|
|
! no vertical axis |
367 |
|
✗ |
DO jf=1,maxrecv |
368 |
|
✗ |
IF (inforecv(i)%action) THEN |
369 |
|
|
CALL histdef(nidcs,inforecv(i)%name ,inforecv(i)%name , & |
370 |
|
✗ |
"-",nbp_lon,nbp_lat,nhoridcs,1,1,1,-99,32,"inst",dtime,dtime) |
371 |
|
|
ENDIF |
372 |
|
|
ENDDO |
373 |
|
✗ |
CALL histend(nidcs) |
374 |
|
✗ |
CALL histsync(nidcs) |
375 |
|
|
|
376 |
|
|
ENDIF ! is_sequential |
377 |
|
|
|
378 |
|
|
!************************************************************************************* |
379 |
|
|
! compatibility test |
380 |
|
|
! |
381 |
|
|
!************************************************************************************* |
382 |
|
✗ |
IF (carbon_cycle_cpl .AND. version_ocean=='opa8') THEN |
383 |
|
✗ |
abort_message='carbon_cycle_cpl does not work with opa8' |
384 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
385 |
|
|
ENDIF |
386 |
|
|
|
387 |
|
✗ |
END SUBROUTINE cpl_init |
388 |
|
|
|
389 |
|
|
! |
390 |
|
|
!************************************************************************************* |
391 |
|
|
! |
392 |
|
|
|
393 |
|
✗ |
SUBROUTINE cpl_receive_frac(itime, dtime, pctsrf, is_modified) |
394 |
|
|
! This subroutine receives from coupler for both ocean and seaice |
395 |
|
|
! 4 fields : read_sst, read_sic, read_sit and read_alb_sic. |
396 |
|
|
! The new sea-ice-land-landice fraction is returned. The others fields |
397 |
|
|
! are stored in this module. |
398 |
|
|
USE surface_data |
399 |
|
|
USE geometry_mod, ONLY : longitude_deg, latitude_deg |
400 |
|
|
USE carbon_cycle_mod, ONLY : carbon_cycle_cpl |
401 |
|
|
USE indice_sol_mod |
402 |
|
|
USE time_phylmdz_mod, ONLY: start_time, itau_phy |
403 |
|
|
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
404 |
|
|
use config_ocean_skin_m, only: activate_ocean_skin |
405 |
|
|
|
406 |
|
|
INCLUDE "YOMCST.h" |
407 |
|
|
|
408 |
|
|
! Arguments |
409 |
|
|
!************************************************************************************ |
410 |
|
|
INTEGER, INTENT(IN) :: itime |
411 |
|
|
REAL, INTENT(IN) :: dtime |
412 |
|
|
REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf |
413 |
|
|
LOGICAL, INTENT(OUT) :: is_modified |
414 |
|
|
|
415 |
|
|
! Local variables |
416 |
|
|
!************************************************************************************ |
417 |
|
|
INTEGER :: j, i, time_sec |
418 |
|
|
INTEGER :: itau_w |
419 |
|
✗ |
INTEGER, DIMENSION(nbp_lon*nbp_lat) :: ndexcs |
420 |
|
|
CHARACTER(len = 20) :: modname = 'cpl_receive_frac' |
421 |
|
|
CHARACTER(len = 80) :: abort_message |
422 |
|
✗ |
REAL, DIMENSION(klon) :: read_sic1D |
423 |
|
✗ |
REAL, DIMENSION(nbp_lon,jj_nb,maxrecv) :: tab_read_flds |
424 |
|
✗ |
REAL, DIMENSION(klon,nbsrf) :: pctsrf_old |
425 |
|
✗ |
REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi |
426 |
|
✗ |
REAL, DIMENSION(nbp_lon,jj_nb) :: tmp_lon, tmp_lat |
427 |
|
✗ |
REAL, DIMENSION(nbp_lon,jj_nb) :: tmp_r0 |
428 |
|
|
|
429 |
|
|
!************************************************************************************* |
430 |
|
|
! Start calculation |
431 |
|
|
! Get fields from coupler |
432 |
|
|
! |
433 |
|
|
!************************************************************************************* |
434 |
|
|
|
435 |
|
✗ |
is_modified=.FALSE. |
436 |
|
|
|
437 |
|
|
! Check if right moment to receive from coupler |
438 |
|
✗ |
IF (MOD(itime, nexca) == 1) THEN |
439 |
|
✗ |
is_modified=.TRUE. |
440 |
|
|
|
441 |
|
|
time_sec=(itime-1)*dtime |
442 |
|
|
|
443 |
|
|
! NetCDF output of received fields |
444 |
|
✗ |
IF (is_sequential) THEN |
445 |
|
✗ |
ndexcs(:) = 0 |
446 |
|
✗ |
itau_w = itau_phy + itime + start_time * day_step_phy |
447 |
|
✗ |
DO i = 1, maxrecv |
448 |
|
✗ |
IF (inforecv(i)%action) THEN |
449 |
|
✗ |
CALL histwrite(nidcs,inforecv(i)%name,itau_w,tab_read_flds(:,:,i),nbp_lon*(nbp_lat),ndexcs) |
450 |
|
|
ENDIF |
451 |
|
|
ENDDO |
452 |
|
|
ENDIF |
453 |
|
|
|
454 |
|
|
|
455 |
|
|
! Save each field in a 2D array. |
456 |
|
|
!$OMP MASTER |
457 |
|
✗ |
read_sst(:,:) = tab_read_flds(:,:,idr_sisutw) ! Sea surface temperature |
458 |
|
✗ |
read_sic(:,:) = tab_read_flds(:,:,idr_icecov) ! Sea ice concentration |
459 |
|
✗ |
read_alb_sic(:,:) = tab_read_flds(:,:,idr_icealw) ! Albedo at sea ice |
460 |
|
✗ |
read_sit(:,:) = tab_read_flds(:,:,idr_icetem) ! Sea ice temperature |
461 |
|
✗ |
if (activate_ocean_skin >= 1) read_sss(:,:) = tab_read_flds(:,:,idr_sss) |
462 |
|
|
!$OMP END MASTER |
463 |
|
|
|
464 |
|
✗ |
IF (cpl_current) THEN |
465 |
|
|
|
466 |
|
|
! Transform the longitudes and latitudes on 2D arrays |
467 |
|
✗ |
CALL gather_omp(longitude_deg,rlon_mpi) |
468 |
|
✗ |
CALL gather_omp(latitude_deg,rlat_mpi) |
469 |
|
|
!$OMP MASTER |
470 |
|
✗ |
CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon) |
471 |
|
✗ |
CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat) |
472 |
|
|
|
473 |
|
|
! Transform the currents from cartesian to spheric coordinates |
474 |
|
|
! tmp_r0 should be zero |
475 |
|
|
CALL geo2atm(nbp_lon, jj_nb, tab_read_flds(:,:,idr_curenx), & |
476 |
|
|
tab_read_flds(:,:,idr_cureny), tab_read_flds(:,:,idr_curenz), & |
477 |
|
|
tmp_lon, tmp_lat, & |
478 |
|
✗ |
read_u0(:,:), read_v0(:,:), tmp_r0(:,:)) |
479 |
|
|
!$OMP END MASTER |
480 |
|
|
|
481 |
|
|
ELSE |
482 |
|
✗ |
read_u0(:,:) = 0. |
483 |
|
✗ |
read_v0(:,:) = 0. |
484 |
|
|
ENDIF |
485 |
|
|
|
486 |
|
✗ |
IF (carbon_cycle_cpl) THEN |
487 |
|
|
!$OMP MASTER |
488 |
|
✗ |
read_co2(:,:) = tab_read_flds(:,:,idr_oceco2) ! CO2 flux |
489 |
|
|
!$OMP END MASTER |
490 |
|
|
ENDIF |
491 |
|
|
|
492 |
|
|
!************************************************************************************* |
493 |
|
|
! Transform seaice fraction (read_sic : ocean-seaice mask) into global |
494 |
|
|
! fraction (pctsrf : ocean-seaice-land-landice mask) |
495 |
|
|
! |
496 |
|
|
!************************************************************************************* |
497 |
|
✗ |
CALL cpl2gath(read_sic, read_sic1D, klon, unity) |
498 |
|
|
|
499 |
|
✗ |
pctsrf_old(:,:) = pctsrf(:,:) |
500 |
|
✗ |
DO i = 1, klon |
501 |
|
|
! treatment only of points with ocean and/or seaice |
502 |
|
|
! old land-ocean mask can not be changed |
503 |
|
✗ |
IF (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic) > 0.) THEN |
504 |
|
|
pctsrf(i,is_sic) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) & |
505 |
|
✗ |
* read_sic1D(i) |
506 |
|
|
pctsrf(i,is_oce) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) & |
507 |
|
✗ |
- pctsrf(i,is_sic) |
508 |
|
|
ENDIF |
509 |
|
|
ENDDO |
510 |
|
|
|
511 |
|
|
ENDIF ! if time to receive |
512 |
|
|
|
513 |
|
✗ |
END SUBROUTINE cpl_receive_frac |
514 |
|
|
|
515 |
|
|
! |
516 |
|
|
!************************************************************************************* |
517 |
|
|
! |
518 |
|
|
|
519 |
|
✗ |
SUBROUTINE cpl_receive_ocean_fields(knon, knindex, tsurf_new, u0_new, & |
520 |
|
✗ |
v0_new, sss) |
521 |
|
|
! |
522 |
|
|
! This routine returns the field for the ocean that has been read from the coupler |
523 |
|
|
! (done earlier with cpl_receive_frac). The field is the temperature. |
524 |
|
|
! The temperature is transformed into 1D array with valid points from index 1 to knon. |
525 |
|
|
! |
526 |
|
|
USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day |
527 |
|
|
USE indice_sol_mod |
528 |
|
|
use config_ocean_skin_m, only: activate_ocean_skin |
529 |
|
|
|
530 |
|
|
! Input arguments |
531 |
|
|
!************************************************************************************* |
532 |
|
|
INTEGER, INTENT(IN) :: knon |
533 |
|
|
INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
534 |
|
|
|
535 |
|
|
! Output arguments |
536 |
|
|
!************************************************************************************* |
537 |
|
|
REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new |
538 |
|
|
|
539 |
|
|
REAL, INTENT(OUT):: sss(:) ! (klon) |
540 |
|
|
! bulk salinity of the surface layer of the ocean, in ppt |
541 |
|
|
|
542 |
|
|
REAL, DIMENSION(klon), INTENT(OUT) :: u0_new |
543 |
|
|
REAL, DIMENSION(klon), INTENT(OUT) :: v0_new |
544 |
|
|
|
545 |
|
|
! Local variables |
546 |
|
|
!************************************************************************************* |
547 |
|
|
INTEGER :: i |
548 |
|
✗ |
INTEGER, DIMENSION(klon) :: index |
549 |
|
✗ |
REAL, DIMENSION(klon) :: sic_new |
550 |
|
|
|
551 |
|
|
!************************************************************************************* |
552 |
|
|
! Transform read_sst into compressed 1D variable tsurf_new |
553 |
|
|
! |
554 |
|
|
!************************************************************************************* |
555 |
|
✗ |
CALL cpl2gath(read_sst, tsurf_new, knon, knindex) |
556 |
|
✗ |
if (activate_ocean_skin >= 1) CALL cpl2gath(read_sss, sss, knon, knindex) |
557 |
|
✗ |
CALL cpl2gath(read_sic, sic_new, knon, knindex) |
558 |
|
✗ |
CALL cpl2gath(read_u0, u0_new, knon, knindex) |
559 |
|
✗ |
CALL cpl2gath(read_v0, v0_new, knon, knindex) |
560 |
|
|
|
561 |
|
|
!************************************************************************************* |
562 |
|
|
! Transform read_co2 into uncompressed 1D variable fco2_ocn_day added directly in |
563 |
|
|
! the module carbon_cycle_mod |
564 |
|
|
! |
565 |
|
|
!************************************************************************************* |
566 |
|
✗ |
IF (carbon_cycle_cpl) THEN |
567 |
|
✗ |
DO i=1,klon |
568 |
|
✗ |
index(i)=i |
569 |
|
|
ENDDO |
570 |
|
✗ |
CALL cpl2gath(read_co2, fco2_ocn_day, klon, index) |
571 |
|
|
ENDIF |
572 |
|
|
|
573 |
|
|
!************************************************************************************* |
574 |
|
|
! The fields received from the coupler have to be weighted with the fraction of ocean |
575 |
|
|
! in relation to the total sea-ice+ocean |
576 |
|
|
! |
577 |
|
|
!************************************************************************************* |
578 |
|
✗ |
DO i=1, knon |
579 |
|
✗ |
tsurf_new(i) = tsurf_new(i)/(1. - sic_new(i)) |
580 |
|
|
ENDDO |
581 |
|
|
|
582 |
|
✗ |
END SUBROUTINE cpl_receive_ocean_fields |
583 |
|
|
|
584 |
|
|
! |
585 |
|
|
!************************************************************************************* |
586 |
|
|
! |
587 |
|
|
|
588 |
|
✗ |
SUBROUTINE cpl_receive_seaice_fields(knon, knindex, & |
589 |
|
✗ |
tsurf_new, alb_new, u0_new, v0_new) |
590 |
|
|
! |
591 |
|
|
! This routine returns the fields for the seaice that have been read from the coupler |
592 |
|
|
! (done earlier with cpl_receive_frac). These fields are the temperature and |
593 |
|
|
! albedo at sea ice surface and fraction of sea ice. |
594 |
|
|
! The fields are transformed into 1D arrays with valid points from index 1 to knon. |
595 |
|
|
! |
596 |
|
|
|
597 |
|
|
! Input arguments |
598 |
|
|
!************************************************************************************* |
599 |
|
|
INTEGER, INTENT(IN) :: knon |
600 |
|
|
INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
601 |
|
|
|
602 |
|
|
! Output arguments |
603 |
|
|
!************************************************************************************* |
604 |
|
|
REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new |
605 |
|
|
REAL, DIMENSION(klon), INTENT(OUT) :: alb_new |
606 |
|
|
REAL, DIMENSION(klon), INTENT(OUT) :: u0_new |
607 |
|
|
REAL, DIMENSION(klon), INTENT(OUT) :: v0_new |
608 |
|
|
|
609 |
|
|
! Local variables |
610 |
|
|
!************************************************************************************* |
611 |
|
|
INTEGER :: i |
612 |
|
✗ |
REAL, DIMENSION(klon) :: sic_new |
613 |
|
|
|
614 |
|
|
!************************************************************************************* |
615 |
|
|
! Transform fields read from coupler from 2D into compressed 1D variables |
616 |
|
|
! |
617 |
|
|
!************************************************************************************* |
618 |
|
✗ |
CALL cpl2gath(read_sit, tsurf_new, knon, knindex) |
619 |
|
✗ |
CALL cpl2gath(read_alb_sic, alb_new, knon, knindex) |
620 |
|
✗ |
CALL cpl2gath(read_sic, sic_new, knon, knindex) |
621 |
|
✗ |
CALL cpl2gath(read_u0, u0_new, knon, knindex) |
622 |
|
✗ |
CALL cpl2gath(read_v0, v0_new, knon, knindex) |
623 |
|
|
|
624 |
|
|
!************************************************************************************* |
625 |
|
|
! The fields received from the coupler have to be weighted with the sea-ice |
626 |
|
|
! concentration (in relation to the total sea-ice + ocean). |
627 |
|
|
! |
628 |
|
|
!************************************************************************************* |
629 |
|
✗ |
DO i= 1, knon |
630 |
|
✗ |
tsurf_new(i) = tsurf_new(i) / sic_new(i) |
631 |
|
✗ |
alb_new(i) = alb_new(i) / sic_new(i) |
632 |
|
|
ENDDO |
633 |
|
|
|
634 |
|
✗ |
END SUBROUTINE cpl_receive_seaice_fields |
635 |
|
|
|
636 |
|
|
! |
637 |
|
|
!************************************************************************************* |
638 |
|
|
! |
639 |
|
|
|
640 |
|
✗ |
SUBROUTINE cpl_send_ocean_fields(itime, knon, knindex, & |
641 |
|
|
swdown, lwdown, fluxlat, fluxsens, & |
642 |
|
|
precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy, windsp,& |
643 |
|
✗ |
sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, delta_sst, & |
644 |
|
✗ |
delta_sal) |
645 |
|
|
|
646 |
|
|
! This subroutine cumulates some fields for each time-step during |
647 |
|
|
! a coupling period. At last time-step in a coupling period the |
648 |
|
|
! fields are transformed to the grid accepted by the coupler. No |
649 |
|
|
! sending to the coupler will be done from here (it is done in |
650 |
|
|
! cpl_send_seaice_fields). Crucial hypothesis is that the surface |
651 |
|
|
! fractions do not change between coupling time-steps. |
652 |
|
|
|
653 |
|
|
USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send |
654 |
|
|
USE indice_sol_mod |
655 |
|
|
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
656 |
|
|
use config_ocean_skin_m, only: activate_ocean_skin |
657 |
|
|
|
658 |
|
|
! Input arguments |
659 |
|
|
!************************************************************************************* |
660 |
|
|
INTEGER, INTENT(IN) :: itime |
661 |
|
|
INTEGER, INTENT(IN) :: knon |
662 |
|
|
INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
663 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: swdown, lwdown |
664 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: fluxlat, fluxsens |
665 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow |
666 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: evap, tsurf, fder, albsol |
667 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: taux, tauy, windsp |
668 |
|
|
REAL, INTENT(IN):: sens_prec_liq(:), sens_prec_sol(:) ! (knon) |
669 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: lat_prec_liq, lat_prec_sol |
670 |
|
|
|
671 |
|
|
REAL, intent(in):: delta_sst(:) ! (knon) |
672 |
|
|
! Ocean-air interface temperature minus bulk SST, in |
673 |
|
|
! K. Defined only if activate_ocean_skin >= 1. |
674 |
|
|
|
675 |
|
|
real, intent(in):: delta_sal(:) ! (knon) |
676 |
|
|
! Ocean-air interface salinity minus bulk salinity, in ppt. |
677 |
|
|
|
678 |
|
|
! Local variables |
679 |
|
|
!************************************************************************************* |
680 |
|
|
INTEGER :: cpl_index, ig |
681 |
|
|
INTEGER :: error, sum_error |
682 |
|
|
CHARACTER(len = 25) :: modname = 'cpl_send_ocean_fields' |
683 |
|
|
CHARACTER(len = 80) :: abort_message |
684 |
|
|
|
685 |
|
|
!************************************************************************************* |
686 |
|
|
! Start calculation |
687 |
|
|
! The ocean points are saved with second array index=1 |
688 |
|
|
! |
689 |
|
|
!************************************************************************************* |
690 |
|
|
cpl_index = 1 |
691 |
|
|
|
692 |
|
|
!************************************************************************************* |
693 |
|
|
! Reset fields to zero in the beginning of a new coupling period |
694 |
|
|
! |
695 |
|
|
!************************************************************************************* |
696 |
|
✗ |
IF (MOD(itime, nexca) == 1) THEN |
697 |
|
✗ |
cpl_sols(1:knon,cpl_index) = 0.0 |
698 |
|
✗ |
cpl_nsol(1:knon,cpl_index) = 0.0 |
699 |
|
✗ |
cpl_rain(1:knon,cpl_index) = 0.0 |
700 |
|
✗ |
cpl_snow(1:knon,cpl_index) = 0.0 |
701 |
|
✗ |
cpl_evap(1:knon,cpl_index) = 0.0 |
702 |
|
✗ |
cpl_tsol(1:knon,cpl_index) = 0.0 |
703 |
|
✗ |
cpl_fder(1:knon,cpl_index) = 0.0 |
704 |
|
✗ |
cpl_albe(1:knon,cpl_index) = 0.0 |
705 |
|
✗ |
cpl_taux(1:knon,cpl_index) = 0.0 |
706 |
|
✗ |
cpl_tauy(1:knon,cpl_index) = 0.0 |
707 |
|
✗ |
cpl_windsp(1:knon,cpl_index) = 0.0 |
708 |
|
✗ |
cpl_sens_rain(1:knon,cpl_index) = 0.0 |
709 |
|
✗ |
cpl_sens_snow(1:knon,cpl_index) = 0.0 |
710 |
|
✗ |
cpl_taumod(1:knon,cpl_index) = 0.0 |
711 |
|
✗ |
IF (carbon_cycle_cpl) cpl_atm_co2(1:knon,cpl_index) = 0.0 |
712 |
|
|
|
713 |
|
✗ |
if (activate_ocean_skin == 2) then |
714 |
|
✗ |
cpl_delta_sst = 0. |
715 |
|
✗ |
cpl_delta_sal = 0. |
716 |
|
|
end if |
717 |
|
|
ENDIF |
718 |
|
|
|
719 |
|
|
!************************************************************************************* |
720 |
|
|
! Cumulate at each time-step |
721 |
|
|
! |
722 |
|
|
!************************************************************************************* |
723 |
|
✗ |
DO ig = 1, knon |
724 |
|
|
cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + & |
725 |
|
✗ |
swdown(ig) / REAL(nexca) |
726 |
|
|
cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + & |
727 |
|
✗ |
(lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca) |
728 |
|
|
cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + & |
729 |
|
✗ |
precip_rain(ig) / REAL(nexca) |
730 |
|
|
cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + & |
731 |
|
✗ |
precip_snow(ig) / REAL(nexca) |
732 |
|
|
cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + & |
733 |
|
✗ |
evap(ig) / REAL(nexca) |
734 |
|
|
cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + & |
735 |
|
✗ |
tsurf(ig) / REAL(nexca) |
736 |
|
|
cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + & |
737 |
|
✗ |
fder(ig) / REAL(nexca) |
738 |
|
|
cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + & |
739 |
|
✗ |
albsol(ig) / REAL(nexca) |
740 |
|
|
cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + & |
741 |
|
✗ |
taux(ig) / REAL(nexca) |
742 |
|
|
cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + & |
743 |
|
✗ |
tauy(ig) / REAL(nexca) |
744 |
|
|
cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) + & |
745 |
|
✗ |
windsp(ig) / REAL(nexca) |
746 |
|
|
cpl_sens_rain(ig,cpl_index) = cpl_sens_rain(ig,cpl_index) + & |
747 |
|
✗ |
sens_prec_liq(ig) / REAL(nexca) |
748 |
|
|
cpl_sens_snow(ig,cpl_index) = cpl_sens_snow(ig,cpl_index) + & |
749 |
|
✗ |
sens_prec_sol(ig) / REAL(nexca) |
750 |
|
|
cpl_taumod(ig,cpl_index) = cpl_taumod(ig,cpl_index) + & |
751 |
|
✗ |
SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / REAL (nexca) |
752 |
|
|
|
753 |
|
✗ |
IF (carbon_cycle_cpl) THEN |
754 |
|
|
cpl_atm_co2(ig,cpl_index) = cpl_atm_co2(ig,cpl_index) + & |
755 |
|
✗ |
co2_send(knindex(ig))/ REAL(nexca) |
756 |
|
|
!!---OB: this is correct but why knindex ?? |
757 |
|
|
ENDIF |
758 |
|
|
|
759 |
|
✗ |
if (activate_ocean_skin == 2) then |
760 |
|
✗ |
cpl_delta_sst(ig) = cpl_delta_sst(ig) + delta_sst(ig) / REAL(nexca) |
761 |
|
✗ |
cpl_delta_sal(ig) = cpl_delta_sal(ig) + delta_sal(ig) / REAL(nexca) |
762 |
|
|
end if |
763 |
|
|
ENDDO |
764 |
|
|
|
765 |
|
|
!************************************************************************************* |
766 |
|
|
! If the time-step corresponds to the end of coupling period the |
767 |
|
|
! fields are transformed to the 2D grid. |
768 |
|
|
! No sending to the coupler (it is done from cpl_send_seaice_fields). |
769 |
|
|
! |
770 |
|
|
!************************************************************************************* |
771 |
|
✗ |
IF (MOD(itime, nexca) == 0) THEN |
772 |
|
|
|
773 |
|
✗ |
IF (.NOT. ALLOCATED(cpl_sols2D)) THEN |
774 |
|
|
sum_error = 0 |
775 |
|
✗ |
ALLOCATE(cpl_sols2D(nbp_lon,jj_nb,2), stat=error) |
776 |
|
|
sum_error = sum_error + error |
777 |
|
✗ |
ALLOCATE(cpl_nsol2D(nbp_lon,jj_nb,2), stat=error) |
778 |
|
✗ |
sum_error = sum_error + error |
779 |
|
✗ |
ALLOCATE(cpl_rain2D(nbp_lon,jj_nb,2), stat=error) |
780 |
|
✗ |
sum_error = sum_error + error |
781 |
|
✗ |
ALLOCATE(cpl_snow2D(nbp_lon,jj_nb,2), stat=error) |
782 |
|
✗ |
sum_error = sum_error + error |
783 |
|
✗ |
ALLOCATE(cpl_evap2D(nbp_lon,jj_nb,2), stat=error) |
784 |
|
✗ |
sum_error = sum_error + error |
785 |
|
✗ |
ALLOCATE(cpl_tsol2D(nbp_lon,jj_nb,2), stat=error) |
786 |
|
✗ |
sum_error = sum_error + error |
787 |
|
✗ |
ALLOCATE(cpl_fder2D(nbp_lon,jj_nb,2), stat=error) |
788 |
|
✗ |
sum_error = sum_error + error |
789 |
|
✗ |
ALLOCATE(cpl_albe2D(nbp_lon,jj_nb,2), stat=error) |
790 |
|
✗ |
sum_error = sum_error + error |
791 |
|
✗ |
ALLOCATE(cpl_taux2D(nbp_lon,jj_nb,2), stat=error) |
792 |
|
✗ |
sum_error = sum_error + error |
793 |
|
✗ |
ALLOCATE(cpl_tauy2D(nbp_lon,jj_nb,2), stat=error) |
794 |
|
✗ |
sum_error = sum_error + error |
795 |
|
✗ |
ALLOCATE(cpl_windsp2D(nbp_lon,jj_nb), stat=error) |
796 |
|
✗ |
sum_error = sum_error + error |
797 |
|
✗ |
ALLOCATE(cpl_sens_rain2D(nbp_lon,jj_nb,2), stat=error) |
798 |
|
✗ |
sum_error = sum_error + error |
799 |
|
✗ |
ALLOCATE(cpl_sens_snow2D(nbp_lon,jj_nb,2), stat=error) |
800 |
|
✗ |
sum_error = sum_error + error |
801 |
|
✗ |
ALLOCATE(cpl_taumod2D(nbp_lon,jj_nb,2), stat=error) |
802 |
|
✗ |
sum_error = sum_error + error |
803 |
|
|
|
804 |
|
✗ |
IF (carbon_cycle_cpl) THEN |
805 |
|
✗ |
ALLOCATE(cpl_atm_co22D(nbp_lon,jj_nb), stat=error) |
806 |
|
✗ |
sum_error = sum_error + error |
807 |
|
|
ENDIF |
808 |
|
|
|
809 |
|
✗ |
if (activate_ocean_skin == 2) then |
810 |
|
|
ALLOCATE(cpl_delta_sst_2D(nbp_lon, jj_nb), & |
811 |
|
✗ |
cpl_delta_sal_2D(nbp_lon, jj_nb), stat = error) |
812 |
|
✗ |
sum_error = sum_error + error |
813 |
|
|
end if |
814 |
|
|
|
815 |
|
✗ |
IF (sum_error /= 0) THEN |
816 |
|
✗ |
abort_message='Pb allocation variables couplees pour l''ecriture' |
817 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
818 |
|
|
ENDIF |
819 |
|
|
ENDIF |
820 |
|
|
|
821 |
|
|
|
822 |
|
|
CALL gath2cpl(cpl_sols(:,cpl_index), cpl_sols2D(:,:,cpl_index), & |
823 |
|
✗ |
knon, knindex) |
824 |
|
|
|
825 |
|
|
CALL gath2cpl(cpl_nsol(:,cpl_index), cpl_nsol2D(:,:,cpl_index), & |
826 |
|
✗ |
knon, knindex) |
827 |
|
|
|
828 |
|
|
CALL gath2cpl(cpl_rain(:,cpl_index), cpl_rain2D(:,:,cpl_index), & |
829 |
|
✗ |
knon, knindex) |
830 |
|
|
|
831 |
|
|
CALL gath2cpl(cpl_snow(:,cpl_index), cpl_snow2D(:,:,cpl_index), & |
832 |
|
✗ |
knon, knindex) |
833 |
|
|
|
834 |
|
|
CALL gath2cpl(cpl_evap(:,cpl_index), cpl_evap2D(:,:,cpl_index), & |
835 |
|
✗ |
knon, knindex) |
836 |
|
|
|
837 |
|
|
! cpl_tsol2D(:,:,:) not used! |
838 |
|
|
CALL gath2cpl(cpl_tsol(:,cpl_index), cpl_tsol2D(:,:, cpl_index), & |
839 |
|
✗ |
knon, knindex) |
840 |
|
|
|
841 |
|
|
! cpl_fder2D(:,:,1) not used, only cpl_fder(:,:,2)! |
842 |
|
|
CALL gath2cpl(cpl_fder(:,cpl_index), cpl_fder2D(:,:,cpl_index), & |
843 |
|
✗ |
knon, knindex) |
844 |
|
|
|
845 |
|
|
! cpl_albe2D(:,:,:) not used! |
846 |
|
|
CALL gath2cpl(cpl_albe(:,cpl_index), cpl_albe2D(:,:,cpl_index), & |
847 |
|
✗ |
knon, knindex) |
848 |
|
|
|
849 |
|
|
CALL gath2cpl(cpl_taux(:,cpl_index), cpl_taux2D(:,:,cpl_index), & |
850 |
|
✗ |
knon, knindex) |
851 |
|
|
|
852 |
|
|
CALL gath2cpl(cpl_tauy(:,cpl_index), cpl_tauy2D(:,:,cpl_index), & |
853 |
|
✗ |
knon, knindex) |
854 |
|
|
|
855 |
|
|
CALL gath2cpl(cpl_windsp(:,cpl_index), cpl_windsp2D(:,:), & |
856 |
|
✗ |
knon, knindex) |
857 |
|
|
|
858 |
|
|
CALL gath2cpl(cpl_sens_rain(:,cpl_index), cpl_sens_rain2D(:,:,cpl_index), & |
859 |
|
✗ |
knon, knindex) |
860 |
|
|
|
861 |
|
|
CALL gath2cpl(cpl_sens_snow(:,cpl_index), cpl_sens_snow2D(:,:,cpl_index), & |
862 |
|
✗ |
knon, knindex) |
863 |
|
|
|
864 |
|
|
CALL gath2cpl(cpl_taumod(:,cpl_index), cpl_taumod2D(:,:,cpl_index), & |
865 |
|
✗ |
knon, knindex) |
866 |
|
|
|
867 |
|
✗ |
IF (carbon_cycle_cpl) & |
868 |
|
✗ |
CALL gath2cpl(cpl_atm_co2(:,cpl_index), cpl_atm_co22D(:,:), knon, knindex) |
869 |
|
✗ |
if (activate_ocean_skin == 2) then |
870 |
|
✗ |
CALL gath2cpl(cpl_delta_sst, cpl_delta_sst_2D, knon, knindex) |
871 |
|
✗ |
CALL gath2cpl(cpl_delta_sal, cpl_delta_sal_2D, knon, knindex) |
872 |
|
|
end if |
873 |
|
|
ENDIF |
874 |
|
|
|
875 |
|
✗ |
END SUBROUTINE cpl_send_ocean_fields |
876 |
|
|
|
877 |
|
|
! |
878 |
|
|
!************************************************************************************* |
879 |
|
|
! |
880 |
|
|
|
881 |
|
✗ |
SUBROUTINE cpl_send_seaice_fields(itime, dtime, knon, knindex, & |
882 |
|
|
pctsrf, lafin, rlon, rlat, & |
883 |
|
✗ |
swdown, lwdown, fluxlat, fluxsens, & |
884 |
|
|
precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy,& |
885 |
|
✗ |
sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol) |
886 |
|
|
! |
887 |
|
|
! This subroutine cumulates some fields for each time-step during a coupling |
888 |
|
|
! period. At last time-step in a coupling period the fields are transformed to the |
889 |
|
|
! grid accepted by the coupler. All fields for all types of surfaces are sent to |
890 |
|
|
! the coupler. |
891 |
|
|
! |
892 |
|
|
USE carbon_cycle_mod, ONLY : carbon_cycle_cpl |
893 |
|
|
USE indice_sol_mod |
894 |
|
|
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
895 |
|
|
|
896 |
|
|
! Input arguments |
897 |
|
|
!************************************************************************************* |
898 |
|
|
INTEGER, INTENT(IN) :: itime |
899 |
|
|
INTEGER, INTENT(IN) :: knon |
900 |
|
|
INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
901 |
|
|
REAL, INTENT(IN) :: dtime |
902 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat |
903 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: swdown, lwdown |
904 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: fluxlat, fluxsens |
905 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow |
906 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: evap, tsurf, fder |
907 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: albsol, taux, tauy |
908 |
|
|
REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf |
909 |
|
|
REAL, INTENT(IN):: sens_prec_liq(:), sens_prec_sol(:) ! (knon) |
910 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: lat_prec_liq, lat_prec_sol |
911 |
|
|
LOGICAL, INTENT(IN) :: lafin |
912 |
|
|
|
913 |
|
|
! Local variables |
914 |
|
|
!************************************************************************************* |
915 |
|
|
INTEGER :: cpl_index, ig |
916 |
|
|
INTEGER :: error, sum_error |
917 |
|
|
CHARACTER(len = 25) :: modname = 'cpl_send_seaice_fields' |
918 |
|
|
CHARACTER(len = 80) :: abort_message |
919 |
|
✗ |
REAL, DIMENSION(klon) :: cpl_fder_tmp |
920 |
|
|
|
921 |
|
|
!************************************************************************************* |
922 |
|
|
! Start calulation |
923 |
|
|
! The sea-ice points are saved with second array index=2 |
924 |
|
|
! |
925 |
|
|
!************************************************************************************* |
926 |
|
|
cpl_index = 2 |
927 |
|
|
|
928 |
|
|
!************************************************************************************* |
929 |
|
|
! Reset fields to zero in the beginning of a new coupling period |
930 |
|
|
! |
931 |
|
|
!************************************************************************************* |
932 |
|
✗ |
IF (MOD(itime, nexca) == 1) THEN |
933 |
|
✗ |
cpl_sols(1:knon,cpl_index) = 0.0 |
934 |
|
✗ |
cpl_nsol(1:knon,cpl_index) = 0.0 |
935 |
|
✗ |
cpl_rain(1:knon,cpl_index) = 0.0 |
936 |
|
✗ |
cpl_snow(1:knon,cpl_index) = 0.0 |
937 |
|
✗ |
cpl_evap(1:knon,cpl_index) = 0.0 |
938 |
|
✗ |
cpl_tsol(1:knon,cpl_index) = 0.0 |
939 |
|
✗ |
cpl_fder(1:knon,cpl_index) = 0.0 |
940 |
|
✗ |
cpl_albe(1:knon,cpl_index) = 0.0 |
941 |
|
✗ |
cpl_taux(1:knon,cpl_index) = 0.0 |
942 |
|
✗ |
cpl_tauy(1:knon,cpl_index) = 0.0 |
943 |
|
✗ |
cpl_sens_rain(1:knon,cpl_index) = 0.0 |
944 |
|
✗ |
cpl_sens_snow(1:knon,cpl_index) = 0.0 |
945 |
|
✗ |
cpl_taumod(1:knon,cpl_index) = 0.0 |
946 |
|
|
ENDIF |
947 |
|
|
|
948 |
|
|
!************************************************************************************* |
949 |
|
|
! Cumulate at each time-step |
950 |
|
|
! |
951 |
|
|
!************************************************************************************* |
952 |
|
✗ |
DO ig = 1, knon |
953 |
|
|
cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + & |
954 |
|
✗ |
swdown(ig) / REAL(nexca) |
955 |
|
|
cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + & |
956 |
|
✗ |
(lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca) |
957 |
|
|
cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + & |
958 |
|
✗ |
precip_rain(ig) / REAL(nexca) |
959 |
|
|
cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + & |
960 |
|
✗ |
precip_snow(ig) / REAL(nexca) |
961 |
|
|
cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + & |
962 |
|
✗ |
evap(ig) / REAL(nexca) |
963 |
|
|
cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + & |
964 |
|
✗ |
tsurf(ig) / REAL(nexca) |
965 |
|
|
cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + & |
966 |
|
✗ |
fder(ig) / REAL(nexca) |
967 |
|
|
cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + & |
968 |
|
✗ |
albsol(ig) / REAL(nexca) |
969 |
|
|
cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + & |
970 |
|
✗ |
taux(ig) / REAL(nexca) |
971 |
|
|
cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + & |
972 |
|
✗ |
tauy(ig) / REAL(nexca) |
973 |
|
|
cpl_sens_rain(ig,cpl_index) = cpl_sens_rain(ig,cpl_index) + & |
974 |
|
✗ |
sens_prec_liq(ig) / REAL(nexca) |
975 |
|
|
cpl_sens_snow(ig,cpl_index) = cpl_sens_snow(ig,cpl_index) + & |
976 |
|
✗ |
sens_prec_sol(ig) / REAL(nexca) |
977 |
|
|
cpl_taumod(ig,cpl_index) = cpl_taumod(ig,cpl_index) + & |
978 |
|
✗ |
SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / REAL(nexca) |
979 |
|
|
ENDDO |
980 |
|
|
|
981 |
|
|
!************************************************************************************* |
982 |
|
|
! If the time-step corresponds to the end of coupling period the |
983 |
|
|
! fields are transformed to the 2D grid and all fields are sent to coupler. |
984 |
|
|
! |
985 |
|
|
!************************************************************************************* |
986 |
|
✗ |
IF (MOD(itime, nexca) == 0) THEN |
987 |
|
✗ |
IF (.NOT. ALLOCATED(cpl_sols2D)) THEN |
988 |
|
|
sum_error = 0 |
989 |
|
✗ |
ALLOCATE(cpl_sols2D(nbp_lon,jj_nb,2), stat=error) |
990 |
|
|
sum_error = sum_error + error |
991 |
|
✗ |
ALLOCATE(cpl_nsol2D(nbp_lon,jj_nb,2), stat=error) |
992 |
|
✗ |
sum_error = sum_error + error |
993 |
|
✗ |
ALLOCATE(cpl_rain2D(nbp_lon,jj_nb,2), stat=error) |
994 |
|
✗ |
sum_error = sum_error + error |
995 |
|
✗ |
ALLOCATE(cpl_snow2D(nbp_lon,jj_nb,2), stat=error) |
996 |
|
✗ |
sum_error = sum_error + error |
997 |
|
✗ |
ALLOCATE(cpl_evap2D(nbp_lon,jj_nb,2), stat=error) |
998 |
|
✗ |
sum_error = sum_error + error |
999 |
|
✗ |
ALLOCATE(cpl_tsol2D(nbp_lon,jj_nb,2), stat=error) |
1000 |
|
✗ |
sum_error = sum_error + error |
1001 |
|
✗ |
ALLOCATE(cpl_fder2D(nbp_lon,jj_nb,2), stat=error) |
1002 |
|
✗ |
sum_error = sum_error + error |
1003 |
|
✗ |
ALLOCATE(cpl_albe2D(nbp_lon,jj_nb,2), stat=error) |
1004 |
|
✗ |
sum_error = sum_error + error |
1005 |
|
✗ |
ALLOCATE(cpl_taux2D(nbp_lon,jj_nb,2), stat=error) |
1006 |
|
✗ |
sum_error = sum_error + error |
1007 |
|
✗ |
ALLOCATE(cpl_tauy2D(nbp_lon,jj_nb,2), stat=error) |
1008 |
|
✗ |
sum_error = sum_error + error |
1009 |
|
✗ |
ALLOCATE(cpl_windsp2D(nbp_lon,jj_nb), stat=error) |
1010 |
|
✗ |
sum_error = sum_error + error |
1011 |
|
✗ |
ALLOCATE(cpl_sens_rain2D(nbp_lon,jj_nb,2), stat=error) |
1012 |
|
✗ |
sum_error = sum_error + error |
1013 |
|
✗ |
ALLOCATE(cpl_sens_snow2D(nbp_lon,jj_nb,2), stat=error) |
1014 |
|
✗ |
sum_error = sum_error + error |
1015 |
|
✗ |
ALLOCATE(cpl_taumod2D(nbp_lon,jj_nb,2), stat=error) |
1016 |
|
✗ |
sum_error = sum_error + error |
1017 |
|
|
|
1018 |
|
✗ |
IF (carbon_cycle_cpl) THEN |
1019 |
|
✗ |
ALLOCATE(cpl_atm_co22D(nbp_lon,jj_nb), stat=error) |
1020 |
|
✗ |
sum_error = sum_error + error |
1021 |
|
|
ENDIF |
1022 |
|
|
|
1023 |
|
✗ |
IF (sum_error /= 0) THEN |
1024 |
|
✗ |
abort_message='Pb allocation variables couplees pour l''ecriture' |
1025 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
1026 |
|
|
ENDIF |
1027 |
|
|
ENDIF |
1028 |
|
|
|
1029 |
|
|
CALL gath2cpl(cpl_sols(:,cpl_index), cpl_sols2D(:,:,cpl_index), & |
1030 |
|
✗ |
knon, knindex) |
1031 |
|
|
|
1032 |
|
|
CALL gath2cpl(cpl_nsol(:,cpl_index), cpl_nsol2D(:,:,cpl_index), & |
1033 |
|
✗ |
knon, knindex) |
1034 |
|
|
|
1035 |
|
|
CALL gath2cpl(cpl_rain(:,cpl_index), cpl_rain2D(:,:,cpl_index), & |
1036 |
|
✗ |
knon, knindex) |
1037 |
|
|
|
1038 |
|
|
CALL gath2cpl(cpl_snow(:,cpl_index), cpl_snow2D(:,:,cpl_index), & |
1039 |
|
✗ |
knon, knindex) |
1040 |
|
|
|
1041 |
|
|
CALL gath2cpl(cpl_evap(:,cpl_index), cpl_evap2D(:,:,cpl_index), & |
1042 |
|
✗ |
knon, knindex) |
1043 |
|
|
|
1044 |
|
|
! cpl_tsol2D(:,:,:) not used! |
1045 |
|
|
CALL gath2cpl(cpl_tsol(:,cpl_index), cpl_tsol2D(:,:, cpl_index), & |
1046 |
|
✗ |
knon, knindex) |
1047 |
|
|
|
1048 |
|
|
! Set default value and decompress before gath2cpl |
1049 |
|
✗ |
cpl_fder_tmp(:) = -20. |
1050 |
|
✗ |
DO ig = 1, knon |
1051 |
|
✗ |
cpl_fder_tmp(knindex(ig))=cpl_fder(ig,cpl_index) |
1052 |
|
|
ENDDO |
1053 |
|
|
CALL gath2cpl(cpl_fder_tmp(:), cpl_fder2D(:,:,cpl_index), & |
1054 |
|
✗ |
klon, unity) |
1055 |
|
|
|
1056 |
|
|
! cpl_albe2D(:,:,:) not used! |
1057 |
|
|
CALL gath2cpl(cpl_albe(:,cpl_index), cpl_albe2D(:,:,cpl_index), & |
1058 |
|
✗ |
knon, knindex) |
1059 |
|
|
|
1060 |
|
|
CALL gath2cpl(cpl_taux(:,cpl_index), cpl_taux2D(:,:,cpl_index), & |
1061 |
|
✗ |
knon, knindex) |
1062 |
|
|
|
1063 |
|
|
CALL gath2cpl(cpl_tauy(:,cpl_index), cpl_tauy2D(:,:,cpl_index), & |
1064 |
|
✗ |
knon, knindex) |
1065 |
|
|
|
1066 |
|
|
CALL gath2cpl(cpl_sens_rain(:,cpl_index), cpl_sens_rain2D(:,:,cpl_index), & |
1067 |
|
✗ |
knon, knindex) |
1068 |
|
|
|
1069 |
|
|
CALL gath2cpl(cpl_sens_snow(:,cpl_index), cpl_sens_snow2D(:,:,cpl_index), & |
1070 |
|
✗ |
knon, knindex) |
1071 |
|
|
|
1072 |
|
|
CALL gath2cpl(cpl_taumod(:,cpl_index), cpl_taumod2D(:,:,cpl_index), & |
1073 |
|
✗ |
knon, knindex) |
1074 |
|
|
|
1075 |
|
|
! Send all fields |
1076 |
|
✗ |
CALL cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat) |
1077 |
|
|
ENDIF |
1078 |
|
|
|
1079 |
|
✗ |
END SUBROUTINE cpl_send_seaice_fields |
1080 |
|
|
|
1081 |
|
|
! |
1082 |
|
|
!************************************************************************************* |
1083 |
|
|
! |
1084 |
|
|
|
1085 |
|
✗ |
SUBROUTINE cpl_send_land_fields(itime, knon, knindex, rriv_in, rcoa_in) |
1086 |
|
|
! |
1087 |
|
|
! This subroutine cumulates some fields for each time-step during a coupling |
1088 |
|
|
! period. At last time-step in a coupling period the fields are transformed to the |
1089 |
|
|
! grid accepted by the coupler. No sending to the coupler will be done from here |
1090 |
|
|
! (it is done in cpl_send_seaice_fields). |
1091 |
|
|
! |
1092 |
|
|
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
1093 |
|
|
|
1094 |
|
|
! Input arguments |
1095 |
|
|
!************************************************************************************* |
1096 |
|
|
INTEGER, INTENT(IN) :: itime |
1097 |
|
|
INTEGER, INTENT(IN) :: knon |
1098 |
|
|
INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
1099 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: rriv_in |
1100 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: rcoa_in |
1101 |
|
|
|
1102 |
|
|
! Local variables |
1103 |
|
|
!************************************************************************************* |
1104 |
|
✗ |
REAL, DIMENSION(nbp_lon,jj_nb) :: rriv2D |
1105 |
|
✗ |
REAL, DIMENSION(nbp_lon,jj_nb) :: rcoa2D |
1106 |
|
|
|
1107 |
|
|
!************************************************************************************* |
1108 |
|
|
! Rearrange fields in 2D variables |
1109 |
|
|
! First initialize to zero to avoid unvalid points causing problems |
1110 |
|
|
! |
1111 |
|
|
!************************************************************************************* |
1112 |
|
|
!$OMP MASTER |
1113 |
|
✗ |
rriv2D(:,:) = 0.0 |
1114 |
|
✗ |
rcoa2D(:,:) = 0.0 |
1115 |
|
|
!$OMP END MASTER |
1116 |
|
✗ |
CALL gath2cpl(rriv_in, rriv2D, knon, knindex) |
1117 |
|
✗ |
CALL gath2cpl(rcoa_in, rcoa2D, knon, knindex) |
1118 |
|
|
|
1119 |
|
|
!************************************************************************************* |
1120 |
|
|
! Reset cumulated fields to zero in the beginning of a new coupling period |
1121 |
|
|
! |
1122 |
|
|
!************************************************************************************* |
1123 |
|
✗ |
IF (MOD(itime, nexca) == 1) THEN |
1124 |
|
|
!$OMP MASTER |
1125 |
|
✗ |
cpl_rriv2D(:,:) = 0.0 |
1126 |
|
✗ |
cpl_rcoa2D(:,:) = 0.0 |
1127 |
|
|
!$OMP END MASTER |
1128 |
|
|
ENDIF |
1129 |
|
|
|
1130 |
|
|
!************************************************************************************* |
1131 |
|
|
! Cumulate : Following fields should be cumulated at each time-step |
1132 |
|
|
! |
1133 |
|
|
!************************************************************************************* |
1134 |
|
|
!$OMP MASTER |
1135 |
|
✗ |
cpl_rriv2D(:,:) = cpl_rriv2D(:,:) + rriv2D(:,:) / REAL(nexca) |
1136 |
|
✗ |
cpl_rcoa2D(:,:) = cpl_rcoa2D(:,:) + rcoa2D(:,:) / REAL(nexca) |
1137 |
|
|
!$OMP END MASTER |
1138 |
|
|
|
1139 |
|
✗ |
END SUBROUTINE cpl_send_land_fields |
1140 |
|
|
|
1141 |
|
|
! |
1142 |
|
|
!************************************************************************************* |
1143 |
|
|
! |
1144 |
|
|
|
1145 |
|
✗ |
SUBROUTINE cpl_send_landice_fields(itime, knon, knindex, rlic_in) |
1146 |
|
|
! This subroutine cumulates the field for melting ice for each time-step |
1147 |
|
|
! during a coupling period. This routine will not send to coupler. Sending |
1148 |
|
|
! will be done in cpl_send_seaice_fields. |
1149 |
|
|
! |
1150 |
|
|
|
1151 |
|
|
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
1152 |
|
|
|
1153 |
|
|
! Input varibales |
1154 |
|
|
!************************************************************************************* |
1155 |
|
|
INTEGER, INTENT(IN) :: itime |
1156 |
|
|
INTEGER, INTENT(IN) :: knon |
1157 |
|
|
INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
1158 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: rlic_in |
1159 |
|
|
|
1160 |
|
|
! Local varibales |
1161 |
|
|
!************************************************************************************* |
1162 |
|
✗ |
REAL, DIMENSION(nbp_lon,jj_nb) :: rlic2D |
1163 |
|
|
|
1164 |
|
|
!************************************************************************************* |
1165 |
|
|
! Rearrange field in a 2D variable |
1166 |
|
|
! First initialize to zero to avoid unvalid points causing problems |
1167 |
|
|
! |
1168 |
|
|
!************************************************************************************* |
1169 |
|
|
!$OMP MASTER |
1170 |
|
✗ |
rlic2D(:,:) = 0.0 |
1171 |
|
|
!$OMP END MASTER |
1172 |
|
✗ |
CALL gath2cpl(rlic_in, rlic2D, knon, knindex) |
1173 |
|
|
|
1174 |
|
|
!************************************************************************************* |
1175 |
|
|
! Reset field to zero in the beginning of a new coupling period |
1176 |
|
|
! |
1177 |
|
|
!************************************************************************************* |
1178 |
|
✗ |
IF (MOD(itime, nexca) == 1) THEN |
1179 |
|
|
!$OMP MASTER |
1180 |
|
✗ |
cpl_rlic2D(:,:) = 0.0 |
1181 |
|
|
!$OMP END MASTER |
1182 |
|
|
ENDIF |
1183 |
|
|
|
1184 |
|
|
!************************************************************************************* |
1185 |
|
|
! Cumulate : Melting ice should be cumulated at each time-step |
1186 |
|
|
! |
1187 |
|
|
!************************************************************************************* |
1188 |
|
|
!$OMP MASTER |
1189 |
|
✗ |
cpl_rlic2D(:,:) = cpl_rlic2D(:,:) + rlic2D(:,:) / REAL(nexca) |
1190 |
|
|
!$OMP END MASTER |
1191 |
|
|
|
1192 |
|
✗ |
END SUBROUTINE cpl_send_landice_fields |
1193 |
|
|
|
1194 |
|
|
! |
1195 |
|
|
!************************************************************************************* |
1196 |
|
|
! |
1197 |
|
|
|
1198 |
|
✗ |
SUBROUTINE cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat) |
1199 |
|
|
! This routine will send fields for all different surfaces to the coupler. |
1200 |
|
|
! This subroutine should be executed after calculations by the last surface(sea-ice), |
1201 |
|
|
! all calculations at the different surfaces have to be done before. |
1202 |
|
|
! |
1203 |
|
|
USE surface_data |
1204 |
|
|
USE carbon_cycle_mod, ONLY : carbon_cycle_cpl |
1205 |
|
|
USE indice_sol_mod |
1206 |
|
|
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
1207 |
|
|
USE time_phylmdz_mod, ONLY: start_time, itau_phy |
1208 |
|
|
use config_ocean_skin_m, only: activate_ocean_skin |
1209 |
|
|
! Some includes |
1210 |
|
|
! |
1211 |
|
|
! Input arguments |
1212 |
|
|
!************************************************************************************* |
1213 |
|
|
INTEGER, INTENT(IN) :: itime |
1214 |
|
|
REAL, INTENT(IN) :: dtime |
1215 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat |
1216 |
|
|
REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf |
1217 |
|
|
LOGICAL, INTENT(IN) :: lafin |
1218 |
|
|
|
1219 |
|
|
! Local variables |
1220 |
|
|
!************************************************************************************* |
1221 |
|
|
INTEGER :: error, sum_error, i,j,k |
1222 |
|
|
INTEGER :: itau_w |
1223 |
|
|
INTEGER :: time_sec |
1224 |
|
✗ |
INTEGER, DIMENSION(nbp_lon*(nbp_lat)) :: ndexct |
1225 |
|
|
REAL :: Up, Down |
1226 |
|
✗ |
REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_lon, tmp_lat |
1227 |
|
✗ |
REAL, DIMENSION(nbp_lon, jj_nb, 4) :: pctsrf2D |
1228 |
|
✗ |
REAL, DIMENSION(nbp_lon, jj_nb) :: deno |
1229 |
|
|
CHARACTER(len = 20) :: modname = 'cpl_send_all' |
1230 |
|
|
CHARACTER(len = 80) :: abort_message |
1231 |
|
|
|
1232 |
|
|
! Variables with fields to coupler |
1233 |
|
✗ |
REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_taux |
1234 |
|
✗ |
REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_tauy |
1235 |
|
✗ |
REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_calv |
1236 |
|
|
! Table with all fields to send to coupler |
1237 |
|
✗ |
REAL, DIMENSION(nbp_lon, jj_nb, maxsend) :: tab_flds |
1238 |
|
✗ |
REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi |
1239 |
|
|
REAL :: calving(nb_zone_calving) |
1240 |
|
|
REAL :: calving_glo(nb_zone_calving) |
1241 |
|
|
|
1242 |
|
|
|
1243 |
|
|
! End definitions |
1244 |
|
|
!************************************************************************************* |
1245 |
|
|
|
1246 |
|
|
|
1247 |
|
|
|
1248 |
|
|
!************************************************************************************* |
1249 |
|
|
! All fields are stored in a table tab_flds(:,:,:) |
1250 |
|
|
! First store the fields which are already on the right format |
1251 |
|
|
! |
1252 |
|
|
!************************************************************************************* |
1253 |
|
|
!$OMP MASTER |
1254 |
|
✗ |
tab_flds(:,:,ids_windsp) = cpl_windsp2D(:,:) |
1255 |
|
✗ |
tab_flds(:,:,ids_shfice) = cpl_sols2D(:,:,2) |
1256 |
|
✗ |
tab_flds(:,:,ids_nsfice) = cpl_nsol2D(:,:,2) |
1257 |
|
✗ |
tab_flds(:,:,ids_dflxdt) = cpl_fder2D(:,:,2) |
1258 |
|
✗ |
tab_flds(:,:,ids_qraioc) = cpl_sens_rain2D(:,:,1) |
1259 |
|
✗ |
tab_flds(:,:,ids_qsnooc) = cpl_sens_snow2D(:,:,1) |
1260 |
|
✗ |
tab_flds(:,:,ids_qraiic) = cpl_sens_rain2D(:,:,2) |
1261 |
|
✗ |
tab_flds(:,:,ids_qsnoic) = cpl_sens_snow2D(:,:,2) |
1262 |
|
|
|
1263 |
|
✗ |
if (activate_ocean_skin == 2) then |
1264 |
|
✗ |
tab_flds(:, :, ids_delta_sst) = cpl_delta_sst_2D |
1265 |
|
✗ |
tab_flds(:, :, ids_delta_sal) = cpl_delta_sal_2D |
1266 |
|
|
end if |
1267 |
|
|
|
1268 |
|
✗ |
IF (version_ocean=='nemo') THEN |
1269 |
|
✗ |
tab_flds(:,:,ids_liqrun) = (cpl_rriv2D(:,:) + cpl_rcoa2D(:,:)) |
1270 |
|
✗ |
IF (carbon_cycle_cpl) tab_flds(:,:,ids_atmco2)=cpl_atm_co22D(:,:) |
1271 |
|
✗ |
ELSE IF (version_ocean=='opa8') THEN |
1272 |
|
✗ |
tab_flds(:,:,ids_shfoce) = cpl_sols2D(:,:,1) |
1273 |
|
✗ |
tab_flds(:,:,ids_nsfoce) = cpl_nsol2D(:,:,1) |
1274 |
|
✗ |
tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2) |
1275 |
|
✗ |
tab_flds(:,:,ids_ocevap) = cpl_evap2D(:,:,1) |
1276 |
|
✗ |
tab_flds(:,:,ids_runcoa) = cpl_rcoa2D(:,:) |
1277 |
|
✗ |
tab_flds(:,:,ids_rivflu) = cpl_rriv2D(:,:) |
1278 |
|
|
ENDIF |
1279 |
|
|
|
1280 |
|
|
!************************************************************************************* |
1281 |
|
|
! Transform the fraction of sub-surfaces from 1D to 2D array |
1282 |
|
|
! |
1283 |
|
|
!************************************************************************************* |
1284 |
|
✗ |
pctsrf2D(:,:,:) = 0. |
1285 |
|
|
!$OMP END MASTER |
1286 |
|
✗ |
CALL gath2cpl(pctsrf(:,is_oce), pctsrf2D(:,:,is_oce), klon, unity) |
1287 |
|
✗ |
CALL gath2cpl(pctsrf(:,is_sic), pctsrf2D(:,:,is_sic), klon, unity) |
1288 |
|
✗ |
CALL gath2cpl(pctsrf(:,is_lic), pctsrf2D(:,:,is_lic), klon, unity) |
1289 |
|
|
|
1290 |
|
|
!************************************************************************************* |
1291 |
|
|
! Calculate the average calving per latitude |
1292 |
|
|
! Store calving in tab_flds(:,:,19) |
1293 |
|
|
! |
1294 |
|
|
!************************************************************************************* |
1295 |
|
✗ |
IF (is_omp_root) THEN |
1296 |
|
|
|
1297 |
|
✗ |
IF (cpl_old_calving) THEN ! use old calving |
1298 |
|
|
|
1299 |
|
✗ |
DO j = 1, jj_nb |
1300 |
|
|
tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:nbp_lon,j), & |
1301 |
|
✗ |
pctsrf2D(1:nbp_lon,j,is_lic)) / REAL(nbp_lon) |
1302 |
|
|
ENDDO |
1303 |
|
|
|
1304 |
|
|
|
1305 |
|
✗ |
IF (is_parallel) THEN |
1306 |
|
|
IF (.NOT. is_north_pole_dyn) THEN |
1307 |
|
|
ENDIF |
1308 |
|
|
|
1309 |
|
|
IF (.NOT. is_south_pole_dyn) THEN |
1310 |
|
|
ENDIF |
1311 |
|
|
|
1312 |
|
✗ |
IF (.NOT. is_north_pole_dyn .AND. ii_begin /=1) THEN |
1313 |
|
✗ |
Up=Up+tmp_calv(nbp_lon,1) |
1314 |
|
✗ |
tmp_calv(:,1)=Up |
1315 |
|
|
ENDIF |
1316 |
|
|
|
1317 |
|
✗ |
IF (.NOT. is_south_pole_dyn .AND. ii_end /= nbp_lon) THEN |
1318 |
|
✗ |
Down=Down+tmp_calv(1,jj_nb) |
1319 |
|
✗ |
tmp_calv(:,jj_nb)=Down |
1320 |
|
|
ENDIF |
1321 |
|
|
ENDIF |
1322 |
|
✗ |
tab_flds(:,:,ids_calvin) = tmp_calv(:,:) |
1323 |
|
|
|
1324 |
|
|
ELSE |
1325 |
|
|
! cpl_old_calving=FALSE |
1326 |
|
|
! To be used with new method for calculation of coupling weights |
1327 |
|
|
DO k=1,nb_zone_calving |
1328 |
|
|
calving(k)=0 |
1329 |
|
|
DO j = 1, jj_nb |
1330 |
|
|
calving(k)= calving(k)+DOT_PRODUCT(cpl_rlic2D(:,j)*area_calving(:,j,k),pctsrf2D(:,j,is_lic)) |
1331 |
|
|
ENDDO |
1332 |
|
|
ENDDO |
1333 |
|
|
|
1334 |
|
|
|
1335 |
|
✗ |
tab_flds(:,:,ids_calvin) = 0 |
1336 |
|
✗ |
DO k=1,nb_zone_calving |
1337 |
|
✗ |
IF (ind_calving(k)>0 ) THEN |
1338 |
|
✗ |
j=(ind_calving(k)-1)/nbp_lon + 1 |
1339 |
|
✗ |
i=MOD(ind_calving(k)-1,nbp_lon)+1 |
1340 |
|
✗ |
tab_flds(i,j,ids_calvin) = calving_glo(k) |
1341 |
|
|
ENDIF |
1342 |
|
|
ENDDO |
1343 |
|
|
|
1344 |
|
|
ENDIF |
1345 |
|
|
|
1346 |
|
|
!************************************************************************************* |
1347 |
|
|
! Calculate total flux for snow, rain and wind with weighted addition using the |
1348 |
|
|
! fractions of ocean and seaice. |
1349 |
|
|
! |
1350 |
|
|
!************************************************************************************* |
1351 |
|
|
! fraction oce+seaice |
1352 |
|
✗ |
deno = pctsrf2D(:,:,is_oce) + pctsrf2D(:,:,is_sic) |
1353 |
|
|
|
1354 |
|
✗ |
IF (version_ocean=='nemo') THEN |
1355 |
|
✗ |
tab_flds(:,:,ids_shftot) = 0.0 |
1356 |
|
✗ |
tab_flds(:,:,ids_nsftot) = 0.0 |
1357 |
|
✗ |
tab_flds(:,:,ids_totrai) = 0.0 |
1358 |
|
✗ |
tab_flds(:,:,ids_totsno) = 0.0 |
1359 |
|
✗ |
tab_flds(:,:,ids_toteva) = 0.0 |
1360 |
|
✗ |
tab_flds(:,:,ids_taumod) = 0.0 |
1361 |
|
|
|
1362 |
|
✗ |
tmp_taux(:,:) = 0.0 |
1363 |
|
✗ |
tmp_tauy(:,:) = 0.0 |
1364 |
|
|
! For all valid grid cells containing some fraction of ocean or sea-ice |
1365 |
|
✗ |
WHERE ( deno(:,:) /= 0 ) |
1366 |
|
|
tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
1367 |
|
|
cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
1368 |
|
|
tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
1369 |
|
|
cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
1370 |
|
|
|
1371 |
|
|
tab_flds(:,:,ids_shftot) = cpl_sols2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
1372 |
|
|
cpl_sols2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
1373 |
|
|
tab_flds(:,:,ids_nsftot) = cpl_nsol2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
1374 |
|
|
cpl_nsol2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
1375 |
|
|
tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
1376 |
|
|
cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
1377 |
|
|
tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
1378 |
|
|
cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
1379 |
|
|
tab_flds(:,:,ids_toteva) = cpl_evap2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
1380 |
|
|
cpl_evap2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
1381 |
|
|
tab_flds(:,:,ids_taumod) = cpl_taumod2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
1382 |
|
|
cpl_taumod2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
1383 |
|
|
|
1384 |
|
|
ENDWHERE |
1385 |
|
|
|
1386 |
|
✗ |
tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2) |
1387 |
|
|
|
1388 |
|
✗ |
ELSE IF (version_ocean=='opa8') THEN |
1389 |
|
|
! Store fields for rain and snow in tab_flds(:,:,15) and tab_flds(:,:,16) |
1390 |
|
✗ |
tab_flds(:,:,ids_totrai) = 0.0 |
1391 |
|
✗ |
tab_flds(:,:,ids_totsno) = 0.0 |
1392 |
|
✗ |
tmp_taux(:,:) = 0.0 |
1393 |
|
✗ |
tmp_tauy(:,:) = 0.0 |
1394 |
|
|
! For all valid grid cells containing some fraction of ocean or sea-ice |
1395 |
|
✗ |
WHERE ( deno(:,:) /= 0 ) |
1396 |
|
|
tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
1397 |
|
|
cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
1398 |
|
|
tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
1399 |
|
|
cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
1400 |
|
|
|
1401 |
|
|
tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
1402 |
|
|
cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
1403 |
|
|
tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
1404 |
|
|
cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
1405 |
|
|
ENDWHERE |
1406 |
|
|
ENDIF |
1407 |
|
|
|
1408 |
|
|
ENDIF ! is_omp_root |
1409 |
|
|
|
1410 |
|
|
!************************************************************************************* |
1411 |
|
|
! Transform the wind components from local atmospheric 2D coordinates to geocentric |
1412 |
|
|
! 3D coordinates. |
1413 |
|
|
! Store the resulting wind components in tab_flds(:,:,1:6) |
1414 |
|
|
!************************************************************************************* |
1415 |
|
|
|
1416 |
|
|
! Transform the longitudes and latitudes on 2D arrays |
1417 |
|
|
|
1418 |
|
✗ |
CALL gather_omp(rlon,rlon_mpi) |
1419 |
|
✗ |
CALL gather_omp(rlat,rlat_mpi) |
1420 |
|
|
!$OMP MASTER |
1421 |
|
✗ |
CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon) |
1422 |
|
✗ |
CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat) |
1423 |
|
|
!$OMP END MASTER |
1424 |
|
|
|
1425 |
|
✗ |
IF (is_sequential) THEN |
1426 |
|
✗ |
IF (is_north_pole_dyn) tmp_lon(:,1) = tmp_lon(:,2) |
1427 |
|
✗ |
IF (is_south_pole_dyn) tmp_lon(:,nbp_lat) = tmp_lon(:,nbp_lat-1) |
1428 |
|
|
ENDIF |
1429 |
|
|
|
1430 |
|
|
! NetCDF output of the wind before transformation of coordinate system |
1431 |
|
✗ |
IF (is_sequential) THEN |
1432 |
|
✗ |
ndexct(:) = 0 |
1433 |
|
✗ |
itau_w = itau_phy + itime + start_time * day_step_phy |
1434 |
|
✗ |
CALL histwrite(nidct,'tauxe',itau_w,tmp_taux,nbp_lon*(nbp_lat),ndexct) |
1435 |
|
✗ |
CALL histwrite(nidct,'tauyn',itau_w,tmp_tauy,nbp_lon*(nbp_lat),ndexct) |
1436 |
|
✗ |
CALL histwrite(nidct,'tmp_lon',itau_w,tmp_lon,nbp_lon*(nbp_lat),ndexct) |
1437 |
|
✗ |
CALL histwrite(nidct,'tmp_lat',itau_w,tmp_lat,nbp_lon*(nbp_lat),ndexct) |
1438 |
|
|
ENDIF |
1439 |
|
|
|
1440 |
|
|
! Transform the wind from spherical atmospheric 2D coordinates to geocentric |
1441 |
|
|
! cartesian 3D coordinates |
1442 |
|
|
!$OMP MASTER |
1443 |
|
|
CALL atm2geo (nbp_lon, jj_nb, tmp_taux, tmp_tauy, tmp_lon, tmp_lat, & |
1444 |
|
✗ |
tab_flds(:,:,ids_tauxxu), tab_flds(:,:,ids_tauyyu), tab_flds(:,:,ids_tauzzu) ) |
1445 |
|
|
|
1446 |
|
✗ |
tab_flds(:,:,ids_tauxxv) = tab_flds(:,:,ids_tauxxu) |
1447 |
|
✗ |
tab_flds(:,:,ids_tauyyv) = tab_flds(:,:,ids_tauyyu) |
1448 |
|
✗ |
tab_flds(:,:,ids_tauzzv) = tab_flds(:,:,ids_tauzzu) |
1449 |
|
|
!$OMP END MASTER |
1450 |
|
|
|
1451 |
|
|
!************************************************************************************* |
1452 |
|
|
! NetCDF output of all fields just before sending to coupler. |
1453 |
|
|
! |
1454 |
|
|
!************************************************************************************* |
1455 |
|
✗ |
IF (is_sequential) THEN |
1456 |
|
✗ |
DO j=1,maxsend |
1457 |
|
✗ |
IF (infosend(j)%action) CALL histwrite(nidct,infosend(j)%name, itau_w, & |
1458 |
|
✗ |
tab_flds(:,:,j),nbp_lon*(nbp_lat),ndexct) |
1459 |
|
|
ENDDO |
1460 |
|
|
ENDIF |
1461 |
|
|
!************************************************************************************* |
1462 |
|
|
! Send the table of all fields |
1463 |
|
|
! |
1464 |
|
|
!************************************************************************************* |
1465 |
|
|
time_sec=(itime-1)*dtime |
1466 |
|
|
|
1467 |
|
|
!************************************************************************************* |
1468 |
|
|
! Finish with some dellocate |
1469 |
|
|
! |
1470 |
|
|
!************************************************************************************* |
1471 |
|
|
sum_error=0 |
1472 |
|
✗ |
DEALLOCATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D, cpl_snow2D, stat=error ) |
1473 |
|
|
sum_error = sum_error + error |
1474 |
|
✗ |
DEALLOCATE(cpl_evap2D, cpl_tsol2D, cpl_fder2D, cpl_albe2D, stat=error ) |
1475 |
|
✗ |
sum_error = sum_error + error |
1476 |
|
✗ |
DEALLOCATE(cpl_taux2D, cpl_tauy2D, cpl_windsp2D, cpl_taumod2D, stat=error ) |
1477 |
|
✗ |
sum_error = sum_error + error |
1478 |
|
✗ |
DEALLOCATE(cpl_sens_rain2D, cpl_sens_snow2D, stat=error) |
1479 |
|
✗ |
sum_error = sum_error + error |
1480 |
|
|
|
1481 |
|
|
|
1482 |
|
✗ |
IF (carbon_cycle_cpl) THEN |
1483 |
|
✗ |
DEALLOCATE(cpl_atm_co22D, stat=error ) |
1484 |
|
✗ |
sum_error = sum_error + error |
1485 |
|
|
ENDIF |
1486 |
|
|
|
1487 |
|
✗ |
if (activate_ocean_skin == 2) deallocate(cpl_delta_sst_2d, cpl_delta_sal_2d) |
1488 |
|
|
|
1489 |
|
✗ |
IF (sum_error /= 0) THEN |
1490 |
|
✗ |
abort_message='Pb in deallocation of cpl_xxxx2D coupling variables' |
1491 |
|
✗ |
CALL abort_physic(modname,abort_message,1) |
1492 |
|
|
ENDIF |
1493 |
|
|
|
1494 |
|
✗ |
END SUBROUTINE cpl_send_all |
1495 |
|
|
! |
1496 |
|
|
!************************************************************************************* |
1497 |
|
|
! |
1498 |
|
✗ |
SUBROUTINE cpl2gath(champ_in, champ_out, knon, knindex) |
1499 |
|
|
USE mod_phys_lmdz_para |
1500 |
|
|
! Cette routine transforme un champs de la grille 2D recu du coupleur sur la grille |
1501 |
|
|
! 'gathered' (la grille physiq comprime). |
1502 |
|
|
! |
1503 |
|
|
! |
1504 |
|
|
! input: |
1505 |
|
|
! champ_in champ sur la grille 2D |
1506 |
|
|
! knon nombre de points dans le domaine a traiter |
1507 |
|
|
! knindex index des points de la surface a traiter |
1508 |
|
|
! |
1509 |
|
|
! output: |
1510 |
|
|
! champ_out champ sur la grille 'gatherd' |
1511 |
|
|
! |
1512 |
|
|
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
1513 |
|
|
|
1514 |
|
|
! Input |
1515 |
|
|
INTEGER, INTENT(IN) :: knon |
1516 |
|
|
REAL, DIMENSION(nbp_lon,jj_nb), INTENT(IN) :: champ_in |
1517 |
|
|
INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
1518 |
|
|
|
1519 |
|
|
! Output |
1520 |
|
|
REAL, DIMENSION(klon_mpi), INTENT(OUT) :: champ_out |
1521 |
|
|
|
1522 |
|
|
! Local |
1523 |
|
|
INTEGER :: i, ig |
1524 |
|
✗ |
REAL, DIMENSION(klon_mpi) :: temp_mpi |
1525 |
|
✗ |
REAL, DIMENSION(klon) :: temp_omp |
1526 |
|
|
|
1527 |
|
|
!************************************************************************************* |
1528 |
|
|
! |
1529 |
|
|
|
1530 |
|
|
|
1531 |
|
|
! Transform from 2 dimensions (nbp_lon,jj_nb) to 1 dimension (klon) |
1532 |
|
|
!$OMP MASTER |
1533 |
|
✗ |
CALL Grid2Dto1D_mpi(champ_in,temp_mpi) |
1534 |
|
|
!$OMP END MASTER |
1535 |
|
|
|
1536 |
|
✗ |
CALL scatter_omp(temp_mpi,temp_omp) |
1537 |
|
|
|
1538 |
|
|
! Compress from klon to knon |
1539 |
|
✗ |
DO i = 1, knon |
1540 |
|
✗ |
ig = knindex(i) |
1541 |
|
✗ |
champ_out(i) = temp_omp(ig) |
1542 |
|
|
ENDDO |
1543 |
|
|
|
1544 |
|
✗ |
END SUBROUTINE cpl2gath |
1545 |
|
|
! |
1546 |
|
|
!************************************************************************************* |
1547 |
|
|
! |
1548 |
|
✗ |
SUBROUTINE gath2cpl(champ_in, champ_out, knon, knindex) |
1549 |
|
|
USE mod_phys_lmdz_para |
1550 |
|
|
! Cette routine ecrit un champ 'gathered' sur la grille 2D pour le passer |
1551 |
|
|
! au coupleur. |
1552 |
|
|
! |
1553 |
|
|
! input: |
1554 |
|
|
! champ_in champ sur la grille gathere |
1555 |
|
|
! knon nombre de points dans le domaine a traiter |
1556 |
|
|
! knindex index des points de la surface a traiter |
1557 |
|
|
! |
1558 |
|
|
! output: |
1559 |
|
|
! champ_out champ sur la grille 2D |
1560 |
|
|
! |
1561 |
|
|
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
1562 |
|
|
|
1563 |
|
|
! Input arguments |
1564 |
|
|
!************************************************************************************* |
1565 |
|
|
INTEGER, INTENT(IN) :: knon |
1566 |
|
|
REAL, DIMENSION(klon), INTENT(IN) :: champ_in |
1567 |
|
|
INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
1568 |
|
|
|
1569 |
|
|
! Output arguments |
1570 |
|
|
!************************************************************************************* |
1571 |
|
|
REAL, DIMENSION(nbp_lon,jj_nb), INTENT(OUT) :: champ_out |
1572 |
|
|
|
1573 |
|
|
! Local variables |
1574 |
|
|
!************************************************************************************* |
1575 |
|
|
INTEGER :: i, ig |
1576 |
|
✗ |
REAL, DIMENSION(klon) :: temp_omp |
1577 |
|
✗ |
REAL, DIMENSION(klon_mpi) :: temp_mpi |
1578 |
|
|
!************************************************************************************* |
1579 |
|
|
|
1580 |
|
|
! Decompress from knon to klon |
1581 |
|
✗ |
temp_omp = 0. |
1582 |
|
✗ |
DO i = 1, knon |
1583 |
|
✗ |
ig = knindex(i) |
1584 |
|
✗ |
temp_omp(ig) = champ_in(i) |
1585 |
|
|
ENDDO |
1586 |
|
|
|
1587 |
|
|
! Transform from 1 dimension (klon) to 2 dimensions (nbp_lon,jj_nb) |
1588 |
|
✗ |
CALL gather_omp(temp_omp,temp_mpi) |
1589 |
|
|
|
1590 |
|
|
!$OMP MASTER |
1591 |
|
✗ |
CALL Grid1Dto2D_mpi(temp_mpi,champ_out) |
1592 |
|
|
|
1593 |
|
✗ |
IF (is_north_pole_dyn) champ_out(:,1)=temp_mpi(1) |
1594 |
|
✗ |
IF (is_south_pole_dyn) champ_out(:,jj_nb)=temp_mpi(klon) |
1595 |
|
|
!$OMP END MASTER |
1596 |
|
|
|
1597 |
|
✗ |
END SUBROUTINE gath2cpl |
1598 |
|
|
! |
1599 |
|
|
!************************************************************************************* |
1600 |
|
|
! |
1601 |
|
|
END MODULE cpl_mod |
1602 |
|
|
|
1603 |
|
|
|