Changeset 4431 for palm/trunk/SOURCE
- Timestamp:
- Feb 27, 2020 11:23:01 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/diagnostic_output_quantities_mod.f90
r4360 r4431 25 25 ! ----------------- 26 26 ! $Id$ 27 ! added wspeed and wdir output; bugfix: set fill_value in case of masked output 28 ! 29 ! 4360 2020-01-07 11:25:50Z suehring 27 30 ! added output of wu, wv, wtheta and wq to enable covariance calculation 28 31 ! according to temporal EC method 29 ! 32 ! 30 33 ! 4346 2019-12-18 11:55:56Z motisi 31 34 ! Introduction of wall_flags_total_0, which currently sets bits based on static 32 35 ! topography information used in wall_flags_static_0 33 ! 36 ! 34 37 ! 4331 2019-12-10 18:25:02Z suehring 35 38 ! - Modularize 2-m potential temperature output 36 39 ! - New output for 10-m wind speed 37 ! 40 ! 38 41 ! 4329 2019-12-10 15:46:36Z motisi 39 42 ! Renamed wall_flags_0 to wall_flags_static_0 40 ! 43 ! 41 44 ! 4182 2019-08-22 15:20:23Z scharf 42 45 ! Corrected "Former revisions" section 43 ! 46 ! 44 47 ! 4167 2019-08-16 11:01:48Z suehring 45 ! Changed behaviour of masked output over surface to follow terrain and ignore 48 ! Changed behaviour of masked output over surface to follow terrain and ignore 46 49 ! buildings (J.Resler, T.Gronemeier) 47 ! 50 ! 48 51 ! 4157 2019-08-14 09:19:12Z suehring 49 52 ! Initialization restructured, in order to work also when data output during 50 ! spin-up is enabled. 51 ! 53 ! spin-up is enabled. 54 ! 52 55 ! 4132 2019-08-02 12:34:17Z suehring 53 56 ! Bugfix in masked data output 54 ! 57 ! 55 58 ! 4069 2019-07-01 14:05:51Z Giersch 56 ! Masked output running index mid has been introduced as a local variable to 57 ! avoid runtime error (Loop variable has been modified) in time_integration 58 ! 59 ! Masked output running index mid has been introduced as a local variable to 60 ! avoid runtime error (Loop variable has been modified) in time_integration 61 ! 59 62 ! 4039 2019-06-18 10:32:41Z suehring 60 63 ! - Add output of uu, vv, ww to enable variance calculation according temporal … … 64 67 ! - Rename subroutines 65 68 ! - Further modularization 66 ! 69 ! 67 70 ! 3998 2019-05-23 13:38:11Z suehring 68 ! Bugfix in gathering all output strings 69 ! 71 ! Bugfix in gathering all output strings 72 ! 70 73 ! 3995 2019-05-22 18:59:54Z suehring 71 74 ! Avoid compiler warnings about unused variable and fix string operation which 72 75 ! is not allowed with PGI compiler 73 ! 76 ! 74 77 ! 3994 2019-05-22 18:08:09Z suehring 75 78 ! Initial revision … … 78 81 ! -------- 79 82 ! @author Farah Kanani-Suehring 80 ! 83 ! 81 84 ! 82 85 ! Description: … … 85 88 !------------------------------------------------------------------------------! 86 89 MODULE diagnostic_output_quantities_mod 87 90 88 91 USE arrays_3d, & 89 92 ONLY: ddzu, & … … 97 100 98 101 USE basic_constants_and_equations_mod, & 99 ONLY: kappa 102 ONLY: kappa, pi 100 103 101 104 USE control_parameters, & … … 104 107 message_string, & 105 108 varnamelength 106 ! 109 ! 107 110 ! USE cpulog, & 108 111 ! ONLY: cpu_log, log_point … … 114 117 ONLY: nbgp, & 115 118 nxl, & 116 nxlg, & 117 nxr, & 119 nxlg, & 120 nxr, & 118 121 nxrg, & 119 122 nyn, & … … 139 142 140 143 INTEGER(iwp) :: timestep_number_at_prev_calc = 0 !< ...at previous diagnostic output calculation 141 144 142 145 LOGICAL :: initialized_diagnostic_output_quantities = .FALSE. !< flag indicating whether output is initialized 143 146 LOGICAL :: prepared_diagnostic_output_quantities = .FALSE. !< flag indicating whether output is p … … 149 152 150 153 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ti !< rotation(u,v,w) aka turbulence intensity 151 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ti_av !< avg. rotation(u,v,w) aka turbulence intensity 152 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: uu !< uu 153 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: uu_av !< mean of uu 154 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: vv !< vv 155 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: vv_av !< mean of vv 156 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ww !< ww 157 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ww_av !< mean of ww 158 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wu !< wu 159 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wu_av !< mean of wu 160 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wv !< wv 161 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wv_av !< mean of wv 162 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wtheta !< wtheta 163 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wtheta_av !< mean of wtheta 164 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wq !< wq 165 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wq_av !< mean of wq 154 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ti_av !< avg. rotation(u,v,w) aka turbulence intensity 155 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: u_center !< u at center of grid box 156 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: u_center_av !< mean of u_center 157 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: uu !< uu 158 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: uu_av !< mean of uu 159 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wspeed !< horizontal wind speed 160 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wspeed_av !< mean of horizotal wind speed 161 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: v_center !< v at center of grid box 162 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: v_center_av !< mean of v_center 163 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: vv !< vv 164 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: vv_av !< mean of vv 165 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wdir !< wind direction 166 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wdir_av !< mean wind direction 167 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ww !< ww 168 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ww_av !< mean of ww 169 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wu !< wu 170 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wu_av !< mean of wu 171 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wv !< wv 172 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wv_av !< mean of wv 173 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wtheta !< wtheta 174 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wtheta_av !< mean of wtheta 175 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wq !< wq 176 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wq_av !< mean of wq 166 177 167 178 … … 178 189 pt_2m_av, & 179 190 ti_av, & 191 u_center_av, & 180 192 uu_av, & 181 193 uv_10m_av, & 194 v_center_av, & 182 195 vv_av, & 196 wdir_av, & 197 wspeed_av, & 183 198 ww_av 184 ! 185 !-- Public routines 199 ! 200 !-- Public routines 186 201 PUBLIC doq_3d_data_averaging, & 187 202 doq_calculate, & … … 198 213 INTERFACE doq_3d_data_averaging 199 214 MODULE PROCEDURE doq_3d_data_averaging 200 END INTERFACE doq_3d_data_averaging 215 END INTERFACE doq_3d_data_averaging 201 216 202 217 INTERFACE doq_calculate … … 207 222 MODULE PROCEDURE doq_check_data_output 208 223 END INTERFACE doq_check_data_output 209 224 210 225 INTERFACE doq_define_netcdf_grid 211 226 MODULE PROCEDURE doq_define_netcdf_grid 212 227 END INTERFACE doq_define_netcdf_grid 213 228 214 229 INTERFACE doq_output_2d 215 230 MODULE PROCEDURE doq_output_2d 216 231 END INTERFACE doq_output_2d 217 232 218 233 INTERFACE doq_output_3d 219 234 MODULE PROCEDURE doq_output_3d 220 235 END INTERFACE doq_output_3d 221 236 222 237 INTERFACE doq_output_mask 223 238 MODULE PROCEDURE doq_output_mask 224 239 END INTERFACE doq_output_mask 225 240 226 241 INTERFACE doq_init 227 242 MODULE PROCEDURE doq_init … … 231 246 MODULE PROCEDURE doq_prepare 232 247 END INTERFACE doq_prepare 233 248 234 249 ! INTERFACE doq_rrd_local 235 250 ! MODULE PROCEDURE doq_rrd_local 236 251 ! END INTERFACE doq_rrd_local 237 252 238 253 INTERFACE doq_wrd_local 239 254 MODULE PROCEDURE doq_wrd_local … … 242 257 243 258 CONTAINS 244 259 245 260 !------------------------------------------------------------------------------! 246 261 ! Description: … … 254 269 ONLY: average_count_3d 255 270 256 CHARACTER (LEN=*) :: mode !< 257 CHARACTER (LEN=*) :: variable !< 271 CHARACTER (LEN=*) :: mode !< 272 CHARACTER (LEN=*) :: variable !< 258 273 259 274 INTEGER(iwp) :: i !< … … 270 285 ENDIF 271 286 ti_av = 0.0_wp 272 287 273 288 CASE ( 'uu' ) 274 289 IF ( .NOT. ALLOCATED( uu_av ) ) THEN … … 276 291 ENDIF 277 292 uu_av = 0.0_wp 278 293 279 294 CASE ( 'vv' ) 280 295 IF ( .NOT. ALLOCATED( vv_av ) ) THEN … … 282 297 ENDIF 283 298 vv_av = 0.0_wp 284 299 285 300 CASE ( 'ww' ) 286 301 IF ( .NOT. ALLOCATED( ww_av ) ) THEN … … 288 303 ENDIF 289 304 ww_av = 0.0_wp 290 305 291 306 CASE ( 'wu' ) 292 307 IF ( .NOT. ALLOCATED( wu_av ) ) THEN … … 294 309 ENDIF 295 310 wu_av = 0.0_wp 296 311 297 312 CASE ( 'wv' ) 298 313 IF ( .NOT. ALLOCATED( wv_av ) ) THEN … … 300 315 ENDIF 301 316 wv_av = 0.0_wp 302 317 303 318 CASE ( 'wtheta' ) 304 319 IF ( .NOT. ALLOCATED( wtheta_av ) ) THEN … … 306 321 ENDIF 307 322 wtheta_av = 0.0_wp 308 323 309 324 CASE ( 'wq' ) 310 325 IF ( .NOT. ALLOCATED( wq_av ) ) THEN … … 312 327 ENDIF 313 328 wq_av = 0.0_wp 314 329 315 330 CASE ( 'theta_2m*' ) 316 331 IF ( .NOT. ALLOCATED( pt_2m_av ) ) THEN … … 318 333 ENDIF 319 334 pt_2m_av = 0.0_wp 320 335 321 336 CASE ( 'wspeed_10m*' ) 322 337 IF ( .NOT. ALLOCATED( uv_10m_av ) ) THEN … … 325 340 uv_10m_av = 0.0_wp 326 341 342 CASE ( 'wspeed' ) 343 IF ( .NOT. ALLOCATED( wspeed_av ) ) THEN 344 ALLOCATE( wspeed_av(nzb:nzt+1,nys:nyn,nxl:nxr) ) 345 ENDIF 346 wspeed_av = 0.0_wp 347 348 CASE ( 'wdir' ) 349 IF ( .NOT. ALLOCATED( u_center_av ) ) THEN 350 ALLOCATE( u_center_av(nzb:nzt+1,nys:nyn,nxl:nxr) ) 351 ENDIF 352 IF ( .NOT. ALLOCATED( v_center_av ) ) THEN 353 ALLOCATE( v_center_av(nzb:nzt+1,nys:nyn,nxl:nxr) ) 354 ENDIF 355 u_center_av = 0.0_wp 356 v_center_av = 0.0_wp 357 327 358 CASE DEFAULT 328 359 CONTINUE … … 333 364 334 365 SELECT CASE ( TRIM( variable ) ) 335 366 336 367 CASE ( 'ti' ) 337 368 IF ( ALLOCATED( ti_av ) ) THEN … … 344 375 ENDDO 345 376 ENDIF 346 377 347 378 CASE ( 'uu' ) 348 379 IF ( ALLOCATED( uu_av ) ) THEN … … 355 386 ENDDO 356 387 ENDIF 357 388 358 389 CASE ( 'vv' ) 359 390 IF ( ALLOCATED( vv_av ) ) THEN … … 366 397 ENDDO 367 398 ENDIF 368 399 369 400 CASE ( 'ww' ) 370 401 IF ( ALLOCATED( ww_av ) ) THEN … … 377 408 ENDDO 378 409 ENDIF 379 410 380 411 CASE ( 'wu' ) 381 412 IF ( ALLOCATED( wu_av ) ) THEN … … 388 419 ENDDO 389 420 ENDIF 390 421 391 422 CASE ( 'wv' ) 392 423 IF ( ALLOCATED( wv_av ) ) THEN … … 399 430 ENDDO 400 431 ENDIF 401 432 402 433 CASE ( 'wtheta' ) 403 434 IF ( ALLOCATED( wtheta_av ) ) THEN … … 410 441 ENDDO 411 442 ENDIF 412 443 413 444 CASE ( 'wq' ) 414 445 IF ( ALLOCATED( wq_av ) ) THEN … … 421 452 ENDDO 422 453 ENDIF 423 454 424 455 CASE ( 'theta_2m*' ) 425 456 IF ( ALLOCATED( pt_2m_av ) ) THEN … … 436 467 DO j = nys, nyn 437 468 uv_10m_av(j,i) = uv_10m_av(j,i) + uv_10m(j,i) 469 ENDDO 470 ENDDO 471 ENDIF 472 473 CASE ( 'wspeed' ) 474 IF ( ALLOCATED( wspeed_av ) ) THEN 475 DO i = nxl, nxr 476 DO j = nys, nyn 477 DO k = nzb, nzt+1 478 wspeed_av(k,j,i) = wspeed_av(k,j,i) + wspeed(k,j,i) 479 ENDDO 480 ENDDO 481 ENDDO 482 ENDIF 483 484 CASE ( 'wdir' ) 485 IF ( ALLOCATED( u_center_av ) .AND. ALLOCATED( v_center_av ) ) THEN 486 DO i = nxl, nxr 487 DO j = nys, nyn 488 DO k = nzb, nzt+1 489 u_center_av(k,j,i) = u_center_av(k,j,i) + u_center(k,j,i) 490 v_center_av(k,j,i) = v_center_av(k,j,i) + v_center(k,j,i) 491 ENDDO 438 492 ENDDO 439 493 ENDDO … … 459 513 ENDDO 460 514 ENDIF 461 515 462 516 CASE ( 'uu' ) 463 517 IF ( ALLOCATED( uu_av ) ) THEN … … 470 524 ENDDO 471 525 ENDIF 472 526 473 527 CASE ( 'vv' ) 474 528 IF ( ALLOCATED( vv_av ) ) THEN … … 481 535 ENDDO 482 536 ENDIF 483 537 484 538 CASE ( 'ww' ) 485 539 IF ( ALLOCATED( ww_av ) ) THEN … … 503 557 ENDDO 504 558 ENDIF 505 559 506 560 CASE ( 'wv' ) 507 561 IF ( ALLOCATED( wv_av ) ) THEN … … 514 568 ENDDO 515 569 ENDIF 516 570 517 571 CASE ( 'wtheta' ) 518 572 IF ( ALLOCATED( wtheta_av ) ) THEN … … 525 579 ENDDO 526 580 ENDIF 527 581 528 582 CASE ( 'wq' ) 529 583 IF ( ALLOCATED( wq_av ) ) THEN … … 557 611 ENDIF 558 612 613 CASE ( 'wspeed' ) 614 IF ( ALLOCATED( wspeed_av ) ) THEN 615 DO i = nxl, nxr 616 DO j = nys, nyn 617 DO k = nzb, nzt+1 618 wspeed_av(k,j,i) = wspeed_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 619 ENDDO 620 ENDDO 621 ENDDO 622 ENDIF 623 624 CASE ( 'wdir' ) 625 IF ( ALLOCATED( u_center_av ) .AND. ALLOCATED( v_center_av ) ) THEN 626 627 IF ( .NOT. ALLOCATED( wdir_av ) ) THEN 628 ALLOCATE( wdir_av(nzb:nzt+1,nys:nyn,nxl:nxr) ) 629 ENDIF 630 wdir_av = 0.0_wp 631 632 DO i = nxl, nxr 633 DO j = nys, nyn 634 DO k = nzb, nzt+1 635 u_center_av(k,j,i) = u_center_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 636 v_center_av(k,j,i) = v_center_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 637 wdir_av(k,j,i) = ATAN2( u_center_av(k,j,i), v_center_av(k,j,i) ) & 638 / pi * 180.0_wp + 180.0_wp 639 ENDDO 640 ENDDO 641 ENDDO 642 ENDIF 643 559 644 END SELECT 560 645 … … 562 647 563 648 564 END SUBROUTINE doq_3d_data_averaging 565 649 END SUBROUTINE doq_3d_data_averaging 650 566 651 !------------------------------------------------------------------------------! 567 652 ! Description: … … 573 658 IMPLICIT NONE 574 659 575 CHARACTER (LEN=*) :: unit !< 660 CHARACTER (LEN=*) :: unit !< 576 661 CHARACTER (LEN=*) :: var !< 577 662 … … 584 669 CASE ( 'ti' ) 585 670 unit = '1/s' 586 671 587 672 CASE ( 'uu' ) 588 673 unit = 'm2/s2' 589 674 590 675 CASE ( 'vv' ) 591 676 unit = 'm2/s2' 592 677 593 678 CASE ( 'ww' ) 594 679 unit = 'm2/s2' 595 680 596 681 CASE ( 'wu' ) 597 682 unit = 'm2/s2' 598 683 599 684 CASE ( 'wv' ) 600 685 unit = 'm2/s2' 601 686 602 687 CASE ( 'wtheta' ) 603 688 unit = 'Km/s' 604 689 605 690 CASE ( 'wq' ) 606 691 unit = 'm/s' 692 693 CASE ( 'wspeed' ) 694 unit = 'm/s' 695 696 CASE ( 'wdir' ) 697 unit = 'degree' 607 698 ! 608 699 !-- Treat horizotal cross-section output quanatities … … 627 718 628 719 END SUBROUTINE doq_check_data_output 629 720 630 721 !------------------------------------------------------------------------------! 631 722 ! … … 633 724 ! ------------ 634 725 !> Subroutine defining appropriate grid for netcdf variables. 635 !------------------------------------------------------------------------------! 726 !------------------------------------------------------------------------------! 636 727 SUBROUTINE doq_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z ) 637 728 638 729 IMPLICIT NONE 639 730 640 731 CHARACTER (LEN=*), INTENT(IN) :: variable !< 641 LOGICAL, INTENT(OUT) :: found !< 642 CHARACTER (LEN=*), INTENT(OUT) :: grid_x !< 643 CHARACTER (LEN=*), INTENT(OUT) :: grid_y !< 644 CHARACTER (LEN=*), INTENT(OUT) :: grid_z !< 732 LOGICAL, INTENT(OUT) :: found !< 733 CHARACTER (LEN=*), INTENT(OUT) :: grid_x !< 734 CHARACTER (LEN=*), INTENT(OUT) :: grid_y !< 735 CHARACTER (LEN=*), INTENT(OUT) :: grid_z !< 645 736 646 737 found = .TRUE. 647 738 648 739 SELECT CASE ( TRIM( variable ) ) 649 740 ! 650 741 !-- s grid 651 742 CASE ( 'ti', 'ti_xy', 'ti_xz', 'ti_yz', & 743 'wspeed', 'wspeed_xy', 'wspeed_xz', 'wspeed_yz', & 744 'wdir', 'wdir_xy', 'wdir_xz', 'wdir_yz', & 652 745 'wu', 'wu_xy', 'wu_xz', 'wu_yz', & 653 746 'wv', 'wv_xy', 'wv_xz', 'wv_yz', & … … 697 790 698 791 END SUBROUTINE doq_define_netcdf_grid 699 792 700 793 !------------------------------------------------------------------------------! 701 794 ! … … 710 803 IMPLICIT NONE 711 804 712 CHARACTER (LEN=*) :: grid !< 713 CHARACTER (LEN=*) :: mode !< 714 CHARACTER (LEN=*) :: variable !< 805 CHARACTER (LEN=*) :: grid !< 806 CHARACTER (LEN=*) :: mode !< 807 CHARACTER (LEN=*) :: variable !< 715 808 716 809 INTEGER(iwp) :: av !< value indicating averaged or non-averaged output … … 719 812 INTEGER(iwp) :: j !< grid index y-direction 720 813 INTEGER(iwp) :: k !< grid index z-direction 721 INTEGER(iwp) :: nzb_do !< 722 INTEGER(iwp) :: nzt_do !< 814 INTEGER(iwp) :: nzb_do !< 815 INTEGER(iwp) :: nzt_do !< 723 816 724 817 LOGICAL :: found !< true if variable is in list … … 727 820 728 821 REAL(wp) :: fill_value !< value for the _FillValue attribute 729 730 REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 822 823 REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 731 824 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which needs to be resorted for output 732 825 733 826 flag_nr = 0 734 827 found = .TRUE. … … 749 842 ENDIF 750 843 flag_nr = 0 751 844 752 845 IF ( mode == 'xy' ) grid = 'zu' 753 846 754 847 CASE ( 'uu_xy', 'uu_xz', 'uu_yz' ) 755 848 IF ( av == 0 ) THEN … … 763 856 ENDIF 764 857 flag_nr = 1 765 858 766 859 IF ( mode == 'xy' ) grid = 'zu' 767 860 768 861 CASE ( 'vv_xy', 'vv_xz', 'vv_yz' ) 769 862 IF ( av == 0 ) THEN … … 777 870 ENDIF 778 871 flag_nr = 2 779 872 780 873 IF ( mode == 'xy' ) grid = 'zu' 781 874 782 875 CASE ( 'ww_xy', 'ww_xz', 'ww_yz' ) 783 876 IF ( av == 0 ) THEN … … 791 884 ENDIF 792 885 flag_nr = 3 793 886 794 887 IF ( mode == 'xy' ) grid = 'zw' 795 888 796 889 CASE ( 'wu_xy', 'wu_xz', 'wu_yz' ) 797 890 IF ( av == 0 ) THEN … … 805 898 ENDIF 806 899 flag_nr = 0 807 900 808 901 IF ( mode == 'xy' ) grid = 'zw' 809 902 810 903 CASE ( 'wv_xy', 'wv_xz', 'wv_yz' ) 811 904 IF ( av == 0 ) THEN … … 819 912 ENDIF 820 913 flag_nr = 0 821 914 822 915 IF ( mode == 'xy' ) grid = 'zw' 823 916 824 917 CASE ( 'wtheta_xy', 'wtheta_xz', 'wtheta_yz' ) 825 918 IF ( av == 0 ) THEN … … 833 926 ENDIF 834 927 flag_nr = 0 835 928 836 929 IF ( mode == 'xy' ) grid = 'zw' 837 930 838 931 CASE ( 'wq_xy', 'wq_xz', 'wq_yz' ) 839 932 IF ( av == 0 ) THEN … … 847 940 ENDIF 848 941 flag_nr = 0 849 942 850 943 IF ( mode == 'xy' ) grid = 'zw' 851 944 852 945 CASE ( 'theta_2m*_xy' ) ! 2d-array 853 946 IF ( av == 0 ) THEN … … 871 964 two_d = .TRUE. 872 965 grid = 'zu1' 873 966 874 967 CASE ( 'wspeed_10m*_xy' ) ! 2d-array 875 968 IF ( av == 0 ) THEN … … 894 987 grid = 'zu1' 895 988 989 CASE ( 'wspeed_xy', 'wspeed_xz', 'wspeed_yz' ) 990 IF ( av == 0 ) THEN 991 to_be_resorted => wspeed 992 ELSE 993 IF ( .NOT. ALLOCATED( wspeed_av ) ) THEN 994 ALLOCATE( wspeed_av(nzb:nzt+1,nys:nyn,nxl:nxr) ) 995 wspeed_av = REAL( fill_value, KIND = wp ) 996 ENDIF 997 to_be_resorted => wspeed_av 998 ENDIF 999 flag_nr = 0 1000 1001 IF ( mode == 'xy' ) grid = 'zu' 1002 1003 CASE ( 'wdir_xy', 'wdir_xz', 'wdir_yz' ) 1004 IF ( av == 0 ) THEN 1005 to_be_resorted => wdir 1006 ELSE 1007 IF ( .NOT. ALLOCATED( wdir_av ) ) THEN 1008 ALLOCATE( wdir_av(nzb:nzt+1,nys:nyn,nxl:nxr) ) 1009 wdir_av = REAL( fill_value, KIND = wp ) 1010 ENDIF 1011 to_be_resorted => wdir_av 1012 ENDIF 1013 flag_nr = 0 1014 1015 IF ( mode == 'xy' ) grid = 'zu' 1016 896 1017 CASE DEFAULT 897 1018 found = .FALSE. … … 899 1020 900 1021 END SELECT 901 902 IF ( found .AND. .NOT. resorted ) THEN 1022 1023 IF ( found .AND. .NOT. resorted ) THEN 903 1024 DO i = nxl, nxr 904 1025 DO j = nys, nyn … … 906 1027 local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), & 907 1028 REAL( fill_value, KIND = wp ), & 908 BTEST( wall_flags_total_0(k,j,i), flag_nr ) ) 1029 BTEST( wall_flags_total_0(k,j,i), flag_nr ) ) 909 1030 ENDDO 910 1031 ENDDO 911 1032 ENDDO 912 1033 ENDIF 913 1034 914 1035 END SUBROUTINE doq_output_2d 915 916 1036 1037 917 1038 !------------------------------------------------------------------------------! 918 1039 ! … … 923 1044 SUBROUTINE doq_output_3d( av, variable, found, local_pf, fill_value, nzb_do, & 924 1045 nzt_do ) 925 1046 926 1047 IMPLICIT NONE 927 1048 928 CHARACTER (LEN=*) :: variable !< 1049 CHARACTER (LEN=*) :: variable !< 929 1050 930 1051 INTEGER(iwp) :: av !< index indicating averaged or instantaneous output … … 941 1062 REAL(wp) :: fill_value !< value for the _FillValue attribute 942 1063 943 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 1064 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 944 1065 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which needs to be resorted for output 945 1066 … … 947 1068 found = .TRUE. 948 1069 resorted = .FALSE. 949 1070 950 1071 SELECT CASE ( TRIM( variable ) ) 951 1072 … … 961 1082 ENDIF 962 1083 flag_nr = 0 963 1084 964 1085 CASE ( 'uu' ) 965 1086 IF ( av == 0 ) THEN … … 973 1094 ENDIF 974 1095 flag_nr = 1 975 1096 976 1097 CASE ( 'vv' ) 977 1098 IF ( av == 0 ) THEN … … 985 1106 ENDIF 986 1107 flag_nr = 2 987 1108 988 1109 CASE ( 'ww' ) 989 1110 IF ( av == 0 ) THEN … … 1021 1142 ENDIF 1022 1143 flag_nr = 0 1023 1144 1024 1145 CASE ( 'wtheta' ) 1025 1146 IF ( av == 0 ) THEN … … 1033 1154 ENDIF 1034 1155 flag_nr = 0 1035 1156 1036 1157 CASE ( 'wq' ) 1037 1158 IF ( av == 0 ) THEN … … 1046 1167 flag_nr = 0 1047 1168 1169 CASE ( 'wspeed' ) 1170 IF ( av == 0 ) THEN 1171 to_be_resorted => wspeed 1172 ELSE 1173 IF ( .NOT. ALLOCATED( wspeed_av ) ) THEN 1174 ALLOCATE( wspeed_av(nzb:nzt+1,nys:nyn,nxl:nxr) ) 1175 wspeed_av = REAL( fill_value, KIND = wp ) 1176 ENDIF 1177 to_be_resorted => wspeed_av 1178 ENDIF 1179 flag_nr = 0 1180 1181 CASE ( 'wdir' ) 1182 IF ( av == 0 ) THEN 1183 to_be_resorted => wdir 1184 ELSE 1185 IF ( .NOT. ALLOCATED( wdir_av ) ) THEN 1186 ALLOCATE( wdir_av(nzb:nzt+1,nys:nyn,nxl:nxr) ) 1187 wdir_av = REAL( fill_value, KIND = wp ) 1188 ENDIF 1189 to_be_resorted => wdir_av 1190 ENDIF 1191 flag_nr = 0 1192 1048 1193 CASE DEFAULT 1049 1194 found = .FALSE. 1050 1195 1051 1196 END SELECT 1052 1053 IF ( found .AND. .NOT. resorted ) THEN 1197 1198 IF ( found .AND. .NOT. resorted ) THEN 1054 1199 DO i = nxl, nxr 1055 1200 DO j = nys, nyn … … 1057 1202 local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), & 1058 1203 REAL( fill_value, KIND = wp ), & 1059 BTEST( wall_flags_total_0(k,j,i), flag_nr ) ) 1204 BTEST( wall_flags_total_0(k,j,i), flag_nr ) ) 1060 1205 ENDDO 1061 1206 ENDDO … … 1064 1209 1065 1210 END SUBROUTINE doq_output_3d 1066 1211 1067 1212 ! Description: 1068 1213 ! ------------ … … 1071 1216 !------------------------------------------------------------------------------! 1072 1217 SUBROUTINE doq_output_mask( av, variable, found, local_pf, mid ) 1073 1218 1074 1219 USE control_parameters 1075 1220 1076 1221 USE indices 1077 1222 … … 1097 1242 REAL(wp), & 1098 1243 DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) :: & 1099 local_pf !< 1244 local_pf !< 1100 1245 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which needs to be resorted for output 1101 1246 … … 1117 1262 grid = 's' 1118 1263 flag_nr = 0 1119 1264 1120 1265 CASE ( 'uu' ) 1121 1266 IF ( av == 0 ) THEN … … 1126 1271 grid = 'u' 1127 1272 flag_nr = 1 1128 1273 1129 1274 CASE ( 'vv' ) 1130 1275 IF ( av == 0 ) THEN … … 1135 1280 grid = 'v' 1136 1281 flag_nr = 2 1137 1282 1138 1283 CASE ( 'ww' ) 1139 1284 IF ( av == 0 ) THEN … … 1144 1289 grid = 'w' 1145 1290 flag_nr = 3 1146 1291 1147 1292 CASE ( 'wu' ) 1148 1293 IF ( av == 0 ) THEN … … 1153 1298 grid = 's' 1154 1299 flag_nr = 0 1155 1300 1156 1301 CASE ( 'wv' ) 1157 1302 IF ( av == 0 ) THEN … … 1162 1307 grid = 's' 1163 1308 flag_nr = 0 1164 1309 1165 1310 CASE ( 'wtheta' ) 1166 1311 IF ( av == 0 ) THEN … … 1171 1316 grid = 's' 1172 1317 flag_nr = 0 1173 1318 1174 1319 CASE ( 'wq' ) 1175 1320 IF ( av == 0 ) THEN … … 1181 1326 flag_nr = 0 1182 1327 1328 CASE ( 'wspeed' ) 1329 IF ( av == 0 ) THEN 1330 to_be_resorted => wspeed 1331 ELSE 1332 to_be_resorted => wspeed_av 1333 ENDIF 1334 grid = 's' 1335 flag_nr = 0 1336 1337 CASE ( 'wdir' ) 1338 IF ( av == 0 ) THEN 1339 to_be_resorted => wdir 1340 ELSE 1341 to_be_resorted => wdir_av 1342 ENDIF 1343 grid = 's' 1344 flag_nr = 0 1345 1183 1346 CASE DEFAULT 1184 1347 found = .FALSE. 1185 1348 1186 1349 END SELECT 1187 1350 1188 1351 IF ( found .AND. .NOT. resorted ) THEN 1189 1352 IF ( .NOT. mask_surface(mid) ) THEN … … 1193 1356 DO j = 1, mask_size_l(mid,2) 1194 1357 DO k = 1, mask_size_l(mid,3) 1195 local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), & 1196 mask_j(mid,j), & 1197 mask_i(mid,i)) 1358 local_pf(i,j,k) = MERGE( to_be_resorted(mask_k(mid,k), & 1359 mask_j(mid,j), & 1360 mask_i(mid,i)), & 1361 REAL( fill_value, KIND = wp ), & 1362 BTEST( wall_flags_total_0( & 1363 mask_k(mid,k), & 1364 mask_j(mid,j), & 1365 mask_i(mid,i)), & 1366 flag_nr ) ) 1198 1367 ENDDO 1199 1368 ENDDO … … 1226 1395 ENDIF 1227 1396 ENDIF 1228 1397 1229 1398 END SUBROUTINE doq_output_mask 1230 1399 … … 1237 1406 1238 1407 IMPLICIT NONE 1239 1408 1240 1409 INTEGER(iwp) :: ivar !< loop index over all 2d/3d/mask output quantities 1241 1410 … … 1248 1417 1249 1418 initialized_diagnostic_output_quantities = .FALSE. 1250 1419 1251 1420 ivar = 1 1252 1253 DO WHILE ( ivar <= SIZE( do_all ) ) 1421 1422 DO WHILE ( ivar <= SIZE( do_all ) ) 1254 1423 1255 1424 SELECT CASE ( TRIM( do_all(ivar) ) ) … … 1324 1493 uv_10m = 0.0_wp 1325 1494 ENDIF 1495 ! 1496 !-- Allocate array for wspeed 1497 CASE ( 'wspeed' ) 1498 IF ( .NOT. ALLOCATED( wspeed ) ) THEN 1499 ALLOCATE( wspeed(nzb:nzt+1,nys:nyn,nxl:nxr) ) 1500 wspeed = 0.0_wp 1501 ENDIF 1502 1503 ! 1504 !-- Allocate array for wdir 1505 CASE ( 'wdir' ) 1506 IF ( .NOT. ALLOCATED( u_center ) ) THEN 1507 ALLOCATE( u_center(nzb:nzt+1,nys:nyn,nxl:nxr) ) 1508 u_center = 0.0_wp 1509 ENDIF 1510 IF ( .NOT. ALLOCATED( v_center ) ) THEN 1511 ALLOCATE( v_center(nzb:nzt+1,nys:nyn,nxl:nxr) ) 1512 v_center = 0.0_wp 1513 ENDIF 1514 IF ( .NOT. ALLOCATED( wdir ) ) THEN 1515 ALLOCATE( wdir(nzb:nzt+1,nys:nyn,nxl:nxr) ) 1516 wdir = 0.0_wp 1517 ENDIF 1326 1518 1327 1519 END SELECT … … 1331 1523 1332 1524 initialized_diagnostic_output_quantities = .TRUE. 1333 1525 1334 1526 END SUBROUTINE doq_init 1335 1527 … … 1345 1537 1346 1538 INTEGER(iwp) :: i !< grid index x-dimension 1347 INTEGER(iwp) :: j !< grid index y-dimension 1539 INTEGER(iwp) :: j !< grid index y-dimension 1348 1540 INTEGER(iwp) :: k !< grid index z-dimension 1349 1541 INTEGER(iwp) :: ivar !< loop index over all 2d/3d/mask output quantities 1350 1542 1351 1543 TYPE(surf_type), POINTER :: surf !< surf-type array, used to generalize subroutines 1352 1544 … … 1355 1547 1356 1548 ! 1357 !-- Save timestep number to check in time_integration if doq_calculate 1549 !-- Save timestep number to check in time_integration if doq_calculate 1358 1550 !-- has been called already, since the CALL occurs at two locations, but the calculations need to be 1359 1551 !-- done only once per timestep. … … 1362 1554 ivar = 1 1363 1555 1364 DO WHILE ( ivar <= SIZE( do_all ) ) 1556 DO WHILE ( ivar <= SIZE( do_all ) ) 1365 1557 1366 1558 SELECT CASE ( TRIM( do_all(ivar) ) ) … … 1387 1579 ENDDO 1388 1580 ENDDO 1389 ENDDO 1581 ENDDO 1390 1582 ! 1391 1583 !-- uu … … 1502 1694 surf => surf_usm_h 1503 1695 CALL calc_wind_10m 1696 ! 1697 !-- horizontal wind speed 1698 CASE ( 'wspeed' ) 1699 DO i = nxl, nxr 1700 DO j = nys, nyn 1701 DO k = nzb, nzt+1 1702 wspeed(k,j,i) = SQRT( ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) )**2 & 1703 + ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) )**2 ) & 1704 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0) ) 1705 ENDDO 1706 ENDDO 1707 ENDDO 1708 1709 ! 1710 !-- horizontal wind direction 1711 CASE ( 'wdir' ) 1712 DO i = nxl, nxr 1713 DO j = nys, nyn 1714 DO k = nzb, nzt+1 1715 u_center(k,j,i) = 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) 1716 v_center(k,j,i) = 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) 1717 1718 wdir(k,j,i) = ATAN2( u_center(k,j,i), v_center(k,j,i) ) & 1719 / pi * 180.0_wp + 180.0_wp 1720 ENDDO 1721 ENDDO 1722 ENDDO 1504 1723 1505 1724 END SELECT … … 1511 1730 1512 1731 ! 1513 !-- The following block contains subroutines to calculate diagnostic 1514 !-- surface quantities. 1732 !-- The following block contains subroutines to calculate diagnostic 1733 !-- surface quantities. 1515 1734 CONTAINS 1516 1735 !------------------------------------------------------------------------------! … … 1528 1747 INTEGER(iwp) :: kk !< running index along the z-dimension 1529 1748 INTEGER(iwp) :: m !< running index for surface elements 1530 1749 1531 1750 DO m = 1, surf%ns 1532 1751 … … 1535 1754 k = surf%k(m) 1536 1755 ! 1537 !-- If 2-m level is below the first grid level, MOST is 1756 !-- If 2-m level is below the first grid level, MOST is 1538 1757 !-- used for calculation of 2-m temperature. 1539 1758 IF ( surf%z_mo(m) > 2.0_wp ) THEN … … 1546 1765 !-- is linearly interpolated between the two nearest vertical grid 1547 1766 !-- levels. Note, since 2-m temperature is only computed for 1548 !-- horizontal upward-facing surfaces, only a vertical 1549 !-- interpolation is necessary. 1767 !-- horizontal upward-facing surfaces, only a vertical 1768 !-- interpolation is necessary. 1550 1769 ELSE 1551 1770 ! 1552 !-- zw(k-1) defines the height of the surface. 1771 !-- zw(k-1) defines the height of the surface. 1553 1772 kk = k 1554 1773 DO WHILE ( zu(kk) - zw(k-1) < 2.0_wp .AND. kk <= nzt ) 1555 kk = kk + 1 1556 ENDDO 1557 ! 1558 !-- kk defines the index of the first grid level >= 2m. 1774 kk = kk + 1 1775 ENDDO 1776 ! 1777 !-- kk defines the index of the first grid level >= 2m. 1559 1778 pt_2m(j,i) = pt(kk-1,j,i) + & 1560 1779 ( zw(k-1) + 2.0_wp - zu(kk-1) ) * & … … 1566 1785 1567 1786 END SUBROUTINE calc_pt_2m 1568 1787 1569 1788 !------------------------------------------------------------------------------! 1570 1789 ! Description: … … 1584 1803 REAL(wp) :: uv_l !< wind speed at lower grid point 1585 1804 REAL(wp) :: uv_u !< wind speed at upper grid point 1586 1805 1587 1806 DO m = 1, surf%ns 1588 1807 … … 1591 1810 k = surf%k(m) 1592 1811 ! 1593 !-- If 10-m level is below the first grid level, MOST is 1812 !-- If 10-m level is below the first grid level, MOST is 1594 1813 !-- used for calculation of 10-m temperature. 1595 1814 IF ( surf%z_mo(m) > 10.0_wp ) THEN … … 1602 1821 !-- is linearly interpolated between the two nearest vertical grid 1603 1822 !-- levels. Note, since 10-m temperature is only computed for 1604 !-- horizontal upward-facing surfaces, only a vertical 1605 !-- interpolation is necessary. 1823 !-- horizontal upward-facing surfaces, only a vertical 1824 !-- interpolation is necessary. 1606 1825 ELSE 1607 1826 ! 1608 !-- zw(k-1) defines the height of the surface. 1827 !-- zw(k-1) defines the height of the surface. 1609 1828 kk = k 1610 1829 DO WHILE ( zu(kk) - zw(k-1) < 10.0_wp .AND. kk <= nzt ) 1611 kk = kk + 1 1830 kk = kk + 1 1612 1831 ENDDO 1613 1832 ! … … 1653 1872 INTEGER(iwp) :: ivar_all !< loop index 1654 1873 INTEGER(iwp) :: l !< index for cutting string 1655 INTEGER(iwp) :: mid !< masked output running index 1874 INTEGER(iwp) :: mid !< masked output running index 1656 1875 1657 1876 prepared_diagnostic_output_quantities = .FALSE. … … 1667 1886 ! 1668 1887 !-- Gather 2d output quantity names. 1669 !-- Check for double occurrence of output quantity, e.g. by _xy, 1670 !-- _yz, _xz. 1888 !-- Check for double occurrence of output quantity, e.g. by _xy, 1889 !-- _yz, _xz. 1671 1890 DO WHILE ( do2d_var(av,ivar)(1:1) /= ' ' ) 1672 1891 IF ( .NOT. ANY( do_all == do2d_var(av,ivar) ) ) THEN … … 1709 1928 1710 1929 END SUBROUTINE doq_prepare 1711 1930 1712 1931 !------------------------------------------------------------------------------! 1713 1932 ! Description: 1714 1933 ! ------------ 1715 1934 !> Subroutine reads local (subdomain) restart data 1716 !> Note: With the current structure reading of non-standard array is not 1935 !> Note: With the current structure reading of non-standard array is not 1717 1936 !> possible 1718 1937 !------------------------------------------------------------------------------! … … 1720 1939 ! nxr_on_file, nynf, nync, nyn_on_file, nysf, & 1721 1940 ! nysc, nys_on_file, tmp_3d_non_standard, found ) 1722 ! 1723 ! 1941 ! 1942 ! 1724 1943 ! USE control_parameters 1725 ! 1944 ! 1726 1945 ! USE indices 1727 ! 1946 ! 1728 1947 ! USE kinds 1729 ! 1948 ! 1730 1949 ! USE pegrid 1731 ! 1732 ! 1950 ! 1951 ! 1733 1952 ! IMPLICIT NONE 1734 ! 1735 ! INTEGER(iwp) :: k !< 1736 ! INTEGER(iwp) :: nxlc !< 1737 ! INTEGER(iwp) :: nxlf !< 1738 ! INTEGER(iwp) :: nxl_on_file !< 1739 ! INTEGER(iwp) :: nxrc !< 1740 ! INTEGER(iwp) :: nxrf !< 1741 ! INTEGER(iwp) :: nxr_on_file !< 1742 ! INTEGER(iwp) :: nync !< 1743 ! INTEGER(iwp) :: nynf !< 1744 ! INTEGER(iwp) :: nyn_on_file !< 1745 ! INTEGER(iwp) :: nysc !< 1746 ! INTEGER(iwp) :: nysf !< 1747 ! INTEGER(iwp) :: nys_on_file !< 1748 ! 1953 ! 1954 ! INTEGER(iwp) :: k !< 1955 ! INTEGER(iwp) :: nxlc !< 1956 ! INTEGER(iwp) :: nxlf !< 1957 ! INTEGER(iwp) :: nxl_on_file !< 1958 ! INTEGER(iwp) :: nxrc !< 1959 ! INTEGER(iwp) :: nxrf !< 1960 ! INTEGER(iwp) :: nxr_on_file !< 1961 ! INTEGER(iwp) :: nync !< 1962 ! INTEGER(iwp) :: nynf !< 1963 ! INTEGER(iwp) :: nyn_on_file !< 1964 ! INTEGER(iwp) :: nysc !< 1965 ! INTEGER(iwp) :: nysf !< 1966 ! INTEGER(iwp) :: nys_on_file !< 1967 ! 1749 1968 ! LOGICAL, INTENT(OUT) :: found 1750 ! 1969 ! 1751 1970 ! REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp_3d_non_standard !< temporary array for storing 3D data with non standard dimensions 1752 1971 ! ! 1753 ! !-- If temporary non-standard array for reading is already allocated, 1972 ! !-- If temporary non-standard array for reading is already allocated, 1754 1973 ! !-- deallocate it. 1755 1974 ! IF ( ALLOCATED( tmp_3d_non_standard ) ) DEALLOCATE( tmp_3d_non_standard ) 1756 ! 1975 ! 1757 1976 ! found = .TRUE. 1758 ! 1977 ! 1759 1978 ! SELECT CASE ( restart_string(1:length) ) 1760 ! 1979 ! 1761 1980 ! CASE ( 'ti_av' ) 1762 1981 ! IF ( .NOT. ALLOCATED( ti_av ) ) THEN … … 1769 1988 ! ENDIF 1770 1989 ! ti_av(:,nysc:nync,nxlc:nxrc) = tmp_3d_non_standard(:,nysf:nynf,nxlf:nxrf) 1771 ! 1990 ! 1772 1991 ! CASE ( 'uu_av' ) 1773 1992 ! IF ( .NOT. ALLOCATED( uu_av ) ) THEN … … 1780 1999 ! ENDIF 1781 2000 ! uu_av(:,nysc:nync,nxlc:nxrc) = tmp_3d_non_standard(:,nysf:nynf,nxlf:nxrf) 1782 ! 2001 ! 1783 2002 ! CASE ( 'vv_av' ) 1784 2003 ! IF ( .NOT. ALLOCATED( vv_av ) ) THEN … … 1791 2010 ! ENDIF 1792 2011 ! vv_av(:,nysc:nync,nxlc:nxrc) = tmp_3d_non_standard(:,nysf:nynf,nxlf:nxrf) 1793 ! 2012 ! 1794 2013 ! CASE ( 'ww_av' ) 1795 2014 ! IF ( .NOT. ALLOCATED( ww_av ) ) THEN … … 1802 2021 ! ENDIF 1803 2022 ! ww_av(:,nysc:nync,nxlc:nxrc) = tmp_3d_non_standard(:,nysf:nynf,nxlf:nxrf) 1804 ! 1805 ! 2023 ! 2024 ! 1806 2025 ! CASE DEFAULT 1807 ! 2026 ! 1808 2027 ! found = .FALSE. 1809 ! 2028 ! 1810 2029 ! END SELECT 1811 ! 2030 ! 1812 2031 ! END SUBROUTINE doq_rrd_local 1813 2032 1814 2033 !------------------------------------------------------------------------------! 1815 2034 ! Description: … … 1861 2080 WRITE ( 14 ) wv_av 1862 2081 ENDIF 1863 2082 1864 2083 IF ( ALLOCATED( wtheta_av ) ) THEN 1865 2084 CALL wrd_write_string( 'wtheta_av' ) 1866 2085 WRITE ( 14 ) wtheta_av 1867 2086 ENDIF 1868 2087 1869 2088 IF ( ALLOCATED( wq_av ) ) THEN 1870 2089 CALL wrd_write_string( 'wq_av' ) … … 1872 2091 ENDIF 1873 2092 2093 IF ( ALLOCATED( wspeed_av ) ) THEN 2094 CALL wrd_write_string( 'wspeed_av' ) 2095 WRITE ( 14 ) wspeed_av 2096 ENDIF 2097 2098 IF ( ALLOCATED( u_center_av ) ) THEN 2099 CALL wrd_write_string( 'u_center_av' ) 2100 WRITE ( 14 ) u_center_av 2101 ENDIF 2102 2103 IF ( ALLOCATED( v_center_av ) ) THEN 2104 CALL wrd_write_string( 'v_center_av' ) 2105 WRITE ( 14 ) v_center_av 2106 ENDIF 2107 1874 2108 END SUBROUTINE doq_wrd_local 1875 1876 2109 2110 1877 2111 1878 2112 END MODULE diagnostic_output_quantities_mod -
palm/trunk/SOURCE/read_restart_data_mod.f90
r4360 r4431 25 25 ! ----------------- 26 26 ! $Id$ 27 ! added u_center_av, v_center_av, wspeed_av 28 ! 29 ! 4360 2020-01-07 11:25:50Z suehring 27 30 ! Change automatic arrays to allocatable ones in rrd_local, in order to avoid 28 ! memory problems due to too small stack size for large jobs with intel 31 ! memory problems due to too small stack size for large jobs with intel 29 32 ! compiler. (J.Resler) 30 ! 33 ! 31 34 ! 4331 2019-12-10 18:25:02Z suehring 32 35 ! Enable restart data for 2-m potential temperature output 33 ! 36 ! 34 37 ! 4301 2019-11-22 12:09:09Z oliver.maas 35 38 ! removed recycling_yshift 36 ! 39 ! 37 40 ! 4227 2019-09-10 18:04:34Z gronemeier 38 41 ! implement new palm_date_time_mod and increased binary version 39 ! 42 ! 40 43 ! 4146 2019-08-07 07:47:36Z gronemeier 41 44 ! Corrected "Former revisions" section 42 ! 45 ! 43 46 ! 4131 2019-08-02 11:06:18Z monakurppa 44 47 ! Allocate hom and hom_sum to allow profile output for salsa variables. 45 ! 48 ! 46 49 ! 4101 2019-07-17 15:14:26Z gronemeier 47 50 ! remove old_dt 48 ! 51 ! 49 52 ! 4039 2019-06-18 10:32:41Z suehring 50 53 ! input of uu_av, vv_av, ww_av added 51 ! 54 ! 52 55 ! 4017 2019-06-06 12:16:46Z schwenkel 53 56 ! bugfix for r3998, allocation of 3d temporary arrays of various dimensions revised 54 ! 57 ! 55 58 ! 3998 2019-05-23 13:38:11Z suehring 56 59 ! Formatting adjustment 57 ! 60 ! 58 61 ! 3994 2019-05-22 18:08:09Z suehring 59 62 ! output of turbulence intensity added 60 ! 63 ! 61 64 ! 3988 2019-05-22 11:32:37Z kanani 62 65 ! + time_virtual_measurement (to enable steering of output interval) 63 ! 66 ! 64 67 ! 3936 2019-04-26 15:38:02Z kanani 65 68 ! Enable time-averaged output of theta_2m* with restarts 66 ! 69 ! 67 70 ! 3767 2019-02-27 08:18:02Z raasch 68 71 ! unused variables removed from rrd-subroutines parameter list 69 ! 72 ! 70 73 ! 3766 2019-02-26 16:23:41Z raasch 71 74 ! first argument removed from module_interface_rrd_* 72 ! 75 ! 73 76 ! 3668 2019-01-14 12:49:24Z maronga 74 77 ! Removed most_method and increased binary version 75 ! 78 ! 76 79 ! 3655 2019-01-07 16:51:22Z knoop 77 80 ! Implementation of the PALM module interface 78 ! 81 ! 79 82 ! 2894 2018-03-15 09:17:58Z Giersch 80 83 ! Initial revision 81 ! 84 ! 82 85 ! 83 86 ! Description: … … 111 114 ONLY: pt_2m_av, & 112 115 ti_av, & 116 u_center_av, & 113 117 uu_av, & 114 118 uv_10m_av, & 119 v_center_av, & 115 120 vv_av, & 121 wspeed_av, & 116 122 ww_av 117 123 … … 191 197 ! Description: 192 198 ! ------------ 193 !> Reads values of global control variables from restart-file (binary format) 199 !> Reads values of global control variables from restart-file (binary format) 194 200 !> created by PE0 of the previous run 195 201 !------------------------------------------------------------------------------! … … 199 205 CHARACTER (LEN=10) :: binary_version_global, version_on_file 200 206 201 LOGICAL :: found 207 LOGICAL :: found 202 208 203 209 … … 773 779 WRITE( message_string, * ) 'unknown variable named "', & 774 780 restart_string(1:length), & 775 '" found in global data from ', & 781 '" found in global data from ', & 776 782 'prior run on PE ', myid 777 783 CALL message( 'rrd_global', 'PA0302', 1, 2, 0, 6, 0 ) 778 784 779 785 ENDIF 780 786 … … 783 789 !-- Read next string 784 790 READ ( 13 ) length 785 READ ( 13 ) restart_string(1:length) 791 READ ( 13 ) restart_string(1:length) 786 792 787 793 ENDDO 788 794 789 795 790 796 CALL close_file( 13 ) 791 797 792 798 793 799 END SUBROUTINE rrd_global 794 800 … … 1013 1019 ! Description: 1014 1020 ! ------------ 1015 !> Reads processor specific data of variables and arrays from restart file 1021 !> Reads processor specific data of variables and arrays from restart file 1016 1022 !> (binary format). 1017 1023 !------------------------------------------------------------------------------! … … 1076 1082 CALL cpu_log( log_point_s(14), 'rrd_local', 'start' ) 1077 1083 ! 1078 !-- Allocate temporary buffer arrays. In previous versions, there were 1084 !-- Allocate temporary buffer arrays. In previous versions, there were 1079 1085 !-- declared as automated arrays, causing memory problems when these 1080 1086 !-- were allocate on stack. … … 1109 1115 !-- matches another time(s) in the current subdomain by shifting it 1110 1116 !-- for nx_on_file+1, ny_on_file+1 respectively 1111 1117 1112 1118 shift_y = 0 1113 1119 j = 0 1114 1120 DO WHILE ( nyspr+shift_y <= nyn-offset_y ) 1115 1116 IF ( nynpr+shift_y >= nys-offset_y ) THEN 1121 1122 IF ( nynpr+shift_y >= nys-offset_y ) THEN 1117 1123 1118 1124 shift_x = 0 1119 1125 DO WHILE ( nxlpr+shift_x <= nxr-offset_x ) 1120 1126 1121 1127 IF ( nxrpr+shift_x >= nxl-offset_x ) THEN 1122 1128 j = j +1 … … 1133 1139 file_list(files_to_be_opened) = i-1 1134 1140 ENDIF 1135 1141 1136 1142 offset_xa(files_to_be_opened,j) = offset_x + shift_x 1137 1143 offset_ya(files_to_be_opened,j) = offset_y + shift_y … … 1147 1153 shift_x = shift_x + ( nx_on_file + 1 ) 1148 1154 ENDDO 1149 1155 1150 1156 ENDIF 1151 1152 shift_y = shift_y + ( ny_on_file + 1 ) 1157 1158 shift_y = shift_y + ( ny_on_file + 1 ) 1153 1159 ENDDO 1154 1160 1155 1161 IF ( j > 0 ) overlap_count(files_to_be_opened) = j 1156 1162 1157 1163 ENDDO 1158 1164 1159 1165 ! 1160 1166 !-- Save the id-string of the current process, since myid_char may now be used … … 1172 1178 !-- Read data from all restart files determined above 1173 1179 DO i = 1, files_to_be_opened 1174 1180 1175 1181 j = file_list(i) 1176 1182 ! … … 1231 1237 '&= ', hor_index_bounds_previous_run(3,j), & 1232 1238 '&from the index bound information array' 1233 CALL message( 'rrd_local', 'PA0289', 2, 2, -1, 6, 1 ) 1239 CALL message( 'rrd_local', 'PA0289', 2, 2, -1, 6, 1 ) 1234 1240 ENDIF 1235 1241 … … 1240 1246 '&= ', hor_index_bounds_previous_run(4,j), & 1241 1247 '&from the index bound information array' 1242 CALL message( 'rrd_local', 'PA0290', 2, 2, -1, 6, 1 ) 1248 CALL message( 'rrd_local', 'PA0290', 2, 2, -1, 6, 1 ) 1243 1249 ENDIF 1244 1250 … … 1248 1254 '&nzb on file = ', nzb_on_file, & 1249 1255 '&nzb = ', nzb 1250 CALL message( 'rrd_local', 'PA0291', 1, 2, 0, 6, 0 ) 1256 CALL message( 'rrd_local', 'PA0291', 1, 2, 0, 6, 0 ) 1251 1257 ENDIF 1252 1258 … … 1256 1262 '&nzt on file = ', nzt_on_file, & 1257 1263 '&nzt = ', nzt 1258 CALL message( 'rrd_local', 'PA0292', 1, 2, 0, 6, 0 ) 1264 CALL message( 'rrd_local', 'PA0292', 1, 2, 0, 6, 0 ) 1259 1265 ENDIF 1260 1266 … … 1267 1273 ! 1268 1274 !-- Read arrays 1269 !-- ATTENTION: If the following read commands have been altered, the 1270 !-- ---------- version number of the variable binary_version_local must 1271 !-- be altered, too. Furthermore, the output list of arrays in 1272 !-- wrd_write_local must also be altered 1275 !-- ATTENTION: If the following read commands have been altered, the 1276 !-- ---------- version number of the variable binary_version_local must 1277 !-- be altered, too. Furthermore, the output list of arrays in 1278 !-- wrd_write_local must also be altered 1273 1279 !-- accordingly. 1274 1280 READ ( 13 ) length 1275 1281 READ ( 13 ) restart_string(1:length) 1276 1282 1277 1283 1278 1284 ! … … 1285 1291 1286 1292 found = .FALSE. 1287 1293 1288 1294 ! 1289 1295 !-- Get the index range of the subdomain on file which overlap with … … 1317 1323 IF ( .NOT. ALLOCATED( e_av ) ) THEN 1318 1324 ALLOCATE( e_av(nzb:nzt+1,nys-nbgp:nyn+nbgp, & 1319 nxl-nbgp:nxr+nbgp) ) 1325 nxl-nbgp:nxr+nbgp) ) 1320 1326 ENDIF 1321 1327 IF ( k == 1 ) READ ( 13 ) tmp_3d … … 1428 1434 IF ( .NOT. ALLOCATED( qsws_av ) ) THEN 1429 1435 ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) ) 1430 ENDIF 1436 ENDIF 1431 1437 IF ( k == 1 ) READ ( 13 ) tmp_2d 1432 1438 qsws_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & … … 1488 1494 shf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 1489 1495 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 1490 1496 1491 1497 CASE ( 'ssws_av' ) 1492 1498 IF ( .NOT. ALLOCATED( ssws_av ) ) THEN 1493 1499 ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) ) 1494 ENDIF 1500 ENDIF 1495 1501 IF ( k == 1 ) READ ( 13 ) tmp_2d 1496 1502 ssws_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & … … 1536 1542 u_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 1537 1543 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 1538 1544 1545 CASE ( 'u_center_av' ) 1546 IF ( .NOT. ALLOCATED( u_center_av ) ) THEN 1547 ALLOCATE( u_center_av(nzb:nzt+1,nys:nyn,nxl:nxr) ) 1548 ENDIF 1549 IF ( k == 1 ) THEN 1550 ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,nys_on_file:nyn_on_file, & 1551 nxl_on_file:nxr_on_file) ) 1552 READ ( 13 ) tmp_3d_non_standard 1553 ENDIF 1554 u_center_av(:,nysc:nync,nxlc:nxrc) = tmp_3d_non_standard(:,nysf:nynf,nxlf:nxrf) 1555 1539 1556 CASE ( 'uu_av' ) 1540 1557 IF ( .NOT. ALLOCATED( uu_av ) ) THEN … … 1616 1633 v_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 1617 1634 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 1618 1635 1636 CASE ( 'v_center_av' ) 1637 IF ( .NOT. ALLOCATED( v_center_av ) ) THEN 1638 ALLOCATE( v_center_av(nzb:nzt+1,nys:nyn,nxl:nxr) ) 1639 ENDIF 1640 IF ( k == 1 ) THEN 1641 ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,nys_on_file:nyn_on_file, & 1642 nxl_on_file:nxr_on_file) ) 1643 READ ( 13 ) tmp_3d_non_standard 1644 ENDIF 1645 v_center_av(:,nysc:nync,nxlc:nxrc) = tmp_3d_non_standard(:,nysf:nynf,nxlf:nxrf) 1646 1619 1647 CASE ( 'vv_av' ) 1620 1648 IF ( .NOT. ALLOCATED( vv_av ) ) THEN … … 1693 1721 w_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 1694 1722 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 1695 1723 1696 1724 CASE ( 'ww_av' ) 1697 1725 IF ( .NOT. ALLOCATED( ww_av ) ) THEN … … 1744 1772 w_m_s(:,:,nxlc-nbgp:nxrc+nbgp) = tmp_3d_non_standard(:,:,nxlf-nbgp:nxrf+nbgp) 1745 1773 ENDIF 1774 1775 CASE ( 'wspeed_av' ) 1776 IF ( .NOT. ALLOCATED( wspeed_av ) ) THEN 1777 ALLOCATE( wspeed_av(nzb:nzt+1,nys:nyn,nxl:nxr) ) 1778 ENDIF 1779 IF ( k == 1 ) THEN 1780 ALLOCATE( tmp_3d_non_standard(nzb:nzt+1,nys_on_file:nyn_on_file, & 1781 nxl_on_file:nxr_on_file) ) 1782 READ ( 13 ) tmp_3d_non_standard 1783 ENDIF 1784 wspeed_av(:,nysc:nync,nxlc:nxrc) = tmp_3d_non_standard(:,nysf:nynf,nxlf:nxrf) 1746 1785 1747 1786 CASE ( 'z0_av' ) … … 1791 1830 'from prior run on PE ', myid 1792 1831 CALL message( 'rrd_local', 'PA0302', 1, 2, 0, 6, 0 ) 1793 1832 1794 1833 ENDIF 1795 1834 1796 1835 END SELECT 1797 1836 1798 ENDDO ! overlaploop 1837 ENDDO ! overlaploop 1799 1838 1800 1839 !
Note: See TracChangeset
for help on using the changeset viewer.