Changeset 4514 for palm/trunk/SOURCE
- Timestamp:
- Apr 30, 2020 4:29:59 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 10 edited
-
average_3d_data.f90 (modified) (3 diffs)
-
check_parameters.f90 (modified) (3 diffs)
-
data_output_2d.f90 (modified) (4 diffs)
-
init_3d_model.f90 (modified) (3 diffs)
-
module_interface.f90 (modified) (5 diffs)
-
modules.f90 (modified) (2 diffs)
-
plant_canopy_model_mod.f90 (modified) (10 diffs)
-
read_restart_data_mod.f90 (modified) (3 diffs)
-
sum_up_3d_data.f90 (modified) (7 diffs)
-
write_restart_data_mod.f90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/average_3d_data.f90
r4509 r4514 24 24 ! ----------------- 25 25 ! $Id$ 26 ! Enable output of qsurf and ssurf 27 ! 28 ! 4509 2020-04-26 15:57:55Z raasch 26 29 ! file re-formatted to follow the PALM coding standard 27 30 ! … … 284 287 ENDIF 285 288 289 CASE ( 'qsurf*' ) 290 IF ( ALLOCATED( qsurf_av ) ) THEN 291 DO i = nxlg, nxrg 292 DO j = nysg, nyng 293 qsurf_av(j,i) = qsurf_av(j,i) / REAL( average_count_3d, KIND=wp ) 294 ENDDO 295 ENDDO 296 CALL exchange_horiz_2d( qsurf_av ) 297 ENDIF 298 286 299 CASE ( 'r_a*' ) 287 300 IF ( ALLOCATED( r_a_av ) ) THEN … … 315 328 ENDIF 316 329 330 CASE ( 'ssurf*' ) 331 IF ( ALLOCATED( ssurf_av ) ) THEN 332 DO i = nxlg, nxrg 333 DO j = nysg, nyng 334 ssurf_av(j,i) = ssurf_av(j,i) / REAL( average_count_3d, KIND=wp ) 335 ENDDO 336 ENDDO 337 CALL exchange_horiz_2d( ssurf_av ) 338 ENDIF 339 317 340 CASE ( 'ssws*' ) 318 341 IF ( ALLOCATED( ssws_av ) ) THEN -
palm/trunk/SOURCE/check_parameters.f90
r4513 r4514 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Enable output of qsurf and ssurf 28 ! 29 ! 4513 2020-04-30 13:45:47Z raasch 27 30 ! unused modules removed 28 31 ! … … 2478 2481 CONTINUE 2479 2482 2480 CASE ( 'ghf*', 'lwp*', 'ol*', 'qs ws*', 'r_a*',&2481 'shf*', 'ss ws*', 't*', 'tsurf*', 'us*',&2482 'z0*', 'z0h*', 'z0q*' )2483 CASE ( 'ghf*', 'lwp*', 'ol*', 'qsurf*', 'qsws*', 'r_a*', & 2484 'shf*', 'ssurf*', 'ssws*', 't*', 'tsurf*', 'us*', & 2485 'z0*', 'z0h*', 'z0q*' ) 2483 2486 IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN 2484 2487 message_string = 'illegal value for data_output: "' // & … … 2523 2526 IF ( TRIM( var ) == 'lwp*' ) unit = 'kg/m2' 2524 2527 IF ( TRIM( var ) == 'ol*' ) unit = 'm' 2528 IF ( TRIM( var ) == 'qsurf*' ) unit = 'kg/kg' 2525 2529 IF ( TRIM( var ) == 'qsws*' ) unit = 'kgm/kgs' 2526 2530 IF ( TRIM( var ) == 'r_a*' ) unit = 's/m' 2527 2531 IF ( TRIM( var ) == 'shf*' ) unit = 'K*m/s' 2532 IF ( TRIM( var ) == 'ssurf*' ) unit = 'kg/kg' 2528 2533 IF ( TRIM( var ) == 'ssws*' ) unit = 'kg/m2*s' 2529 2534 IF ( TRIM( var ) == 't*' ) unit = 'K' -
palm/trunk/SOURCE/data_output_2d.f90
r4500 r4514 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Enable output of qsurf and ssurf 28 ! 29 ! 4500 2020-04-17 10:12:45Z suehring 27 30 ! Unify output conversion of sensible and latent heat flux 28 31 ! … … 123 126 USE indices, & 124 127 ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, & 125 nzb, nzt, wall_flags_total_0 128 nzb, nzt, & 129 topo_top_ind, & 130 wall_flags_total_0 126 131 127 132 USE kinds … … 701 706 IF ( mode == 'xy' ) level_z = zu 702 707 708 CASE ( 'qsurf*_xy' ) ! 2d-array 709 IF ( av == 0 ) THEN 710 DO m = 1, surf_def_h(0)%ns 711 i = surf_def_h(0)%i(m) 712 j = surf_def_h(0)%j(m) 713 local_pf(i,j,nzb+1) = surf_def_h(0)%q_surface(m) 714 ENDDO 715 716 DO m = 1, surf_lsm_h%ns 717 i = surf_lsm_h%i(m) 718 j = surf_lsm_h%j(m) 719 local_pf(i,j,nzb+1) = surf_lsm_h%q_surface(m) 720 ENDDO 721 722 DO m = 1, surf_usm_h%ns 723 i = surf_usm_h%i(m) 724 j = surf_usm_h%j(m) 725 local_pf(i,j,nzb+1) = surf_usm_h%q_surface(m) 726 ENDDO 727 728 ELSE 729 IF ( .NOT. ALLOCATED( qsurf_av ) ) THEN 730 ALLOCATE( qsurf_av(nysg:nyng,nxlg:nxrg) ) 731 qsurf_av = REAL( fill_value, KIND = wp ) 732 ENDIF 733 DO i = nxl, nxr 734 DO j = nys, nyn 735 local_pf(i,j,nzb+1) = qsurf_av(j,i) 736 ENDDO 737 ENDDO 738 ENDIF 739 resorted = .TRUE. 740 two_d = .TRUE. 741 level_z(nzb+1) = zu(nzb+1) 742 703 743 CASE ( 'qsws*_xy' ) ! 2d-array 704 744 IF ( av == 0 ) THEN … … 845 885 two_d = .TRUE. 846 886 level_z(nzb+1) = zu(nzb+1) 847 887 888 CASE ( 'ssurf*_xy' ) ! 2d-array 889 IF ( av == 0 ) THEN 890 DO i = nxl, nxr 891 DO j = nys, nyn 892 k = topo_top_ind(j,i,0) 893 local_pf(i,j,nzb+1) = s(k+k,j,i) 894 ENDDO 895 ENDDO 896 ELSE 897 IF ( .NOT. ALLOCATED( ssurf_av ) ) THEN 898 ALLOCATE( ssurf_av(nysg:nyng,nxlg:nxrg) ) 899 ssurf_av = REAL( fill_value, KIND = wp ) 900 ENDIF 901 DO i = nxl, nxr 902 DO j = nys, nyn 903 local_pf(i,j,nzb+1) = ssurf_av(j,i) 904 ENDDO 905 ENDDO 906 ENDIF 907 resorted = .TRUE. 908 two_d = .TRUE. 909 level_z(nzb+1) = zu(nzb+1) 910 848 911 CASE ( 'ssws*_xy' ) ! 2d-array 849 912 IF ( av == 0 ) THEN -
palm/trunk/SOURCE/init_3d_model.f90
r4493 r4514 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Add possibility to initialize surface sensible and latent heat fluxes via 28 ! a static driver. 29 ! 30 ! 4493 2020-04-10 09:49:43Z pavelkrc 27 31 ! Overwrite u_init, v_init, pt_init, q_init and s_init with hom for all 28 32 ! cyclic_fill-cases, not only for turbulent_inflow = .TRUE. … … 1599 1603 !-- Initialize roughness length. Note, z0 will be only initialized at 1600 1604 !-- default-type surfaces. At natural or urban z0 is implicitly 1601 !-- initialized by the respective parameter lists.1605 !-- initialized by the respective parameter lists. 1602 1606 !-- Initialize horizontal surface elements. 1603 1607 CALL init_single_surface_properties( surf_def_h(0)%z0, & … … 1624 1628 ENDIF 1625 1629 ! 1626 !-- Additional variables, e.g. shf, qsws, etc, can be initialized the 1630 !-- Input surface sensible heat flux. 1631 IF ( check_existence( vars_pids, 'shf' ) ) THEN 1632 ! 1633 !-- Read _FillValue attribute 1634 CALL get_attribute( pids_id, char_fill, tmp_2d%fill, & 1635 .FALSE., 'shf' ) 1636 ! 1637 !-- Read variable 1638 CALL get_variable( pids_id, 'shf', tmp_2d%var, & 1639 nxl, nxr, nys, nyn ) 1640 ! 1641 !-- Initialize heat flux. Note, shf will be only initialized at 1642 !-- default-type surfaces. At natural or urban shf is implicitly 1643 !-- initialized by the respective parameter lists. 1644 !-- Initialize horizontal surface elements. 1645 CALL init_single_surface_properties( surf_def_h(0)%shf, & 1646 tmp_2d%var, & 1647 surf_def_h(0)%ns, & 1648 tmp_2d%fill, & 1649 surf_def_h(0)%i, & 1650 surf_def_h(0)%j ) 1651 ! 1652 !-- Initialize heat flux also at vertical surface elements. 1653 !-- Note, the actual 2D input arrays are only defined on the 1654 !-- subdomain. Therefore, pass the index arrays with their respective 1655 !-- offset values. 1656 DO l = 0, 3 1657 CALL init_single_surface_properties( & 1658 surf_def_v(l)%shf, & 1659 tmp_2d%var, & 1660 surf_def_v(l)%ns, & 1661 tmp_2d%fill, & 1662 surf_def_v(l)%i + surf_def_v(l)%ioff, & 1663 surf_def_v(l)%j + surf_def_v(l)%joff ) 1664 ENDDO 1665 1666 ENDIF 1667 ! 1668 !-- Input surface sensible heat flux. 1669 IF ( check_existence( vars_pids, 'qsws' ) ) THEN 1670 ! 1671 !-- Read _FillValue attribute 1672 CALL get_attribute( pids_id, char_fill, tmp_2d%fill, & 1673 .FALSE., 'qsws' ) 1674 ! 1675 !-- Read variable 1676 CALL get_variable( pids_id, 'qsws', tmp_2d%var, & 1677 nxl, nxr, nys, nyn ) 1678 ! 1679 !-- Initialize latent heat flux. Note, qsws will be only initialized at 1680 !-- default-type surfaces. At natural or urban qsws is implicitly 1681 !-- initialized by the respective parameter lists. 1682 !-- Initialize horizontal surface elements. 1683 CALL init_single_surface_properties( surf_def_h(0)%qsws, & 1684 tmp_2d%var, & 1685 surf_def_h(0)%ns, & 1686 tmp_2d%fill, & 1687 surf_def_h(0)%i, & 1688 surf_def_h(0)%j ) 1689 ! 1690 !-- Initialize latent heat flux also at vertical surface elements. 1691 !-- Note, the actual 2D input arrays are only defined on the 1692 !-- subdomain. Therefore, pass the index arrays with their respective 1693 !-- offset values. 1694 DO l = 0, 3 1695 CALL init_single_surface_properties( & 1696 surf_def_v(l)%qsws, & 1697 tmp_2d%var, & 1698 surf_def_v(l)%ns, & 1699 tmp_2d%fill, & 1700 surf_def_v(l)%i + surf_def_v(l)%ioff, & 1701 surf_def_v(l)%j + surf_def_v(l)%joff ) 1702 ENDDO 1703 1704 ENDIF 1705 ! 1706 !-- Additional variables, can be initialized the 1627 1707 !-- same way. 1628 1708 1629 1709 ! 1630 1710 !-- Finally, close the input file and deallocate temporary arrays -
palm/trunk/SOURCE/module_interface.f90
r4495 r4514 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Added global restart routines for plant-canopy model 28 ! 29 ! 4495 2020-04-13 20:11:20Z raasch 27 30 ! restart data handling with MPI-IO added 28 31 ! … … 442 445 pcm_3d_data_averaging, & 443 446 pcm_data_output_3d, & 447 pcm_rrd_global, & 444 448 pcm_rrd_local, & 449 pcm_wrd_global, & 445 450 pcm_wrd_local 446 451 … … 1722 1727 IF ( .NOT. found ) CALL gust_rrd_global( found ) ! ToDo: change interface to pass variable 1723 1728 IF ( .NOT. found ) CALL lpm_rrd_global( found ) ! ToDo: change interface to pass variable 1729 IF ( .NOT. found ) CALL pcm_rrd_global( found ) 1724 1730 IF ( .NOT. found ) CALL ocean_rrd_global( found ) ! ToDo: change interface to pass variable 1725 1731 IF ( .NOT. found ) CALL stg_rrd_global ( found ) ! ToDo: change interface to pass variable … … 1752 1758 IF ( gust_module_enabled ) CALL gust_rrd_global 1753 1759 IF ( particle_advection ) CALL lpm_rrd_global 1760 IF ( plant_canopy ) CALL pcm_rrd_global 1754 1761 IF ( ocean_mode ) CALL ocean_rrd_global 1755 1762 IF ( syn_turb_gen ) CALL stg_rrd_global … … 1782 1789 IF ( gust_module_enabled ) CALL gust_wrd_global 1783 1790 IF ( particle_advection ) CALL lpm_wrd_global 1791 IF ( plant_canopy ) CALL pcm_wrd_global 1784 1792 IF ( ocean_mode ) CALL ocean_wrd_global 1785 1793 IF ( syn_turb_gen ) CALL stg_wrd_global -
palm/trunk/SOURCE/modules.f90
r4505 r4514 25 25 ! ----------------- 26 26 ! $Id$ 27 ! +qsurf_av, ssurf_av 28 ! 29 ! 4505 2020-04-20 15:37:15Z schwenkel 27 30 ! Add flag for saturation check 28 31 ! … … 471 474 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lwp_av !< avg. liquid water path 472 475 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ol_av !< avg. Obukhov length 476 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: qsurf_av !< avg. surface mixing ratio 473 477 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: qsws_av !< avg. surface moisture flux 474 478 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: r_a_av !< avg. resistance 479 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ssurf_av !< avg. surface passive scalar 475 480 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ssws_av !< avg. surface scalar flux 476 481 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: shf_av !< avg. surface heat flux -
palm/trunk/SOURCE/plant_canopy_model_mod.f90
r4495 r4514 27 27 ! ----------------- 28 28 ! $Id$ 29 ! - Bugfix in output of pcm_heatrate_av in a restart run. In order to fix this, 30 ! pch_index is now output for a restart run. Therefore, define global restart 31 ! routines. 32 ! - Error message number renamed and check for PA0505 revised in order to also 33 ! consider natural surfaces with plant-canopy. 34 ! 35 ! 4495 2020-04-13 20:11:20Z raasch 29 36 ! restart data handling with MPI-IO added 30 37 ! … … 168 175 ! @todo - precalculate constant terms in pcm_calc_transpiration_rate 169 176 ! @todo - unify variable names (pcm_, pc_, ...) 177 ! @todo - get rid-off dependency on radiation model 170 178 !------------------------------------------------------------------------------! 171 179 MODULE plant_canopy_model_mod … … 187 195 dz, & 188 196 humidity, & 197 land_surface, & 189 198 length, & 190 199 message_string, & … … 225 234 226 235 USE restart_data_mpi_io_mod, & 227 ONLY: wrd_mpi_io 236 ONLY: rrd_mpi_io, & 237 wrd_mpi_io 228 238 229 239 USE surface_mod, & … … 294 304 pcm_init, & 295 305 pcm_parin, & 306 pcm_rrd_global, & 296 307 pcm_rrd_local, & 297 308 pcm_tendency, & 309 pcm_wrd_global, & 298 310 pcm_wrd_local 299 311 … … 349 361 END INTERFACE pcm_rrd_local 350 362 363 INTERFACE pcm_rrd_global 364 MODULE PROCEDURE pcm_rrd_global_ftn 365 MODULE PROCEDURE pcm_rrd_global_mpi 366 END INTERFACE pcm_rrd_global 367 351 368 INTERFACE pcm_tendency 352 369 MODULE PROCEDURE pcm_tendency … … 357 374 MODULE PROCEDURE pcm_wrd_local 358 375 END INTERFACE pcm_wrd_local 376 377 INTERFACE pcm_wrd_global 378 MODULE PROCEDURE pcm_wrd_global 379 END INTERFACE pcm_wrd_global 359 380 360 381 … … 483 504 484 505 CASE ( 'pcm_heatrate' ) 485 IF ( cthf == 0.0_wp .AND. .NOT. urban_surface ) THEN 486 message_string = 'output of "' // TRIM( var ) // '" requi' // & 506 ! 507 !-- Output of heatrate can be only done if it is explicitely set by cthf, 508 !-- or parametrized by absorption of radiation. The latter, however, is 509 !-- only available if radiation_interactions are on. Note, these are 510 !-- enabled if land-surface or urban-surface is switched-on. Using 511 !-- radiation_interactions_on directly is not possible since it belongs 512 !-- to the radition_model, which in turn depends on the plant-canopy model, 513 !-- creating circular dependencies. 514 IF ( cthf == 0.0_wp .AND. ( .NOT. urban_surface .AND. & 515 .NOT. land_surface ) ) THEN 516 message_string = 'output of "' // TRIM( var ) // '" requi' // & 487 517 'res setting of parameter cthf /= 0.0' 488 CALL message( 'pcm_check_data_output', 'PA 1000', 1, 2, 0, 6, 0 )518 CALL message( 'pcm_check_data_output', 'PA0505', 1, 2, 0, 6, 0 ) 489 519 ENDIF 490 520 unit = 'K s-1' … … 1620 1650 ! Description: 1621 1651 ! ------------ 1652 !> Read module-specific global restart data (Fortran binary format). 1653 !------------------------------------------------------------------------------! 1654 SUBROUTINE pcm_rrd_global_ftn( found ) 1655 1656 LOGICAL, INTENT(OUT) :: found 1657 1658 found = .TRUE. 1659 1660 SELECT CASE ( restart_string(1:length) ) 1661 1662 CASE ( 'pch_index' ) 1663 READ ( 13 ) pch_index 1664 1665 CASE DEFAULT 1666 1667 found = .FALSE. 1668 1669 END SELECT 1670 1671 END SUBROUTINE pcm_rrd_global_ftn 1672 1673 !------------------------------------------------------------------------------! 1674 ! Description: 1675 ! ------------ 1676 !> Read module-specific global restart data (MPI-IO). 1677 !------------------------------------------------------------------------------! 1678 SUBROUTINE pcm_rrd_global_mpi 1679 1680 CALL rrd_mpi_io( 'pch_index', pch_index ) 1681 1682 END SUBROUTINE pcm_rrd_global_mpi 1683 1684 !------------------------------------------------------------------------------! 1685 ! Description: 1686 ! ------------ 1622 1687 !> Subroutine reads local (subdomain) restart data 1623 1688 !------------------------------------------------------------------------------! … … 2437 2502 ! Description: 2438 2503 ! ------------ 2504 !> Subroutine writes global restart data 2505 !------------------------------------------------------------------------------! 2506 SUBROUTINE pcm_wrd_global 2507 2508 IF ( TRIM( restart_data_format_output ) == 'fortran_binary' ) THEN 2509 2510 CALL wrd_write_string( 'pch_index' ) 2511 WRITE ( 14 ) pch_index 2512 2513 ELSEIF ( TRIM( restart_data_format_output ) == 'mpi' ) THEN 2514 2515 CALL wrd_mpi_io( 'pch_index', pch_index ) 2516 2517 ENDIF 2518 2519 END SUBROUTINE pcm_wrd_global 2520 2521 !------------------------------------------------------------------------------! 2522 ! Description: 2523 ! ------------ 2439 2524 !> Subroutine writes local (subdomain) restart data 2440 2525 !------------------------------------------------------------------------------! -
palm/trunk/SOURCE/read_restart_data_mod.f90
r4498 r4514 25 25 ! ----------------- 26 26 ! $Id$ 27 ! qsurf and ssurf added 28 ! 29 ! 4498 2020-04-15 14:26:31Z raasch 27 30 ! argument removed from rd_mpi_io_open 28 31 ! … … 1797 1800 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 1798 1801 1802 CASE ( 'qsurf_av' ) 1803 IF ( .NOT. ALLOCATED( qsurf_av ) ) THEN 1804 ALLOCATE( qsurf_av(nysg:nyng,nxlg:nxrg) ) 1805 ENDIF 1806 IF ( k == 1 ) READ ( 13 ) tmp_2d 1807 qsurf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 1808 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 1809 1799 1810 CASE ( 'qsws_av' ) 1800 1811 IF ( .NOT. ALLOCATED( qsws_av ) ) THEN … … 1859 1870 IF ( k == 1 ) READ ( 13 ) tmp_2d 1860 1871 shf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 1872 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 1873 1874 CASE ( 'ssurf_av' ) 1875 IF ( .NOT. ALLOCATED( ssurf_av ) ) THEN 1876 ALLOCATE( ssurf_av(nysg:nyng,nxlg:nxrg) ) 1877 ENDIF 1878 IF ( k == 1 ) READ ( 13 ) tmp_2d 1879 ssurf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 1861 1880 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 1862 1881 -
palm/trunk/SOURCE/sum_up_3d_data.f90
r4442 r4514 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Enable output of qsurf and ssurf 28 ! 29 ! 4442 2020-03-04 19:21:13Z suehring 27 30 ! Change order of dimension in surface array %frac to allow for better 28 31 ! vectorization. … … 77 80 USE averaging, & 78 81 ONLY: e_av, ghf_av, lpt_av, lwp_av, ol_av, p_av, pc_av, pr_av, pt_av, & 79 q_av, ql_av, ql_c_av, ql_v_av, ql_vp_av, qsws_av, & 80 qv_av, r_a_av, s_av, shf_av, ssws_av, ts_av, tsurf_av, u_av, & 82 q_av, ql_av, ql_c_av, ql_v_av, ql_vp_av, qsurf_av, qsws_av, & 83 qv_av, r_a_av, s_av, shf_av, ssurf_av, & 84 ssws_av, ts_av, tsurf_av, u_av, & 81 85 us_av, v_av, vpt_av, w_av, z0_av, z0h_av, z0q_av 82 86 … … 95 99 96 100 USE indices, & 97 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt 101 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, & 102 topo_top_ind 98 103 99 104 USE kinds … … 232 237 ql_vp_av = 0.0_wp 233 238 239 CASE ( 'qsurf*' ) 240 IF ( .NOT. ALLOCATED( qsurf_av ) ) THEN 241 ALLOCATE( qsurf_av(nysg:nyng,nxlg:nxrg) ) 242 ENDIF 243 qsurf_av = 0.0_wp 244 234 245 CASE ( 'qsws*' ) 235 246 IF ( .NOT. ALLOCATED( qsws_av ) ) THEN … … 261 272 ENDIF 262 273 shf_av = 0.0_wp 263 274 275 CASE ( 'ssurf*' ) 276 IF ( .NOT. ALLOCATED( ssurf_av ) ) THEN 277 ALLOCATE( ssurf_av(nysg:nyng,nxlg:nxrg) ) 278 ENDIF 279 ssurf_av = 0.0_wp 280 264 281 CASE ( 'ssws*' ) 265 282 IF ( .NOT. ALLOCATED( ssws_av ) ) THEN … … 587 604 ENDIF 588 605 606 CASE ( 'qsurf*' ) 607 IF ( ALLOCATED( qsurf_av ) ) THEN 608 DO i = nxl, nxr 609 DO j = nys, nyn 610 match_def = surf_def_h(0)%start_index(j,i) <= & 611 surf_def_h(0)%end_index(j,i) 612 match_lsm = surf_lsm_h%start_index(j,i) <= & 613 surf_lsm_h%end_index(j,i) 614 match_usm = surf_usm_h%start_index(j,i) <= & 615 surf_usm_h%end_index(j,i) 616 617 IF ( match_def ) THEN 618 m = surf_def_h(0)%end_index(j,i) 619 qsurf_av(j,i) = qsurf_av(j,i) + & 620 surf_def_h(0)%q_surface(m) 621 ELSEIF ( match_lsm .AND. .NOT. match_usm ) THEN 622 m = surf_lsm_h%end_index(j,i) 623 qsurf_av(j,i) = qsurf_av(j,i) + & 624 surf_lsm_h%q_surface(m) 625 ELSEIF ( match_usm ) THEN 626 m = surf_usm_h%end_index(j,i) 627 qsurf_av(j,i) = qsurf_av(j,i) + & 628 surf_usm_h%q_surface(m) 629 ENDIF 630 ENDDO 631 ENDDO 632 ENDIF 633 589 634 CASE ( 'qsws*' ) 590 635 ! … … 703 748 ENDIF 704 749 750 CASE ( 'ssurf*' ) 751 IF ( ALLOCATED( ssurf_av ) ) THEN 752 DO i = nxl, nxr 753 DO j = nys, nyn 754 k = topo_top_ind(j,i,0) 755 ssurf_av(j,i) = ssurf_av(j,i) + s(k,j,i) 756 ENDDO 757 ENDDO 758 ENDIF 759 705 760 CASE ( 'ssws*' ) 706 761 IF ( ALLOCATED( ssws_av ) ) THEN -
palm/trunk/SOURCE/write_restart_data_mod.f90
r4495 r4514 24 24 ! ----------------- 25 25 ! $Id$ 26 ! qsurf and ssurf added 27 ! 28 ! 4495 2020-04-13 20:11:20Z raasch 26 29 ! restart data handling with MPI-IO added 27 30 ! … … 1254 1257 ENDIF 1255 1258 1259 IF ( ALLOCATED( qsurf_av ) ) THEN 1260 CALL wrd_write_string( 'qsurf_av' ) 1261 WRITE ( 14 ) qsurf_av 1262 ENDIF 1263 1256 1264 IF ( ALLOCATED( qsws_av ) ) THEN 1257 1265 CALL wrd_write_string( 'qsws_av' ) … … 1269 1277 CALL wrd_write_string( 's_av' ) 1270 1278 WRITE ( 14 ) s_av 1279 ENDIF 1280 1281 IF ( ALLOCATED( ssurf_av ) ) THEN 1282 CALL wrd_write_string( 'ssurf_av' ) 1283 WRITE ( 14 ) ssurf_av 1271 1284 ENDIF 1272 1285 … … 1491 1504 ENDIF 1492 1505 1506 IF ( ALLOCATED( qsurf_av ) ) CALL wrd_mpi_io( 'qsurf_av', qsurf_av ) 1493 1507 IF ( ALLOCATED( qsws_av ) ) CALL wrd_mpi_io( 'qsws_av', qsws_av ) 1494 1508 … … 1499 1513 CALL wrd_mpi_io( 's', s ) 1500 1514 IF ( ALLOCATED( s_av ) ) CALL wrd_mpi_io( 's_av', s_av ) 1515 IF ( ALLOCATED( ssurf_av ) ) CALL wrd_mpi_io( 'ssurf_av', ssurf_av ) 1501 1516 IF ( ALLOCATED( ssws_av ) ) CALL wrd_mpi_io( 'ssws_av', ssws_av ) 1502 1517
Note: See TracChangeset
for help on using the changeset viewer.
