Changeset 4671 for palm/trunk/SOURCE/surface_coupler.f90
- Timestamp:
- Sep 9, 2020 8:27:58 PM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/surface_coupler.f90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/surface_coupler.f90
r4429 r4671 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 23 ! 22 ! 23 ! 24 24 ! Former revisions: 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Implementation of downward facing USM and LSM surfaces 28 ! 29 ! 4429 2020-02-27 15:24:30Z raasch 27 30 ! bugfix: preprocessor directives rearranged for serial mode 28 31 ! … … 168 171 !-- Send heat flux at bottom surface to the ocean. First, transfer from 169 172 !-- 1D surface type to 2D grid. 170 CALL transfer_1D_to_2D_equal( surf_def_h(0)%shf, surf_lsm_h %shf, &171 surf_usm_h %shf )173 CALL transfer_1D_to_2D_equal( surf_def_h(0)%shf, surf_lsm_h(0)%shf, & 174 surf_usm_h(0)%shf ) 172 175 CALL MPI_SEND( surface_flux(nysg,nxlg), ngp_xy, MPI_REAL, target_id, & 173 176 12, comm_inter, ierr ) … … 175 178 !-- Send humidity flux at bottom surface to the ocean. First, transfer 176 179 !-- from 1D surface type to 2D grid. 177 CALL transfer_1D_to_2D_equal( surf_def_h(0)%qsws, surf_lsm_h %qsws, &178 surf_usm_h %qsws )180 CALL transfer_1D_to_2D_equal( surf_def_h(0)%qsws, surf_lsm_h(0)%qsws, & 181 surf_usm_h(0)%qsws ) 179 182 IF ( humidity ) THEN 180 183 CALL MPI_SEND( surface_flux(nysg,nxlg), ngp_xy, MPI_REAL, & … … 188 191 !-- Send the momentum flux (u) at bottom surface to the ocean. First, 189 192 !-- transfer from 1D surface type to 2D grid. 190 CALL transfer_1D_to_2D_equal( surf_def_h(0)%usws, surf_lsm_h %usws, &191 surf_usm_h %usws )193 CALL transfer_1D_to_2D_equal( surf_def_h(0)%usws, surf_lsm_h(0)%usws, & 194 surf_usm_h(0)%usws ) 192 195 CALL MPI_SEND( surface_flux(nysg,nxlg), ngp_xy, MPI_REAL, target_id, & 193 196 15, comm_inter, ierr ) … … 195 198 !-- Send the momentum flux (v) at bottom surface to the ocean. First, 196 199 !-- transfer from 1D surface type to 2D grid. 197 CALL transfer_1D_to_2D_equal( surf_def_h(0)%vsws, surf_lsm_h %vsws, &198 surf_usm_h %vsws )200 CALL transfer_1D_to_2D_equal( surf_def_h(0)%vsws, surf_lsm_h(0)%vsws, & 201 surf_usm_h(0)%vsws ) 199 202 CALL MPI_SEND( surface_flux(nysg,nxlg), ngp_xy, MPI_REAL, target_id, & 200 203 16, comm_inter, ierr ) … … 218 221 ! 219 222 !-- Transfer from 1D surface type to 2D grid. 220 CALL transfer_1D_to_2D_unequal( surf_def_h(0)%shf, surf_lsm_h %shf, &221 surf_usm_h %shf )223 CALL transfer_1D_to_2D_unequal( surf_def_h(0)%shf, surf_lsm_h(0)%shf, & 224 surf_usm_h(0)%shf ) 222 225 223 226 CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, MPI_SUM, 0, & … … 232 235 !-- Transfer from 1D surface type to 2D grid. 233 236 CALL transfer_1D_to_2D_unequal( surf_def_h(0)%qsws, & 234 surf_lsm_h %qsws, &235 surf_usm_h %qsws )237 surf_lsm_h(0)%qsws, & 238 surf_usm_h(0)%qsws ) 236 239 237 240 CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, MPI_SUM, & … … 255 258 ! 256 259 !-- Transfer from 1D surface type to 2D grid. 257 CALL transfer_1D_to_2D_unequal( surf_def_h(0)%usws, surf_lsm_h %usws, &258 surf_usm_h %usws )260 CALL transfer_1D_to_2D_unequal( surf_def_h(0)%usws, surf_lsm_h(0)%usws, & 261 surf_usm_h(0)%usws ) 259 262 CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, MPI_SUM, 0, & 260 263 comm2d, ierr ) … … 266 269 ! 267 270 !-- Transfer from 1D surface type to 2D grid. 268 CALL transfer_1D_to_2D_unequal( surf_def_h(0)%usws, surf_lsm_h %usws, &269 surf_usm_h %usws )271 CALL transfer_1D_to_2D_unequal( surf_def_h(0)%usws, surf_lsm_h(0)%usws, & 272 surf_usm_h(0)%usws ) 270 273 CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, MPI_SUM, 0, & 271 274 comm2d, ierr ) … … 473 476 474 477 REAL(wp), DIMENSION(1:surf_def_h(0)%ns) :: def_1d !< 1D surface flux, default surfaces 475 REAL(wp), DIMENSION(1:surf_lsm_h %ns):: lsm_1d !< 1D surface flux, natural surfaces476 REAL(wp), DIMENSION(1:surf_usm_h %ns):: usm_1d !< 1D surface flux, urban surfaces478 REAL(wp), DIMENSION(1:surf_lsm_h(0)%ns) :: lsm_1d !< 1D surface flux, natural surfaces 479 REAL(wp), DIMENSION(1:surf_usm_h(0)%ns) :: usm_1d !< 1D surface flux, urban surfaces 477 480 ! 478 481 !-- Transfer surface flux at default surfaces to 2D grid … … 486 489 IF ( land_surface ) THEN 487 490 DO m = 1, SIZE(lsm_1d) 488 i = surf_lsm_h %i(m)489 j = surf_lsm_h %j(m)491 i = surf_lsm_h(0)%i(m) 492 j = surf_lsm_h(0)%j(m) 490 493 surface_flux(j,i) = lsm_1d(m) 491 494 ENDDO … … 495 498 IF ( urban_surface ) THEN 496 499 DO m = 1, SIZE(usm_1d) 497 i = surf_usm_h %i(m)498 j = surf_usm_h %j(m)500 i = surf_usm_h(0)%i(m) 501 j = surf_usm_h(0)%j(m) 499 502 surface_flux(j,i) = usm_1d(m) 500 503 ENDDO … … 541 544 542 545 REAL(wp), DIMENSION(1:surf_def_h(0)%ns) :: def_1d !< 1D surface flux, default surfaces 543 REAL(wp), DIMENSION(1:surf_lsm_h %ns) :: lsm_1d !< 1D surface flux, natural surfaces544 REAL(wp), DIMENSION(1:surf_usm_h %ns) :: usm_1d !< 1D surface flux, urban surfaces546 REAL(wp), DIMENSION(1:surf_lsm_h(0)%ns) :: lsm_1d !< 1D surface flux, natural surfaces 547 REAL(wp), DIMENSION(1:surf_usm_h(0)%ns) :: usm_1d !< 1D surface flux, urban surfaces 545 548 ! 546 549 !-- Transfer surface flux at default surfaces to 2D grid. Transfer no … … 559 562 IF ( land_surface ) THEN 560 563 DO m = 1, SIZE(lsm_1d) 561 i = surf_lsm_h %i(m)562 j = surf_lsm_h %j(m)564 i = surf_lsm_h(0)%i(m) 565 j = surf_lsm_h(0)%j(m) 563 566 564 567 IF ( i >= nxl .AND. i <= nxr .AND. & … … 572 575 IF ( urban_surface ) THEN 573 576 DO m = 1, SIZE(usm_1d) 574 i = surf_usm_h %i(m)575 j = surf_usm_h %j(m)577 i = surf_usm_h(0)%i(m) 578 j = surf_usm_h(0)%j(m) 576 579 577 580 IF ( i >= nxl .AND. i <= nxr .AND. &
Note: See TracChangeset
for help on using the changeset viewer.
