[782] | 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 | !************************************************************************************* |
---|
[836] | 17 | USE dimphy, ONLY : klon |
---|
[782] | 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 | |
---|
| 27 | ! Global attributes |
---|
| 28 | !************************************************************************************* |
---|
| 29 | IMPLICIT NONE |
---|
| 30 | PRIVATE |
---|
| 31 | |
---|
[996] | 32 | ! All subroutine are public except cpl_send_all |
---|
| 33 | PUBLIC :: cpl_init, cpl_receive_frac, cpl_receive_ocean_fields, cpl_receive_seaice_fields, & |
---|
[782] | 34 | cpl_send_ocean_fields, cpl_send_seaice_fields, cpl_send_land_fields, & |
---|
| 35 | cpl_send_landice_fields, gath2cpl |
---|
| 36 | |
---|
| 37 | |
---|
| 38 | ! Declaration of module variables |
---|
| 39 | !************************************************************************************* |
---|
| 40 | ! variable for coupling period |
---|
| 41 | INTEGER, SAVE :: nexca |
---|
| 42 | !$OMP THREADPRIVATE(nexca) |
---|
| 43 | |
---|
| 44 | ! variables for cumulating fields during a coupling periode : |
---|
| 45 | REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_sols, cpl_nsol, cpl_rain |
---|
| 46 | !$OMP THREADPRIVATE(cpl_sols,cpl_nsol,cpl_rain) |
---|
| 47 | REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_snow, cpl_evap, cpl_tsol |
---|
| 48 | !$OMP THREADPRIVATE(cpl_snow,cpl_evap,cpl_tsol) |
---|
| 49 | REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_fder, cpl_albe, cpl_taux |
---|
| 50 | !$OMP THREADPRIVATE(cpl_fder,cpl_albe,cpl_taux) |
---|
| 51 | REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_windsp |
---|
| 52 | !$OMP THREADPRIVATE(cpl_windsp) |
---|
| 53 | REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_tauy |
---|
| 54 | !$OMP THREADPRIVATE(cpl_tauy) |
---|
| 55 | REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_rriv2D, cpl_rcoa2D, cpl_rlic2D |
---|
| 56 | !$OMP THREADPRIVATE(cpl_rriv2D,cpl_rcoa2D,cpl_rlic2D) |
---|
| 57 | |
---|
| 58 | ! variables read from coupler : |
---|
| 59 | REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sst ! sea surface temperature |
---|
| 60 | !$OMP THREADPRIVATE(read_sst) |
---|
| 61 | REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sit ! sea ice temperature |
---|
| 62 | !$OMP THREADPRIVATE(read_sit) |
---|
| 63 | REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sic ! sea ice fraction |
---|
| 64 | !$OMP THREADPRIVATE(read_sic) |
---|
| 65 | REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_alb_sic ! albedo at sea ice |
---|
| 66 | !$OMP THREADPRIVATE(read_alb_sic) |
---|
[1067] | 67 | REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_u0, read_v0 ! ocean surface current |
---|
| 68 | !$OMP THREADPRIVATE(read_u0,read_v0) |
---|
[782] | 69 | |
---|
| 70 | INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: unity |
---|
| 71 | !$OMP THREADPRIVATE(unity) |
---|
| 72 | INTEGER, SAVE :: nidct, nidcs |
---|
| 73 | !$OMP THREADPRIVATE(nidct,nidcs) |
---|
| 74 | |
---|
| 75 | ! variables to be sent to the coupler |
---|
| 76 | REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_sols2D, cpl_nsol2D, cpl_rain2D |
---|
| 77 | !$OMP THREADPRIVATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D) |
---|
| 78 | REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_snow2D, cpl_evap2D, cpl_tsol2D |
---|
| 79 | !$OMP THREADPRIVATE(cpl_snow2D, cpl_evap2D, cpl_tsol2D) |
---|
| 80 | REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_fder2D, cpl_albe2D |
---|
| 81 | !$OMP THREADPRIVATE(cpl_fder2D, cpl_albe2D) |
---|
| 82 | REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taux2D, cpl_tauy2D |
---|
| 83 | !$OMP THREADPRIVATE(cpl_taux2D, cpl_tauy2D) |
---|
| 84 | REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_windsp2D |
---|
| 85 | !$OMP THREADPRIVATE(cpl_windsp2D) |
---|
| 86 | |
---|
[1001] | 87 | ! variable for OPENMP parallelisation |
---|
| 88 | |
---|
[987] | 89 | INTEGER,ALLOCATABLE,DIMENSION(:),SAVE :: knon_omp |
---|
| 90 | REAL,ALLOCATABLE,DIMENSION(:,:),SAVE :: buffer_omp |
---|
| 91 | |
---|
[782] | 92 | CONTAINS |
---|
| 93 | ! |
---|
| 94 | !************************************************************************************ |
---|
| 95 | ! |
---|
| 96 | SUBROUTINE cpl_init(dtime, rlon, rlat) |
---|
| 97 | |
---|
[793] | 98 | INCLUDE "dimensions.h" |
---|
| 99 | INCLUDE "indicesol.h" |
---|
| 100 | INCLUDE "control.h" |
---|
| 101 | INCLUDE "temps.h" |
---|
[782] | 102 | INCLUDE "iniprint.h" |
---|
| 103 | |
---|
| 104 | ! Input arguments |
---|
| 105 | !************************************************************************************* |
---|
| 106 | REAL, INTENT(IN) :: dtime |
---|
| 107 | REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat |
---|
| 108 | |
---|
| 109 | ! Local variables |
---|
| 110 | !************************************************************************************* |
---|
| 111 | INTEGER :: error, sum_error, ig, i |
---|
| 112 | INTEGER :: jf, nhoridct |
---|
| 113 | INTEGER :: nhoridcs |
---|
| 114 | INTEGER :: idtime |
---|
| 115 | INTEGER :: idayref |
---|
| 116 | INTEGER :: npas ! only for OASIS2 |
---|
| 117 | REAL :: zjulian |
---|
| 118 | REAL, DIMENSION(iim,jjm+1) :: zx_lon, zx_lat |
---|
| 119 | CHARACTER(len = 20) :: modname = 'cpl_init' |
---|
| 120 | CHARACTER(len = 80) :: abort_message |
---|
| 121 | CHARACTER(len=80) :: clintocplnam, clfromcplnam |
---|
| 122 | |
---|
| 123 | !************************************************************************************* |
---|
| 124 | ! Calculate coupling period |
---|
| 125 | ! |
---|
| 126 | !************************************************************************************* |
---|
| 127 | |
---|
| 128 | npas = itaufin/ iphysiq |
---|
| 129 | nexca = 86400 / dtime |
---|
| 130 | WRITE(lunout,*)' ##### Ocean couple #####' |
---|
| 131 | WRITE(lunout,*)' Valeurs des pas de temps' |
---|
| 132 | WRITE(lunout,*)' npas = ', npas |
---|
| 133 | WRITE(lunout,*)' nexca = ', nexca |
---|
| 134 | |
---|
| 135 | !************************************************************************************* |
---|
| 136 | ! Allocate variables |
---|
| 137 | ! |
---|
| 138 | !************************************************************************************* |
---|
| 139 | error = 0 |
---|
| 140 | sum_error = 0 |
---|
| 141 | |
---|
| 142 | ALLOCATE(unity(klon), stat = error) |
---|
| 143 | sum_error = sum_error + error |
---|
| 144 | ALLOCATE(cpl_sols(klon,2), stat = error) |
---|
| 145 | sum_error = sum_error + error |
---|
| 146 | ALLOCATE(cpl_nsol(klon,2), stat = error) |
---|
| 147 | sum_error = sum_error + error |
---|
| 148 | ALLOCATE(cpl_rain(klon,2), stat = error) |
---|
| 149 | sum_error = sum_error + error |
---|
| 150 | ALLOCATE(cpl_snow(klon,2), stat = error) |
---|
| 151 | sum_error = sum_error + error |
---|
| 152 | ALLOCATE(cpl_evap(klon,2), stat = error) |
---|
| 153 | sum_error = sum_error + error |
---|
| 154 | ALLOCATE(cpl_tsol(klon,2), stat = error) |
---|
| 155 | sum_error = sum_error + error |
---|
| 156 | ALLOCATE(cpl_fder(klon,2), stat = error) |
---|
| 157 | sum_error = sum_error + error |
---|
| 158 | ALLOCATE(cpl_albe(klon,2), stat = error) |
---|
| 159 | sum_error = sum_error + error |
---|
| 160 | ALLOCATE(cpl_taux(klon,2), stat = error) |
---|
| 161 | sum_error = sum_error + error |
---|
| 162 | ALLOCATE(cpl_windsp(klon,2), stat = error) |
---|
| 163 | sum_error = sum_error + error |
---|
| 164 | ALLOCATE(cpl_tauy(klon,2), stat = error) |
---|
| 165 | sum_error = sum_error + error |
---|
| 166 | ALLOCATE(cpl_rriv2D(iim,jj_nb), stat=error) |
---|
| 167 | sum_error = sum_error + error |
---|
| 168 | ALLOCATE(cpl_rcoa2D(iim,jj_nb), stat=error) |
---|
| 169 | sum_error = sum_error + error |
---|
| 170 | ALLOCATE(cpl_rlic2D(iim,jj_nb), stat=error) |
---|
| 171 | sum_error = sum_error + error |
---|
| 172 | ALLOCATE(read_sst(iim, jj_nb), stat = error) |
---|
| 173 | sum_error = sum_error + error |
---|
| 174 | ALLOCATE(read_sic(iim, jj_nb), stat = error) |
---|
| 175 | sum_error = sum_error + error |
---|
| 176 | ALLOCATE(read_sit(iim, jj_nb), stat = error) |
---|
| 177 | sum_error = sum_error + error |
---|
| 178 | ALLOCATE(read_alb_sic(iim, jj_nb), stat = error) |
---|
| 179 | sum_error = sum_error + error |
---|
| 180 | |
---|
[1067] | 181 | ALLOCATE(read_u0(iim, jj_nb), stat = error) |
---|
| 182 | sum_error = sum_error + error |
---|
| 183 | ALLOCATE(read_v0(iim, jj_nb), stat = error) |
---|
| 184 | sum_error = sum_error + error |
---|
| 185 | |
---|
[782] | 186 | IF (sum_error /= 0) THEN |
---|
| 187 | abort_message='Pb allocation variables couplees' |
---|
| 188 | CALL abort_gcm(modname,abort_message,1) |
---|
| 189 | ENDIF |
---|
| 190 | !************************************************************************************* |
---|
| 191 | ! Initialize the allocated varaibles |
---|
| 192 | ! |
---|
| 193 | !************************************************************************************* |
---|
| 194 | DO ig = 1, klon |
---|
| 195 | unity(ig) = ig |
---|
| 196 | ENDDO |
---|
| 197 | |
---|
[996] | 198 | ! cpl_sols = 0. ; cpl_nsol = 0. ; cpl_rain = 0. ; cpl_snow = 0. |
---|
| 199 | ! cpl_evap = 0. ; cpl_tsol = 0. ; cpl_fder = 0. ; cpl_albe = 0. |
---|
| 200 | ! cpl_taux = 0. ; cpl_tauy = 0. ; cpl_rriv2D = 0. ; cpl_rcoa2D = 0. |
---|
| 201 | ! cpl_rlic2D = 0. ; cpl_windsp = 0. |
---|
[782] | 202 | |
---|
| 203 | !************************************************************************************* |
---|
| 204 | ! Initialize coupling |
---|
| 205 | ! |
---|
| 206 | !************************************************************************************* |
---|
| 207 | idtime = INT(dtime) |
---|
| 208 | #ifdef CPP_COUPLE |
---|
[987] | 209 | !$OMP MASTER |
---|
[782] | 210 | CALL inicma |
---|
[987] | 211 | !$OMP END MASTER |
---|
[782] | 212 | #endif |
---|
| 213 | |
---|
| 214 | !************************************************************************************* |
---|
| 215 | ! initialize NetCDF output |
---|
| 216 | ! |
---|
| 217 | !************************************************************************************* |
---|
| 218 | IF (is_sequential) THEN |
---|
| 219 | idayref = day_ini |
---|
| 220 | CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) |
---|
| 221 | CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon) |
---|
| 222 | DO i = 1, iim |
---|
| 223 | zx_lon(i,1) = rlon(i+1) |
---|
| 224 | zx_lon(i,jjm+1) = rlon(i+1) |
---|
| 225 | ENDDO |
---|
| 226 | CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat) |
---|
| 227 | clintocplnam="cpl_atm_tauflx" |
---|
| 228 | CALL histbeg(clintocplnam, iim,zx_lon(:,1),jjm+1,zx_lat(1,:),& |
---|
| 229 | 1,iim,1,jjm+1, itau_phy,zjulian,dtime,nhoridct,nidct) |
---|
| 230 | ! no vertical axis |
---|
| 231 | CALL histdef(nidct, 'tauxe','tauxe', & |
---|
| 232 | "-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) |
---|
| 233 | CALL histdef(nidct, 'tauyn','tauyn', & |
---|
| 234 | "-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) |
---|
| 235 | CALL histdef(nidct, 'tmp_lon','tmp_lon', & |
---|
| 236 | "-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) |
---|
| 237 | CALL histdef(nidct, 'tmp_lat','tmp_lat', & |
---|
| 238 | "-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) |
---|
| 239 | DO jf=1,jpflda2o1 + jpflda2o2 |
---|
| 240 | CALL histdef(nidct, cl_writ(jf),cl_writ(jf), & |
---|
| 241 | "-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) |
---|
| 242 | END DO |
---|
| 243 | CALL histend(nidct) |
---|
| 244 | CALL histsync(nidct) |
---|
| 245 | |
---|
| 246 | clfromcplnam="cpl_atm_sst" |
---|
| 247 | CALL histbeg(clfromcplnam, iim,zx_lon(:,1),jjm+1,zx_lat(1,:),1,iim,1,jjm+1, & |
---|
| 248 | 0,zjulian,dtime,nhoridcs,nidcs) |
---|
| 249 | ! no vertical axis |
---|
| 250 | DO jf=1,jpfldo2a |
---|
| 251 | CALL histdef(nidcs, cl_read(jf),cl_read(jf), & |
---|
| 252 | "-",iim, jjm+1, nhoridcs, 1, 1, 1, -99, 32, "inst", dtime,dtime) |
---|
| 253 | END DO |
---|
| 254 | CALL histend(nidcs) |
---|
| 255 | CALL histsync(nidcs) |
---|
| 256 | |
---|
| 257 | ENDIF ! is_sequential |
---|
| 258 | |
---|
[987] | 259 | ! OPENMP Initialization |
---|
| 260 | |
---|
| 261 | !$OMP MASTER |
---|
[1001] | 262 | ALLOCATE(knon_omp(0:omp_size-1)) |
---|
| 263 | ALLOCATE(buffer_omp(klon_mpi,0:omp_size-1)) |
---|
[987] | 264 | !$OMP END MASTER |
---|
| 265 | !$OMP BARRIER |
---|
| 266 | |
---|
[782] | 267 | END SUBROUTINE cpl_init |
---|
| 268 | |
---|
| 269 | ! |
---|
| 270 | !************************************************************************************* |
---|
| 271 | ! |
---|
[996] | 272 | |
---|
| 273 | SUBROUTINE cpl_receive_frac(itime, dtime, pctsrf, is_modified) |
---|
| 274 | ! This subroutine receives from coupler for both ocean and seaice |
---|
[782] | 275 | ! 4 fields : read_sst, read_sic, read_sit and read_alb_sic. |
---|
[996] | 276 | ! The new sea-ice-land-landice fraction is returned. The others fields |
---|
| 277 | ! are stored in this module. |
---|
| 278 | USE surface_data |
---|
[1067] | 279 | USE phys_state_var_mod, ONLY : rlon, rlat |
---|
| 280 | USE Write_Field |
---|
[782] | 281 | |
---|
[793] | 282 | INCLUDE "indicesol.h" |
---|
| 283 | INCLUDE "temps.h" |
---|
[782] | 284 | INCLUDE "iniprint.h" |
---|
[793] | 285 | INCLUDE "YOMCST.h" |
---|
| 286 | INCLUDE "dimensions.h" |
---|
[782] | 287 | |
---|
[996] | 288 | ! Arguments |
---|
[782] | 289 | !************************************************************************************ |
---|
[996] | 290 | INTEGER, INTENT(IN) :: itime |
---|
| 291 | REAL, INTENT(IN) :: dtime |
---|
| 292 | REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf |
---|
| 293 | LOGICAL, INTENT(OUT) :: is_modified |
---|
[782] | 294 | |
---|
| 295 | ! Local variables |
---|
| 296 | !************************************************************************************ |
---|
[996] | 297 | INTEGER :: j, i, time_sec |
---|
[782] | 298 | INTEGER :: itau_w |
---|
| 299 | INTEGER, DIMENSION(iim*(jjm+1)) :: ndexcs |
---|
[996] | 300 | CHARACTER(len = 20) :: modname = 'cpl_receive_frac' |
---|
[782] | 301 | CHARACTER(len = 80) :: abort_message |
---|
| 302 | REAL, DIMENSION(klon) :: read_sic1D |
---|
[996] | 303 | REAL, DIMENSION(iim,jj_nb,jpfldo2a) :: tab_read_flds |
---|
| 304 | REAL, DIMENSION(klon,nbsrf) :: pctsrf_old |
---|
[1067] | 305 | REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi |
---|
| 306 | REAL, DIMENSION(iim, jj_nb) :: tmp_lon, tmp_lat |
---|
| 307 | REAL, DIMENSION(iim, jj_nb) :: tmp_r0 |
---|
[782] | 308 | |
---|
| 309 | !************************************************************************************* |
---|
| 310 | ! Start calculation |
---|
| 311 | ! Get fields from coupler |
---|
| 312 | ! |
---|
| 313 | !************************************************************************************* |
---|
| 314 | |
---|
[996] | 315 | is_modified=.FALSE. |
---|
| 316 | |
---|
| 317 | ! Check if right moment to recevie from coupler |
---|
| 318 | IF (MOD(itime, nexca) == 1) THEN |
---|
| 319 | is_modified=.TRUE. |
---|
| 320 | |
---|
| 321 | time_sec=(itime-1)*dtime |
---|
[782] | 322 | #ifdef CPP_COUPLE |
---|
[987] | 323 | !$OMP MASTER |
---|
[1010] | 324 | CALL fromcpl(time_sec, tab_read_flds) |
---|
[987] | 325 | !$OMP END MASTER |
---|
[782] | 326 | #endif |
---|
| 327 | |
---|
| 328 | ! NetCDF output of received fields |
---|
[996] | 329 | IF (is_sequential) THEN |
---|
| 330 | ndexcs(:) = 0 |
---|
| 331 | itau_w = itau_phy + itime |
---|
| 332 | DO i = 1, jpfldo2a |
---|
| 333 | CALL histwrite(nidcs,cl_read(i),itau_w,tab_read_flds(:,:,i),iim*(jjm+1),ndexcs) |
---|
| 334 | END DO |
---|
| 335 | ENDIF |
---|
[782] | 336 | |
---|
[1001] | 337 | |
---|
[996] | 338 | ! Save each field in a 2D array. |
---|
[987] | 339 | !$OMP MASTER |
---|
[1079] | 340 | read_sst(:,:) = tab_read_flds(:,:,1) ! Sea surface temperature |
---|
| 341 | read_sic(:,:) = tab_read_flds(:,:,2) ! Sea ice concentration |
---|
| 342 | read_alb_sic(:,:) = tab_read_flds(:,:,3) ! Albedo at sea ice |
---|
| 343 | read_sit(:,:) = tab_read_flds(:,:,4) ! Sea ice temperature |
---|
[996] | 344 | !$OMP END MASTER |
---|
[987] | 345 | |
---|
[1067] | 346 | IF (cpl_current) THEN |
---|
| 347 | |
---|
| 348 | ! Transform the longitudes and latitudes on 2D arrays |
---|
| 349 | CALL gather_omp(rlon,rlon_mpi) |
---|
| 350 | CALL gather_omp(rlat,rlat_mpi) |
---|
| 351 | !$OMP MASTER |
---|
| 352 | CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon) |
---|
| 353 | CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat) |
---|
| 354 | |
---|
| 355 | ! Transform the currents from cartesian to spheric coordinates |
---|
| 356 | ! tmp_r0 should be zero |
---|
| 357 | CALL geo2atm(iim, jj_nb, tab_read_flds(:,:,5), tab_read_flds(:,:,6), tab_read_flds(:,:,7), & |
---|
| 358 | tmp_lon, tmp_lat, & |
---|
| 359 | read_u0(:,:), read_v0(:,:), tmp_r0(:,:)) |
---|
| 360 | !$OMP END MASTER |
---|
[1125] | 361 | |
---|
[1067] | 362 | ELSE |
---|
| 363 | read_u0(:,:) = 0. |
---|
| 364 | read_v0(:,:) = 0. |
---|
| 365 | ENDIF |
---|
| 366 | |
---|
[782] | 367 | !************************************************************************************* |
---|
[996] | 368 | ! Transform seaice fraction (read_sic : ocean-seaice mask) into global |
---|
| 369 | ! fraction (pctsrf : ocean-seaice-land-landice mask) |
---|
[782] | 370 | ! |
---|
| 371 | !************************************************************************************* |
---|
[996] | 372 | CALL cpl2gath(read_sic, read_sic1D, klon, unity) |
---|
| 373 | |
---|
| 374 | pctsrf_old(:,:) = pctsrf(:,:) |
---|
| 375 | DO i = 1, klon |
---|
| 376 | ! treatment only of points with ocean and/or seaice |
---|
| 377 | IF (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic) > 0.) THEN |
---|
| 378 | pctsrf(i,is_sic) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) & |
---|
| 379 | * read_sic1D(i) |
---|
| 380 | pctsrf(i,is_oce) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) & |
---|
| 381 | - pctsrf(i,is_sic) |
---|
[782] | 382 | ENDIF |
---|
| 383 | ENDDO |
---|
[987] | 384 | |
---|
[996] | 385 | END IF ! if time to receive |
---|
[782] | 386 | |
---|
[996] | 387 | END SUBROUTINE cpl_receive_frac |
---|
[782] | 388 | |
---|
| 389 | ! |
---|
| 390 | !************************************************************************************* |
---|
| 391 | ! |
---|
[996] | 392 | |
---|
[1067] | 393 | SUBROUTINE cpl_receive_ocean_fields(knon, knindex, tsurf_new, u0_new, v0_new) |
---|
[782] | 394 | ! |
---|
[996] | 395 | ! This routine returns the field for the ocean that has been read from the coupler |
---|
| 396 | ! (done earlier with cpl_receive_frac). The field is the temperature. |
---|
| 397 | ! The temperature is transformed into 1D array with valid points from index 1 to knon. |
---|
[782] | 398 | ! |
---|
[793] | 399 | INCLUDE "indicesol.h" |
---|
[782] | 400 | |
---|
| 401 | ! Input arguments |
---|
| 402 | !************************************************************************************* |
---|
| 403 | INTEGER, INTENT(IN) :: knon |
---|
| 404 | INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
---|
| 405 | |
---|
| 406 | ! Output arguments |
---|
| 407 | !************************************************************************************* |
---|
| 408 | REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new |
---|
[1067] | 409 | REAL, DIMENSION(klon), INTENT(OUT) :: u0_new |
---|
| 410 | REAL, DIMENSION(klon), INTENT(OUT) :: v0_new |
---|
[782] | 411 | |
---|
[996] | 412 | ! Local variables |
---|
[782] | 413 | !************************************************************************************* |
---|
[996] | 414 | INTEGER :: i |
---|
| 415 | REAL, DIMENSION(klon) :: sic_new |
---|
[782] | 416 | |
---|
| 417 | !************************************************************************************* |
---|
| 418 | ! Transform read_sst into compressed 1D variable tsurf_new |
---|
| 419 | ! |
---|
| 420 | !************************************************************************************* |
---|
| 421 | CALL cpl2gath(read_sst, tsurf_new, knon, knindex) |
---|
[996] | 422 | CALL cpl2gath(read_sic, sic_new, knon, knindex) |
---|
[1067] | 423 | CALL cpl2gath(read_u0, u0_new, knon, knindex) |
---|
| 424 | CALL cpl2gath(read_v0, v0_new, knon, knindex) |
---|
[782] | 425 | |
---|
[996] | 426 | !************************************************************************************* |
---|
| 427 | ! The fields received from the coupler have to be weighted with the fraction of ocean |
---|
| 428 | ! in relation to the total sea-ice+ocean |
---|
| 429 | ! |
---|
| 430 | !************************************************************************************* |
---|
| 431 | DO i=1, knon |
---|
| 432 | tsurf_new(i) = tsurf_new(i)/(1. - sic_new(i)) |
---|
| 433 | END DO |
---|
[782] | 434 | |
---|
| 435 | END SUBROUTINE cpl_receive_ocean_fields |
---|
[996] | 436 | |
---|
[782] | 437 | ! |
---|
| 438 | !************************************************************************************* |
---|
| 439 | ! |
---|
[996] | 440 | |
---|
[782] | 441 | SUBROUTINE cpl_receive_seaice_fields(knon, knindex, & |
---|
[1125] | 442 | tsurf_new, alb_new, u0_new, v0_new) |
---|
[782] | 443 | ! |
---|
| 444 | ! This routine returns the fields for the seaice that have been read from the coupler |
---|
[996] | 445 | ! (done earlier with cpl_receive_frac). These fields are the temperature and |
---|
[782] | 446 | ! albedo at sea ice surface and fraction of sea ice. |
---|
[996] | 447 | ! The fields are transformed into 1D arrays with valid points from index 1 to knon. |
---|
[782] | 448 | ! |
---|
| 449 | |
---|
| 450 | ! Input arguments |
---|
| 451 | !************************************************************************************* |
---|
| 452 | INTEGER, INTENT(IN) :: knon |
---|
| 453 | INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
---|
| 454 | |
---|
| 455 | ! Output arguments |
---|
| 456 | !************************************************************************************* |
---|
| 457 | REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new |
---|
| 458 | REAL, DIMENSION(klon), INTENT(OUT) :: alb_new |
---|
[1125] | 459 | REAL, DIMENSION(klon), INTENT(OUT) :: u0_new |
---|
| 460 | REAL, DIMENSION(klon), INTENT(OUT) :: v0_new |
---|
[782] | 461 | |
---|
[996] | 462 | ! Local variables |
---|
| 463 | !************************************************************************************* |
---|
| 464 | INTEGER :: i |
---|
| 465 | REAL, DIMENSION(klon) :: sic_new |
---|
[782] | 466 | |
---|
| 467 | !************************************************************************************* |
---|
| 468 | ! Transform fields read from coupler from 2D into compressed 1D variables |
---|
| 469 | ! |
---|
| 470 | !************************************************************************************* |
---|
| 471 | CALL cpl2gath(read_sit, tsurf_new, knon, knindex) |
---|
| 472 | CALL cpl2gath(read_alb_sic, alb_new, knon, knindex) |
---|
[996] | 473 | CALL cpl2gath(read_sic, sic_new, knon, knindex) |
---|
[1125] | 474 | CALL cpl2gath(read_u0, u0_new, knon, knindex) |
---|
| 475 | CALL cpl2gath(read_v0, v0_new, knon, knindex) |
---|
[782] | 476 | |
---|
[996] | 477 | !************************************************************************************* |
---|
| 478 | ! The fields received from the coupler have to be weighted with the sea-ice |
---|
| 479 | ! concentration (in relation to the total sea-ice + ocean). |
---|
| 480 | ! |
---|
| 481 | !************************************************************************************* |
---|
| 482 | DO i= 1, knon |
---|
| 483 | tsurf_new(i) = tsurf_new(i) / sic_new(i) |
---|
| 484 | alb_new(i) = alb_new(i) / sic_new(i) |
---|
| 485 | END DO |
---|
| 486 | |
---|
[782] | 487 | END SUBROUTINE cpl_receive_seaice_fields |
---|
| 488 | |
---|
| 489 | ! |
---|
| 490 | !************************************************************************************* |
---|
| 491 | ! |
---|
| 492 | |
---|
| 493 | SUBROUTINE cpl_send_ocean_fields(itime, knon, knindex, & |
---|
| 494 | swdown, lwdown, fluxlat, fluxsens, & |
---|
| 495 | precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy, windsp) |
---|
| 496 | ! |
---|
| 497 | ! This subroutine cumulates some fields for each time-step during a coupling |
---|
| 498 | ! period. At last time-step in a coupling period the fields are transformed to the |
---|
| 499 | ! grid accepted by the coupler. No sending to the coupler will be done from here |
---|
| 500 | ! (it is done in cpl_send_seaice_fields). |
---|
| 501 | ! |
---|
[793] | 502 | INCLUDE "indicesol.h" |
---|
| 503 | INCLUDE "dimensions.h" |
---|
[782] | 504 | |
---|
| 505 | ! Input arguments |
---|
| 506 | !************************************************************************************* |
---|
| 507 | INTEGER, INTENT(IN) :: itime |
---|
| 508 | INTEGER, INTENT(IN) :: knon |
---|
| 509 | INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
---|
| 510 | REAL, DIMENSION(klon), INTENT(IN) :: swdown, lwdown |
---|
| 511 | REAL, DIMENSION(klon), INTENT(IN) :: fluxlat, fluxsens |
---|
| 512 | REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow |
---|
| 513 | REAL, DIMENSION(klon), INTENT(IN) :: evap, tsurf, fder, albsol |
---|
| 514 | REAL, DIMENSION(klon), INTENT(IN) :: taux, tauy, windsp |
---|
| 515 | |
---|
| 516 | ! Local variables |
---|
| 517 | !************************************************************************************* |
---|
| 518 | INTEGER :: cpl_index, ig |
---|
| 519 | INTEGER :: error, sum_error |
---|
| 520 | CHARACTER(len = 25) :: modname = 'cpl_send_ocean_fields' |
---|
| 521 | CHARACTER(len = 80) :: abort_message |
---|
| 522 | |
---|
| 523 | !************************************************************************************* |
---|
| 524 | ! Start calculation |
---|
| 525 | ! The ocean points are saved with second array index=1 |
---|
| 526 | ! |
---|
| 527 | !************************************************************************************* |
---|
| 528 | cpl_index = 1 |
---|
| 529 | |
---|
| 530 | !************************************************************************************* |
---|
| 531 | ! Reset fields to zero in the beginning of a new coupling period |
---|
| 532 | ! |
---|
| 533 | !************************************************************************************* |
---|
| 534 | IF (MOD(itime, nexca) == 1) THEN |
---|
[996] | 535 | cpl_sols(1:knon,cpl_index) = 0.0 |
---|
| 536 | cpl_nsol(1:knon,cpl_index) = 0.0 |
---|
| 537 | cpl_rain(1:knon,cpl_index) = 0.0 |
---|
| 538 | cpl_snow(1:knon,cpl_index) = 0.0 |
---|
| 539 | cpl_evap(1:knon,cpl_index) = 0.0 |
---|
| 540 | cpl_tsol(1:knon,cpl_index) = 0.0 |
---|
| 541 | cpl_fder(1:knon,cpl_index) = 0.0 |
---|
| 542 | cpl_albe(1:knon,cpl_index) = 0.0 |
---|
| 543 | cpl_taux(1:knon,cpl_index) = 0.0 |
---|
| 544 | cpl_tauy(1:knon,cpl_index) = 0.0 |
---|
| 545 | cpl_windsp(1:knon,cpl_index) = 0.0 |
---|
[782] | 546 | ENDIF |
---|
| 547 | |
---|
| 548 | !************************************************************************************* |
---|
| 549 | ! Cumulate at each time-step |
---|
| 550 | ! |
---|
| 551 | !************************************************************************************* |
---|
| 552 | DO ig = 1, knon |
---|
| 553 | cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + & |
---|
| 554 | swdown(ig) / FLOAT(nexca) |
---|
| 555 | cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + & |
---|
| 556 | (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / FLOAT(nexca) |
---|
| 557 | cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + & |
---|
| 558 | precip_rain(ig) / FLOAT(nexca) |
---|
| 559 | cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + & |
---|
| 560 | precip_snow(ig) / FLOAT(nexca) |
---|
| 561 | cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + & |
---|
| 562 | evap(ig) / FLOAT(nexca) |
---|
| 563 | cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + & |
---|
| 564 | tsurf(ig) / FLOAT(nexca) |
---|
| 565 | cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + & |
---|
| 566 | fder(ig) / FLOAT(nexca) |
---|
| 567 | cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + & |
---|
| 568 | albsol(ig) / FLOAT(nexca) |
---|
| 569 | cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + & |
---|
| 570 | taux(ig) / FLOAT(nexca) |
---|
| 571 | cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + & |
---|
| 572 | tauy(ig) / FLOAT(nexca) |
---|
| 573 | cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) + & |
---|
| 574 | windsp(ig) / FLOAT(nexca) |
---|
| 575 | ENDDO |
---|
| 576 | |
---|
| 577 | !************************************************************************************* |
---|
| 578 | ! If the time-step corresponds to the end of coupling period the |
---|
| 579 | ! fields are transformed to the 2D grid. |
---|
| 580 | ! No sending to the coupler (it is done from cpl_send_seaice_fields). |
---|
| 581 | ! |
---|
| 582 | !************************************************************************************* |
---|
| 583 | IF (MOD(itime, nexca) == 0) THEN |
---|
| 584 | |
---|
| 585 | IF (.NOT. ALLOCATED(cpl_sols2D)) THEN |
---|
| 586 | sum_error = 0 |
---|
| 587 | ALLOCATE(cpl_sols2D(iim,jj_nb,2), stat=error) |
---|
| 588 | sum_error = sum_error + error |
---|
| 589 | ALLOCATE(cpl_nsol2D(iim,jj_nb,2), stat=error) |
---|
| 590 | sum_error = sum_error + error |
---|
| 591 | ALLOCATE(cpl_rain2D(iim,jj_nb,2), stat=error) |
---|
| 592 | sum_error = sum_error + error |
---|
| 593 | ALLOCATE(cpl_snow2D(iim,jj_nb,2), stat=error) |
---|
| 594 | sum_error = sum_error + error |
---|
| 595 | ALLOCATE(cpl_evap2D(iim,jj_nb,2), stat=error) |
---|
| 596 | sum_error = sum_error + error |
---|
| 597 | ALLOCATE(cpl_tsol2D(iim,jj_nb,2), stat=error) |
---|
| 598 | sum_error = sum_error + error |
---|
| 599 | ALLOCATE(cpl_fder2D(iim,jj_nb,2), stat=error) |
---|
| 600 | sum_error = sum_error + error |
---|
| 601 | ALLOCATE(cpl_albe2D(iim,jj_nb,2), stat=error) |
---|
| 602 | sum_error = sum_error + error |
---|
| 603 | ALLOCATE(cpl_taux2D(iim,jj_nb,2), stat=error) |
---|
| 604 | sum_error = sum_error + error |
---|
| 605 | ALLOCATE(cpl_tauy2D(iim,jj_nb,2), stat=error) |
---|
| 606 | sum_error = sum_error + error |
---|
| 607 | ALLOCATE(cpl_windsp2D(iim,jj_nb), stat=error) |
---|
| 608 | sum_error = sum_error + error |
---|
| 609 | |
---|
| 610 | IF (sum_error /= 0) THEN |
---|
| 611 | abort_message='Pb allocation variables couplees pour l''ecriture' |
---|
| 612 | CALL abort_gcm(modname,abort_message,1) |
---|
| 613 | ENDIF |
---|
| 614 | ENDIF |
---|
| 615 | |
---|
| 616 | |
---|
| 617 | CALL gath2cpl(cpl_sols(1,cpl_index), cpl_sols2D(1,1,cpl_index), & |
---|
| 618 | knon, knindex) |
---|
| 619 | |
---|
| 620 | CALL gath2cpl(cpl_nsol(1,cpl_index), cpl_nsol2D(1,1,cpl_index), & |
---|
| 621 | knon, knindex) |
---|
| 622 | |
---|
| 623 | CALL gath2cpl(cpl_rain(1,cpl_index), cpl_rain2D(1,1,cpl_index), & |
---|
| 624 | knon, knindex) |
---|
| 625 | |
---|
| 626 | CALL gath2cpl(cpl_snow(1,cpl_index), cpl_snow2D(1,1,cpl_index), & |
---|
| 627 | knon, knindex) |
---|
| 628 | |
---|
| 629 | CALL gath2cpl(cpl_evap(1,cpl_index), cpl_evap2D(1,1,cpl_index), & |
---|
| 630 | knon, knindex) |
---|
| 631 | |
---|
| 632 | ! cpl_tsol2D(:,:,:) not used! |
---|
| 633 | CALL gath2cpl(cpl_tsol(1,cpl_index), cpl_tsol2D(1,1, cpl_index), & |
---|
| 634 | knon, knindex) |
---|
| 635 | |
---|
| 636 | ! cpl_fder2D(:,:,1) not used, only cpl_fder(:,:,2)! |
---|
| 637 | CALL gath2cpl(cpl_fder(1,cpl_index), cpl_fder2D(1,1,cpl_index), & |
---|
| 638 | knon, knindex) |
---|
| 639 | |
---|
| 640 | ! cpl_albe2D(:,:,:) not used! |
---|
| 641 | CALL gath2cpl(cpl_albe(1,cpl_index), cpl_albe2D(1,1,cpl_index), & |
---|
| 642 | knon, knindex) |
---|
| 643 | |
---|
| 644 | CALL gath2cpl(cpl_taux(1,cpl_index), cpl_taux2D(1,1,cpl_index), & |
---|
| 645 | knon, knindex) |
---|
| 646 | |
---|
| 647 | CALL gath2cpl(cpl_tauy(1,cpl_index), cpl_tauy2D(1,1,cpl_index), & |
---|
| 648 | knon, knindex) |
---|
| 649 | |
---|
| 650 | CALL gath2cpl(cpl_windsp(1,cpl_index), cpl_windsp2D(1,1), & |
---|
| 651 | knon, knindex) |
---|
| 652 | |
---|
| 653 | ENDIF |
---|
| 654 | |
---|
| 655 | END SUBROUTINE cpl_send_ocean_fields |
---|
| 656 | |
---|
| 657 | ! |
---|
| 658 | !************************************************************************************* |
---|
| 659 | ! |
---|
| 660 | |
---|
| 661 | SUBROUTINE cpl_send_seaice_fields(itime, dtime, knon, knindex, & |
---|
| 662 | pctsrf, lafin, rlon, rlat, & |
---|
| 663 | swdown, lwdown, fluxlat, fluxsens, & |
---|
| 664 | precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy) |
---|
| 665 | ! |
---|
| 666 | ! This subroutine cumulates some fields for each time-step during a coupling |
---|
| 667 | ! period. At last time-step in a coupling period the fields are transformed to the |
---|
| 668 | ! grid accepted by the coupler. All fields for all types of surfaces are sent to |
---|
| 669 | ! the coupler. |
---|
| 670 | ! |
---|
[793] | 671 | INCLUDE "indicesol.h" |
---|
| 672 | INCLUDE "dimensions.h" |
---|
[782] | 673 | |
---|
| 674 | ! Input arguments |
---|
| 675 | !************************************************************************************* |
---|
| 676 | INTEGER, INTENT(IN) :: itime |
---|
| 677 | INTEGER, INTENT(IN) :: knon |
---|
| 678 | INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
---|
| 679 | REAL, INTENT(IN) :: dtime |
---|
| 680 | REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat |
---|
| 681 | REAL, DIMENSION(klon), INTENT(IN) :: swdown, lwdown |
---|
| 682 | REAL, DIMENSION(klon), INTENT(IN) :: fluxlat, fluxsens |
---|
| 683 | REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow |
---|
| 684 | REAL, DIMENSION(klon), INTENT(IN) :: evap, tsurf, fder |
---|
| 685 | REAL, DIMENSION(klon), INTENT(IN) :: albsol, taux, tauy |
---|
| 686 | REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf |
---|
| 687 | LOGICAL, INTENT(IN) :: lafin |
---|
| 688 | |
---|
| 689 | ! Local variables |
---|
| 690 | !************************************************************************************* |
---|
| 691 | INTEGER :: cpl_index, ig |
---|
| 692 | INTEGER :: error, sum_error |
---|
| 693 | CHARACTER(len = 25) :: modname = 'cpl_send_seaice_fields' |
---|
| 694 | CHARACTER(len = 80) :: abort_message |
---|
| 695 | |
---|
| 696 | |
---|
| 697 | !************************************************************************************* |
---|
| 698 | ! Start calulation |
---|
| 699 | ! The sea-ice points are saved with second array index=2 |
---|
| 700 | ! |
---|
| 701 | !************************************************************************************* |
---|
| 702 | cpl_index = 2 |
---|
| 703 | |
---|
| 704 | !************************************************************************************* |
---|
| 705 | ! Reset fields to zero in the beginning of a new coupling period |
---|
| 706 | ! |
---|
| 707 | !************************************************************************************* |
---|
| 708 | IF (MOD(itime, nexca) == 1) THEN |
---|
[996] | 709 | cpl_sols(1:knon,cpl_index) = 0.0 |
---|
| 710 | cpl_nsol(1:knon,cpl_index) = 0.0 |
---|
| 711 | cpl_rain(1:knon,cpl_index) = 0.0 |
---|
| 712 | cpl_snow(1:knon,cpl_index) = 0.0 |
---|
| 713 | cpl_evap(1:knon,cpl_index) = 0.0 |
---|
| 714 | cpl_tsol(1:knon,cpl_index) = 0.0 |
---|
| 715 | cpl_fder(1:knon,cpl_index) = 0.0 |
---|
| 716 | cpl_albe(1:knon,cpl_index) = 0.0 |
---|
| 717 | cpl_taux(1:knon,cpl_index) = 0.0 |
---|
| 718 | cpl_tauy(1:knon,cpl_index) = 0.0 |
---|
[782] | 719 | ENDIF |
---|
| 720 | |
---|
| 721 | !************************************************************************************* |
---|
| 722 | ! Cumulate at each time-step |
---|
| 723 | ! |
---|
| 724 | !************************************************************************************* |
---|
| 725 | DO ig = 1, knon |
---|
| 726 | cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + & |
---|
| 727 | swdown(ig) / FLOAT(nexca) |
---|
| 728 | cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + & |
---|
| 729 | (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / FLOAT(nexca) |
---|
| 730 | cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + & |
---|
| 731 | precip_rain(ig) / FLOAT(nexca) |
---|
| 732 | cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + & |
---|
| 733 | precip_snow(ig) / FLOAT(nexca) |
---|
| 734 | cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + & |
---|
| 735 | evap(ig) / FLOAT(nexca) |
---|
| 736 | cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + & |
---|
| 737 | tsurf(ig) / FLOAT(nexca) |
---|
| 738 | cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + & |
---|
| 739 | fder(ig) / FLOAT(nexca) |
---|
| 740 | cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + & |
---|
| 741 | albsol(ig) / FLOAT(nexca) |
---|
| 742 | cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + & |
---|
| 743 | taux(ig) / FLOAT(nexca) |
---|
| 744 | cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + & |
---|
| 745 | tauy(ig) / FLOAT(nexca) |
---|
| 746 | ENDDO |
---|
| 747 | |
---|
| 748 | !************************************************************************************* |
---|
| 749 | ! If the time-step corresponds to the end of coupling period the |
---|
| 750 | ! fields are transformed to the 2D grid and all fields are sent to coupler. |
---|
| 751 | ! |
---|
| 752 | !************************************************************************************* |
---|
| 753 | IF (MOD(itime, nexca) == 0) THEN |
---|
| 754 | IF (.NOT. ALLOCATED(cpl_sols2D)) THEN |
---|
| 755 | sum_error = 0 |
---|
| 756 | ALLOCATE(cpl_sols2D(iim,jj_nb,2), stat=error) |
---|
| 757 | sum_error = sum_error + error |
---|
| 758 | ALLOCATE(cpl_nsol2D(iim,jj_nb,2), stat=error) |
---|
| 759 | sum_error = sum_error + error |
---|
| 760 | ALLOCATE(cpl_rain2D(iim,jj_nb,2), stat=error) |
---|
| 761 | sum_error = sum_error + error |
---|
| 762 | ALLOCATE(cpl_snow2D(iim,jj_nb,2), stat=error) |
---|
| 763 | sum_error = sum_error + error |
---|
| 764 | ALLOCATE(cpl_evap2D(iim,jj_nb,2), stat=error) |
---|
| 765 | sum_error = sum_error + error |
---|
| 766 | ALLOCATE(cpl_tsol2D(iim,jj_nb,2), stat=error) |
---|
| 767 | sum_error = sum_error + error |
---|
| 768 | ALLOCATE(cpl_fder2D(iim,jj_nb,2), stat=error) |
---|
| 769 | sum_error = sum_error + error |
---|
| 770 | ALLOCATE(cpl_albe2D(iim,jj_nb,2), stat=error) |
---|
| 771 | sum_error = sum_error + error |
---|
| 772 | ALLOCATE(cpl_taux2D(iim,jj_nb,2), stat=error) |
---|
| 773 | sum_error = sum_error + error |
---|
| 774 | ALLOCATE(cpl_tauy2D(iim,jj_nb,2), stat=error) |
---|
| 775 | sum_error = sum_error + error |
---|
| 776 | ALLOCATE(cpl_windsp2D(iim,jj_nb), stat=error) |
---|
| 777 | sum_error = sum_error + error |
---|
| 778 | |
---|
| 779 | IF (sum_error /= 0) THEN |
---|
| 780 | abort_message='Pb allocation variables couplees pour l''ecriture' |
---|
| 781 | CALL abort_gcm(modname,abort_message,1) |
---|
| 782 | ENDIF |
---|
| 783 | ENDIF |
---|
| 784 | |
---|
| 785 | CALL gath2cpl(cpl_sols(1,cpl_index), cpl_sols2D(1,1,cpl_index), & |
---|
| 786 | knon, knindex) |
---|
| 787 | |
---|
| 788 | CALL gath2cpl(cpl_nsol(1,cpl_index), cpl_nsol2D(1,1,cpl_index), & |
---|
| 789 | knon, knindex) |
---|
| 790 | |
---|
| 791 | CALL gath2cpl(cpl_rain(1,cpl_index), cpl_rain2D(1,1,cpl_index), & |
---|
| 792 | knon, knindex) |
---|
| 793 | |
---|
| 794 | CALL gath2cpl(cpl_snow(1,cpl_index), cpl_snow2D(1,1,cpl_index), & |
---|
| 795 | knon, knindex) |
---|
| 796 | |
---|
| 797 | CALL gath2cpl(cpl_evap(1,cpl_index), cpl_evap2D(1,1,cpl_index), & |
---|
| 798 | knon, knindex) |
---|
| 799 | |
---|
| 800 | ! cpl_tsol2D(:,:,:) not used! |
---|
| 801 | CALL gath2cpl(cpl_tsol(1,cpl_index), cpl_tsol2D(1,1, cpl_index), & |
---|
| 802 | knon, knindex) |
---|
| 803 | |
---|
| 804 | CALL gath2cpl(cpl_fder(1,cpl_index), cpl_fder2D(1,1,cpl_index), & |
---|
| 805 | knon, knindex) |
---|
| 806 | |
---|
| 807 | ! cpl_albe2D(:,:,:) not used! |
---|
| 808 | CALL gath2cpl(cpl_albe(1,cpl_index), cpl_albe2D(1,1,cpl_index), & |
---|
| 809 | knon, knindex) |
---|
| 810 | |
---|
| 811 | CALL gath2cpl(cpl_taux(1,cpl_index), cpl_taux2D(1,1,cpl_index), & |
---|
| 812 | knon, knindex) |
---|
| 813 | |
---|
| 814 | CALL gath2cpl(cpl_tauy(1,cpl_index), cpl_tauy2D(1,1,cpl_index), & |
---|
| 815 | knon, knindex) |
---|
| 816 | |
---|
| 817 | ! Send all fields |
---|
| 818 | CALL cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat) |
---|
| 819 | ENDIF |
---|
| 820 | |
---|
| 821 | END SUBROUTINE cpl_send_seaice_fields |
---|
| 822 | |
---|
| 823 | ! |
---|
| 824 | !************************************************************************************* |
---|
| 825 | ! |
---|
| 826 | |
---|
| 827 | SUBROUTINE cpl_send_land_fields(itime, knon, knindex, rriv_in, rcoa_in) |
---|
| 828 | ! |
---|
| 829 | ! This subroutine cumulates some fields for each time-step during a coupling |
---|
| 830 | ! period. At last time-step in a coupling period the fields are transformed to the |
---|
| 831 | ! grid accepted by the coupler. No sending to the coupler will be done from here |
---|
| 832 | ! (it is done in cpl_send_seaice_fields). |
---|
| 833 | ! |
---|
[793] | 834 | INCLUDE "dimensions.h" |
---|
[782] | 835 | |
---|
| 836 | ! Input arguments |
---|
| 837 | !************************************************************************************* |
---|
| 838 | INTEGER, INTENT(IN) :: itime |
---|
| 839 | INTEGER, INTENT(IN) :: knon |
---|
| 840 | INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
---|
| 841 | REAL, DIMENSION(klon), INTENT(IN) :: rriv_in |
---|
| 842 | REAL, DIMENSION(klon), INTENT(IN) :: rcoa_in |
---|
| 843 | |
---|
| 844 | ! Local variables |
---|
| 845 | !************************************************************************************* |
---|
| 846 | REAL, DIMENSION(iim,jj_nb) :: rriv2D |
---|
| 847 | REAL, DIMENSION(iim,jj_nb) :: rcoa2D |
---|
| 848 | |
---|
| 849 | !************************************************************************************* |
---|
| 850 | ! Rearrange fields in 2D variables |
---|
| 851 | ! First initialize to zero to avoid unvalid points causing problems |
---|
| 852 | ! |
---|
| 853 | !************************************************************************************* |
---|
[987] | 854 | !$OMP MASTER |
---|
[782] | 855 | rriv2D(:,:) = 0.0 |
---|
| 856 | rcoa2D(:,:) = 0.0 |
---|
[987] | 857 | !$OMP END MASTER |
---|
[782] | 858 | CALL gath2cpl(rriv_in, rriv2D, knon, knindex) |
---|
| 859 | CALL gath2cpl(rcoa_in, rcoa2D, knon, knindex) |
---|
| 860 | |
---|
| 861 | !************************************************************************************* |
---|
| 862 | ! Reset cumulated fields to zero in the beginning of a new coupling period |
---|
| 863 | ! |
---|
| 864 | !************************************************************************************* |
---|
| 865 | IF (MOD(itime, nexca) == 1) THEN |
---|
[987] | 866 | !$OMP MASTER |
---|
[782] | 867 | cpl_rriv2D(:,:) = 0.0 |
---|
| 868 | cpl_rcoa2D(:,:) = 0.0 |
---|
[987] | 869 | !$OMP END MASTER |
---|
[782] | 870 | ENDIF |
---|
| 871 | |
---|
| 872 | !************************************************************************************* |
---|
| 873 | ! Cumulate : Following fields should be cumulated at each time-step |
---|
| 874 | ! |
---|
| 875 | !************************************************************************************* |
---|
[987] | 876 | !$OMP MASTER |
---|
[782] | 877 | cpl_rriv2D(:,:) = cpl_rriv2D(:,:) + rriv2D(:,:) / FLOAT(nexca) |
---|
| 878 | cpl_rcoa2D(:,:) = cpl_rcoa2D(:,:) + rcoa2D(:,:) / FLOAT(nexca) |
---|
[987] | 879 | !$OMP END MASTER |
---|
[782] | 880 | |
---|
| 881 | END SUBROUTINE cpl_send_land_fields |
---|
| 882 | |
---|
| 883 | ! |
---|
| 884 | !************************************************************************************* |
---|
| 885 | ! |
---|
| 886 | |
---|
| 887 | SUBROUTINE cpl_send_landice_fields(itime, knon, knindex, rlic_in) |
---|
| 888 | ! This subroutine cumulates the field for melting ice for each time-step |
---|
| 889 | ! during a coupling period. This routine will not send to coupler. Sending |
---|
| 890 | ! will be done in cpl_send_seaice_fields. |
---|
| 891 | ! |
---|
[793] | 892 | INCLUDE "dimensions.h" |
---|
[996] | 893 | |
---|
[782] | 894 | ! Input varibales |
---|
| 895 | !************************************************************************************* |
---|
| 896 | INTEGER, INTENT(IN) :: itime |
---|
| 897 | INTEGER, INTENT(IN) :: knon |
---|
| 898 | INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
---|
| 899 | REAL, DIMENSION(klon), INTENT(IN) :: rlic_in |
---|
| 900 | |
---|
| 901 | ! Local varibales |
---|
| 902 | !************************************************************************************* |
---|
| 903 | REAL, DIMENSION(iim,jj_nb) :: rlic2D |
---|
| 904 | |
---|
| 905 | !************************************************************************************* |
---|
| 906 | ! Rearrange field in a 2D variable |
---|
| 907 | ! First initialize to zero to avoid unvalid points causing problems |
---|
| 908 | ! |
---|
| 909 | !************************************************************************************* |
---|
[987] | 910 | !$OMP MASTER |
---|
[782] | 911 | rlic2D(:,:) = 0.0 |
---|
[987] | 912 | !$OMP END MASTER |
---|
[782] | 913 | CALL gath2cpl(rlic_in, rlic2D, knon, knindex) |
---|
| 914 | |
---|
| 915 | !************************************************************************************* |
---|
| 916 | ! Reset field to zero in the beginning of a new coupling period |
---|
| 917 | ! |
---|
| 918 | !************************************************************************************* |
---|
| 919 | IF (MOD(itime, nexca) == 1) THEN |
---|
[987] | 920 | !$OMP MASTER |
---|
[782] | 921 | cpl_rlic2D(:,:) = 0.0 |
---|
[987] | 922 | !$OMP END MASTER |
---|
[782] | 923 | ENDIF |
---|
| 924 | |
---|
| 925 | !************************************************************************************* |
---|
| 926 | ! Cumulate : Melting ice should be cumulated at each time-step |
---|
| 927 | ! |
---|
| 928 | !************************************************************************************* |
---|
[987] | 929 | !$OMP MASTER |
---|
[782] | 930 | cpl_rlic2D(:,:) = cpl_rlic2D(:,:) + rlic2D(:,:) / FLOAT(nexca) |
---|
[987] | 931 | !$OMP END MASTER |
---|
[782] | 932 | |
---|
| 933 | END SUBROUTINE cpl_send_landice_fields |
---|
| 934 | |
---|
| 935 | ! |
---|
| 936 | !************************************************************************************* |
---|
| 937 | ! |
---|
| 938 | |
---|
| 939 | SUBROUTINE cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat) |
---|
| 940 | ! This routine will send fields for all different surfaces to the coupler. |
---|
| 941 | ! This subroutine should be executed after calculations by the last surface(sea-ice), |
---|
| 942 | ! all calculations at the different surfaces have to be done before. |
---|
| 943 | ! |
---|
[996] | 944 | USE surface_data |
---|
[782] | 945 | ! Some includes |
---|
| 946 | !************************************************************************************* |
---|
[793] | 947 | INCLUDE "indicesol.h" |
---|
| 948 | INCLUDE "temps.h" |
---|
| 949 | INCLUDE "dimensions.h" |
---|
[782] | 950 | |
---|
| 951 | ! Input arguments |
---|
| 952 | !************************************************************************************* |
---|
| 953 | INTEGER, INTENT(IN) :: itime |
---|
| 954 | REAL, INTENT(IN) :: dtime |
---|
| 955 | REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat |
---|
| 956 | REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf |
---|
| 957 | LOGICAL, INTENT(IN) :: lafin |
---|
| 958 | |
---|
| 959 | ! Local variables |
---|
| 960 | !************************************************************************************* |
---|
| 961 | INTEGER :: error, sum_error, j |
---|
| 962 | INTEGER :: itau_w |
---|
[996] | 963 | INTEGER :: time_sec |
---|
[782] | 964 | INTEGER, DIMENSION(iim*(jjm+1)) :: ndexct |
---|
| 965 | REAL :: Up, Down |
---|
[836] | 966 | REAL, DIMENSION(iim, jj_nb) :: tmp_lon, tmp_lat |
---|
| 967 | REAL, DIMENSION(iim, jj_nb, 4) :: pctsrf2D |
---|
| 968 | REAL, DIMENSION(iim, jj_nb) :: deno |
---|
[782] | 969 | CHARACTER(len = 20) :: modname = 'cpl_send_all' |
---|
| 970 | CHARACTER(len = 80) :: abort_message |
---|
| 971 | |
---|
| 972 | ! Variables with fields to coupler |
---|
[836] | 973 | REAL, DIMENSION(iim, jj_nb) :: tmp_taux |
---|
| 974 | REAL, DIMENSION(iim, jj_nb) :: tmp_tauy |
---|
| 975 | REAL, DIMENSION(iim, jj_nb) :: tmp_calv |
---|
[782] | 976 | ! Table with all fields to send to coupler |
---|
[836] | 977 | REAL, DIMENSION(iim, jj_nb, jpflda2o1+jpflda2o2) :: tab_flds |
---|
[987] | 978 | REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi |
---|
| 979 | |
---|
[1001] | 980 | #ifdef CPP_MPI |
---|
[782] | 981 | INCLUDE 'mpif.h' |
---|
| 982 | INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status |
---|
| 983 | #endif |
---|
| 984 | |
---|
| 985 | ! End definitions |
---|
| 986 | !************************************************************************************* |
---|
| 987 | |
---|
| 988 | |
---|
| 989 | |
---|
| 990 | !************************************************************************************* |
---|
| 991 | ! All fields are stored in a table tab_flds(:,:,:) |
---|
[1079] | 992 | ! First store the fields which are already on the right format |
---|
[782] | 993 | ! |
---|
| 994 | !************************************************************************************* |
---|
[987] | 995 | !$OMP MASTER |
---|
[1079] | 996 | tab_flds(:,:,7) = cpl_windsp2D(:,:) |
---|
| 997 | tab_flds(:,:,8) = cpl_sols2D(:,:,2) |
---|
| 998 | tab_flds(:,:,9) = cpl_sols2D(:,:,1) |
---|
| 999 | tab_flds(:,:,10) = cpl_nsol2D(:,:,2) |
---|
| 1000 | tab_flds(:,:,11) = cpl_nsol2D(:,:,1) |
---|
| 1001 | tab_flds(:,:,12) = cpl_fder2D(:,:,2) |
---|
| 1002 | |
---|
[996] | 1003 | IF (version_ocean=='nemo') THEN |
---|
[1079] | 1004 | tab_flds(:,:,18) = cpl_rriv2D(:,:) + cpl_rcoa2D(:,:) |
---|
[996] | 1005 | ELSE IF (version_ocean=='opa8') THEN |
---|
| 1006 | tab_flds(:,:,13) = cpl_evap2D(:,:,2) |
---|
| 1007 | tab_flds(:,:,14) = cpl_evap2D(:,:,1) |
---|
| 1008 | tab_flds(:,:,17) = cpl_rcoa2D(:,:) |
---|
| 1009 | tab_flds(:,:,18) = cpl_rriv2D(:,:) |
---|
| 1010 | END IF |
---|
[1079] | 1011 | |
---|
[782] | 1012 | !************************************************************************************* |
---|
| 1013 | ! Transform the fraction of sub-surfaces from 1D to 2D array |
---|
| 1014 | ! |
---|
| 1015 | !************************************************************************************* |
---|
| 1016 | pctsrf2D(:,:,:) = 0. |
---|
[987] | 1017 | !$OMP END MASTER |
---|
[782] | 1018 | CALL gath2cpl(pctsrf(:,is_oce), pctsrf2D(:,:,is_oce), klon, unity) |
---|
| 1019 | CALL gath2cpl(pctsrf(:,is_sic), pctsrf2D(:,:,is_sic), klon, unity) |
---|
| 1020 | CALL gath2cpl(pctsrf(:,is_lic), pctsrf2D(:,:,is_lic), klon, unity) |
---|
| 1021 | |
---|
| 1022 | !************************************************************************************* |
---|
| 1023 | ! Calculate the average calving per latitude |
---|
| 1024 | ! Store calving in tab_flds(:,:,19) |
---|
| 1025 | ! |
---|
| 1026 | !************************************************************************************* |
---|
[987] | 1027 | IF (is_omp_root) THEN |
---|
| 1028 | |
---|
[1001] | 1029 | DO j = 1, jj_nb |
---|
| 1030 | tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:iim,j), & |
---|
| 1031 | pctsrf2D(1:iim,j,is_lic)) / REAL(iim) |
---|
| 1032 | ENDDO |
---|
[782] | 1033 | |
---|
[1001] | 1034 | |
---|
| 1035 | IF (is_parallel) THEN |
---|
[987] | 1036 | IF (.NOT. is_north_pole) THEN |
---|
[1001] | 1037 | #ifdef CPP_MPI |
---|
[987] | 1038 | CALL MPI_RECV(Up,1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,status,error) |
---|
| 1039 | CALL MPI_SEND(tmp_calv(1,1),1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,error) |
---|
[782] | 1040 | #endif |
---|
[987] | 1041 | ENDIF |
---|
[1001] | 1042 | |
---|
[987] | 1043 | IF (.NOT. is_south_pole) THEN |
---|
[1001] | 1044 | #ifdef CPP_MPI |
---|
[987] | 1045 | CALL MPI_SEND(tmp_calv(1,jj_nb),1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,error) |
---|
| 1046 | CALL MPI_RECV(down,1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,status,error) |
---|
[782] | 1047 | #endif |
---|
[987] | 1048 | ENDIF |
---|
[996] | 1049 | |
---|
[987] | 1050 | IF (.NOT. is_north_pole .AND. ii_begin /=1) THEN |
---|
| 1051 | Up=Up+tmp_calv(iim,1) |
---|
| 1052 | tmp_calv(:,1)=Up |
---|
| 1053 | ENDIF |
---|
[996] | 1054 | |
---|
[987] | 1055 | IF (.NOT. is_south_pole .AND. ii_end /= iim) THEN |
---|
| 1056 | Down=Down+tmp_calv(1,jj_nb) |
---|
| 1057 | tmp_calv(:,jj_nb)=Down |
---|
| 1058 | ENDIF |
---|
| 1059 | ENDIF |
---|
[996] | 1060 | |
---|
| 1061 | IF (version_ocean=='nemo') THEN |
---|
| 1062 | tab_flds(:,:,17) = tmp_calv(:,:) |
---|
| 1063 | ELSE IF (version_ocean=='opa8') THEN |
---|
| 1064 | tab_flds(:,:,19) = tmp_calv(:,:) |
---|
| 1065 | END IF |
---|
[782] | 1066 | |
---|
| 1067 | !************************************************************************************* |
---|
| 1068 | ! Calculate total flux for snow, rain and wind with weighted addition using the |
---|
| 1069 | ! fractions of ocean and seaice. |
---|
| 1070 | ! |
---|
| 1071 | !************************************************************************************* |
---|
[996] | 1072 | ! fraction oce+seaice |
---|
| 1073 | deno = pctsrf2D(:,:,is_oce) + pctsrf2D(:,:,is_sic) |
---|
[836] | 1074 | |
---|
[996] | 1075 | IF (version_ocean=='nemo') THEN |
---|
[1079] | 1076 | tab_flds(:,:,13) = cpl_evap2D(:,:,2) - (cpl_rain2D(:,:,2) + cpl_snow2D(:,:,2)) |
---|
| 1077 | |
---|
| 1078 | tab_flds(:,:,14) = 0.0 |
---|
[996] | 1079 | tmp_taux(:,:) = 0.0 |
---|
| 1080 | tmp_tauy(:,:) = 0.0 |
---|
| 1081 | ! For all valid grid cells containing some fraction of ocean or sea-ice |
---|
| 1082 | WHERE ( deno(:,:) /= 0 ) |
---|
| 1083 | tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
---|
| 1084 | cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
---|
| 1085 | tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
---|
| 1086 | cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
---|
[1079] | 1087 | tab_flds(:,:,14) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
---|
| 1088 | cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
---|
| 1089 | |
---|
[996] | 1090 | ENDWHERE |
---|
[1079] | 1091 | |
---|
| 1092 | ! WHERE (pctsrf2D(:,:,is_sic) == 0) |
---|
| 1093 | ! cpl_evap2D(:,:,2) = 0.0 |
---|
| 1094 | ! END WHERE |
---|
[996] | 1095 | |
---|
[1079] | 1096 | tab_flds(:,:,14) = cpl_evap2D(:,:,2) - tab_flds(:,:,14) |
---|
| 1097 | tab_flds(:,:,15) = cpl_evap2D(:,:,1) - (cpl_rain2D(:,:,1) + cpl_snow2D(:,:,1)) |
---|
| 1098 | tab_flds(:,:,16) = cpl_evap2D(:,:,2) |
---|
| 1099 | |
---|
[996] | 1100 | ELSE IF (version_ocean=='opa8') THEN |
---|
[1079] | 1101 | ! Store fields for rain and snow in tab_flds(:,:,15) and tab_flds(:,:,16) |
---|
[996] | 1102 | tab_flds(:,:,15) = 0.0 |
---|
| 1103 | tab_flds(:,:,16) = 0.0 |
---|
| 1104 | tmp_taux(:,:) = 0.0 |
---|
| 1105 | tmp_tauy(:,:) = 0.0 |
---|
| 1106 | ! For all valid grid cells containing some fraction of ocean or sea-ice |
---|
| 1107 | WHERE ( deno(:,:) /= 0 ) |
---|
| 1108 | tab_flds(:,:,15) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
---|
| 1109 | cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
---|
| 1110 | tab_flds(:,:,16) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
---|
| 1111 | cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
---|
| 1112 | |
---|
| 1113 | tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
---|
| 1114 | cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
---|
| 1115 | tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & |
---|
| 1116 | cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) |
---|
| 1117 | ENDWHERE |
---|
| 1118 | END IF |
---|
[987] | 1119 | |
---|
[996] | 1120 | ENDIF ! is_omp_root |
---|
| 1121 | |
---|
[782] | 1122 | !************************************************************************************* |
---|
| 1123 | ! Transform the wind components from local atmospheric 2D coordinates to geocentric |
---|
| 1124 | ! 3D coordinates. |
---|
| 1125 | ! Store the resulting wind components in tab_flds(:,:,1:6) |
---|
| 1126 | !************************************************************************************* |
---|
| 1127 | |
---|
| 1128 | ! Transform the longitudes and latitudes on 2D arrays |
---|
[1001] | 1129 | |
---|
[987] | 1130 | CALL gather_omp(rlon,rlon_mpi) |
---|
| 1131 | CALL gather_omp(rlat,rlat_mpi) |
---|
| 1132 | !$OMP MASTER |
---|
| 1133 | CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon) |
---|
| 1134 | CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat) |
---|
| 1135 | !$OMP END MASTER |
---|
| 1136 | |
---|
[782] | 1137 | IF (is_sequential) THEN |
---|
| 1138 | IF (is_north_pole) tmp_lon(:,1) = tmp_lon(:,2) |
---|
| 1139 | IF (is_south_pole) tmp_lon(:,jjm+1) = tmp_lon(:,jjm) |
---|
| 1140 | ENDIF |
---|
| 1141 | |
---|
| 1142 | ! NetCDF output of the wind before transformation of coordinate system |
---|
| 1143 | IF (is_sequential) THEN |
---|
| 1144 | ndexct(:) = 0 |
---|
| 1145 | itau_w = itau_phy + itime |
---|
| 1146 | CALL histwrite(nidct,'tauxe',itau_w,tmp_taux,iim*(jjm+1),ndexct) |
---|
| 1147 | CALL histwrite(nidct,'tauyn',itau_w,tmp_tauy,iim*(jjm+1),ndexct) |
---|
| 1148 | CALL histwrite(nidct,'tmp_lon',itau_w,tmp_lon,iim*(jjm+1),ndexct) |
---|
| 1149 | CALL histwrite(nidct,'tmp_lat',itau_w,tmp_lat,iim*(jjm+1),ndexct) |
---|
| 1150 | ENDIF |
---|
| 1151 | |
---|
[1067] | 1152 | ! Transform the wind from spherical atmospheric 2D coordinates to geocentric |
---|
| 1153 | ! cartesian 3D coordinates |
---|
[987] | 1154 | !$OMP MASTER |
---|
[782] | 1155 | CALL atm2geo (iim, jj_nb, tmp_taux, tmp_tauy, tmp_lon, tmp_lat, & |
---|
| 1156 | tab_flds(:,:,1), tab_flds(:,:,2), tab_flds(:,:,3) ) |
---|
| 1157 | |
---|
| 1158 | tab_flds(:,:,4) = tab_flds(:,:,1) |
---|
| 1159 | tab_flds(:,:,5) = tab_flds(:,:,2) |
---|
| 1160 | tab_flds(:,:,6) = tab_flds(:,:,3) |
---|
[987] | 1161 | !$OMP END MASTER |
---|
[782] | 1162 | |
---|
| 1163 | !************************************************************************************* |
---|
| 1164 | ! NetCDF output of all fields just before sending to coupler. |
---|
| 1165 | ! |
---|
| 1166 | !************************************************************************************* |
---|
| 1167 | IF (is_sequential) THEN |
---|
| 1168 | CALL histwrite(nidct,cl_writ(8), itau_w,tab_flds(:,:,8), iim*(jjm+1),ndexct) |
---|
| 1169 | CALL histwrite(nidct,cl_writ(9), itau_w,tab_flds(:,:,9), iim*(jjm+1),ndexct) |
---|
| 1170 | CALL histwrite(nidct,cl_writ(10),itau_w,tab_flds(:,:,10),iim*(jjm+1),ndexct) |
---|
| 1171 | CALL histwrite(nidct,cl_writ(11),itau_w,tab_flds(:,:,11),iim*(jjm+1),ndexct) |
---|
| 1172 | CALL histwrite(nidct,cl_writ(12),itau_w,tab_flds(:,:,12),iim*(jjm+1),ndexct) |
---|
| 1173 | CALL histwrite(nidct,cl_writ(13),itau_w,tab_flds(:,:,13),iim*(jjm+1),ndexct) |
---|
| 1174 | CALL histwrite(nidct,cl_writ(14),itau_w,tab_flds(:,:,14),iim*(jjm+1),ndexct) |
---|
| 1175 | CALL histwrite(nidct,cl_writ(15),itau_w,tab_flds(:,:,15),iim*(jjm+1),ndexct) |
---|
| 1176 | CALL histwrite(nidct,cl_writ(16),itau_w,tab_flds(:,:,16),iim*(jjm+1),ndexct) |
---|
| 1177 | CALL histwrite(nidct,cl_writ(17),itau_w,tab_flds(:,:,17),iim*(jjm+1),ndexct) |
---|
| 1178 | CALL histwrite(nidct,cl_writ(18),itau_w,tab_flds(:,:,18),iim*(jjm+1),ndexct) |
---|
| 1179 | CALL histwrite(nidct,cl_writ(19),itau_w,tab_flds(:,:,19),iim*(jjm+1),ndexct) |
---|
| 1180 | CALL histwrite(nidct,cl_writ(1), itau_w,tab_flds(:,:,1), iim*(jjm+1),ndexct) |
---|
| 1181 | CALL histwrite(nidct,cl_writ(2), itau_w,tab_flds(:,:,2), iim*(jjm+1),ndexct) |
---|
| 1182 | CALL histwrite(nidct,cl_writ(3), itau_w,tab_flds(:,:,3), iim*(jjm+1),ndexct) |
---|
| 1183 | CALL histwrite(nidct,cl_writ(4), itau_w,tab_flds(:,:,4), iim*(jjm+1),ndexct) |
---|
| 1184 | CALL histwrite(nidct,cl_writ(5), itau_w,tab_flds(:,:,5), iim*(jjm+1),ndexct) |
---|
| 1185 | CALL histwrite(nidct,cl_writ(6), itau_w,tab_flds(:,:,6), iim*(jjm+1),ndexct) |
---|
| 1186 | CALL histwrite(nidct,cl_writ(7), itau_w,tab_flds(:,:,7), iim*(jjm+1),ndexct) |
---|
| 1187 | CALL histsync(nidct) |
---|
| 1188 | ENDIF |
---|
| 1189 | |
---|
| 1190 | |
---|
| 1191 | !************************************************************************************* |
---|
| 1192 | ! Send the table of all fields |
---|
| 1193 | ! |
---|
| 1194 | !************************************************************************************* |
---|
[996] | 1195 | time_sec=(itime-1)*dtime |
---|
[782] | 1196 | #ifdef CPP_COUPLE |
---|
[987] | 1197 | !$OMP MASTER |
---|
[1010] | 1198 | CALL intocpl(time_sec, lafin, tab_flds(:,:,:)) |
---|
[987] | 1199 | !$OMP END MASTER |
---|
[782] | 1200 | #endif |
---|
| 1201 | |
---|
| 1202 | !************************************************************************************* |
---|
| 1203 | ! Finish with some dellocate |
---|
| 1204 | ! |
---|
| 1205 | !************************************************************************************* |
---|
| 1206 | sum_error=0 |
---|
| 1207 | DEALLOCATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D, cpl_snow2D, stat=error ) |
---|
| 1208 | sum_error = sum_error + error |
---|
| 1209 | DEALLOCATE(cpl_evap2D, cpl_tsol2D, cpl_fder2D, cpl_albe2D, stat=error ) |
---|
| 1210 | sum_error = sum_error + error |
---|
| 1211 | DEALLOCATE(cpl_taux2D, cpl_tauy2D, cpl_windsp2D, stat=error ) |
---|
| 1212 | sum_error = sum_error + error |
---|
| 1213 | IF (sum_error /= 0) THEN |
---|
| 1214 | abort_message='Pb in deallocation of cpl_xxxx2D coupling variables' |
---|
| 1215 | CALL abort_gcm(modname,abort_message,1) |
---|
| 1216 | ENDIF |
---|
| 1217 | |
---|
| 1218 | END SUBROUTINE cpl_send_all |
---|
| 1219 | ! |
---|
| 1220 | !************************************************************************************* |
---|
| 1221 | ! |
---|
| 1222 | SUBROUTINE cpl2gath(champ_in, champ_out, knon, knindex) |
---|
[1001] | 1223 | USE mod_phys_lmdz_para |
---|
[782] | 1224 | ! Cette routine ecrit un champ 'gathered' sur la grille 2D pour le passer |
---|
| 1225 | ! au coupleur. |
---|
| 1226 | ! |
---|
| 1227 | ! |
---|
| 1228 | ! input: |
---|
| 1229 | ! champ_in champ sur la grille gathere |
---|
| 1230 | ! knon nombre de points dans le domaine a traiter |
---|
| 1231 | ! knindex index des points de la surface a traiter |
---|
| 1232 | ! |
---|
| 1233 | ! output: |
---|
| 1234 | ! champ_out champ sur la grille 2D |
---|
| 1235 | ! |
---|
[793] | 1236 | INCLUDE "dimensions.h" |
---|
[782] | 1237 | |
---|
| 1238 | ! Input |
---|
| 1239 | INTEGER, INTENT(IN) :: knon |
---|
| 1240 | REAL, DIMENSION(iim,jj_nb), INTENT(IN) :: champ_in |
---|
| 1241 | INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
---|
| 1242 | |
---|
| 1243 | ! Output |
---|
[987] | 1244 | REAL, DIMENSION(klon_mpi), INTENT(OUT) :: champ_out |
---|
[782] | 1245 | |
---|
| 1246 | ! Local |
---|
| 1247 | INTEGER :: i, ig |
---|
[987] | 1248 | REAL, DIMENSION(klon_mpi) :: temp_mpi |
---|
| 1249 | REAL, DIMENSION(klon) :: temp_omp |
---|
[782] | 1250 | |
---|
| 1251 | !************************************************************************************* |
---|
| 1252 | ! |
---|
[1001] | 1253 | |
---|
| 1254 | |
---|
[782] | 1255 | ! Transform from 2 dimensions (iim,jj_nb) to 1 dimension (klon) |
---|
[987] | 1256 | !$OMP MASTER |
---|
| 1257 | CALL Grid2Dto1D_mpi(champ_in,temp_mpi) |
---|
| 1258 | !$OMP END MASTER |
---|
[782] | 1259 | |
---|
[987] | 1260 | CALL scatter_omp(temp_mpi,temp_omp) |
---|
| 1261 | |
---|
[782] | 1262 | ! Compress from klon to knon |
---|
| 1263 | DO i = 1, knon |
---|
| 1264 | ig = knindex(i) |
---|
[987] | 1265 | champ_out(i) = temp_omp(ig) |
---|
[782] | 1266 | ENDDO |
---|
[1001] | 1267 | |
---|
[782] | 1268 | END SUBROUTINE cpl2gath |
---|
| 1269 | ! |
---|
| 1270 | !************************************************************************************* |
---|
| 1271 | ! |
---|
| 1272 | SUBROUTINE gath2cpl(champ_in, champ_out, knon, knindex) |
---|
[987] | 1273 | USE mod_phys_lmdz_para |
---|
[782] | 1274 | ! Cette routine ecrit un champ 'gathered' sur la grille 2D pour le passer |
---|
| 1275 | ! au coupleur. |
---|
| 1276 | ! |
---|
| 1277 | ! input: |
---|
| 1278 | ! champ_in champ sur la grille gathere |
---|
| 1279 | ! knon nombre de points dans le domaine a traiter |
---|
| 1280 | ! knindex index des points de la surface a traiter |
---|
| 1281 | ! |
---|
| 1282 | ! output: |
---|
| 1283 | ! champ_out champ sur la grille 2D |
---|
| 1284 | ! |
---|
[793] | 1285 | INCLUDE "dimensions.h" |
---|
[782] | 1286 | |
---|
| 1287 | ! Input arguments |
---|
| 1288 | !************************************************************************************* |
---|
| 1289 | INTEGER, INTENT(IN) :: knon |
---|
| 1290 | REAL, DIMENSION(klon), INTENT(IN) :: champ_in |
---|
| 1291 | INTEGER, DIMENSION(klon), INTENT(IN) :: knindex |
---|
| 1292 | |
---|
| 1293 | ! Output arguments |
---|
| 1294 | !************************************************************************************* |
---|
| 1295 | REAL, DIMENSION(iim,jj_nb), INTENT(OUT) :: champ_out |
---|
| 1296 | |
---|
| 1297 | ! Local variables |
---|
| 1298 | !************************************************************************************* |
---|
| 1299 | INTEGER :: i, ig |
---|
[987] | 1300 | REAL, DIMENSION(klon) :: temp_omp |
---|
| 1301 | REAL, DIMENSION(klon_mpi) :: temp_mpi |
---|
[782] | 1302 | !************************************************************************************* |
---|
| 1303 | |
---|
| 1304 | ! Decompress from knon to klon |
---|
[987] | 1305 | temp_omp = 0. |
---|
[782] | 1306 | DO i = 1, knon |
---|
| 1307 | ig = knindex(i) |
---|
[987] | 1308 | temp_omp(ig) = champ_in(i) |
---|
[782] | 1309 | ENDDO |
---|
| 1310 | |
---|
| 1311 | ! Transform from 1 dimension (klon) to 2 dimensions (iim,jj_nb) |
---|
[987] | 1312 | CALL gather_omp(temp_omp,temp_mpi) |
---|
| 1313 | |
---|
| 1314 | !$OMP MASTER |
---|
| 1315 | CALL Grid1Dto2D_mpi(temp_mpi,champ_out) |
---|
[782] | 1316 | |
---|
[987] | 1317 | IF (is_north_pole) champ_out(:,1)=temp_mpi(1) |
---|
| 1318 | IF (is_south_pole) champ_out(:,jj_nb)=temp_mpi(klon) |
---|
| 1319 | !$OMP END MASTER |
---|
[782] | 1320 | |
---|
| 1321 | END SUBROUTINE gath2cpl |
---|
| 1322 | ! |
---|
| 1323 | !************************************************************************************* |
---|
| 1324 | ! |
---|
| 1325 | END MODULE cpl_mod |
---|
| 1326 | |
---|