Changeset 3687 for palm/trunk/SOURCE/user_module.f90
- Timestamp:
- Jan 22, 2019 10:42:06 AM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/user_module.f90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/user_module.f90
r3655 r3687 70 70 !------------------------------------------------------------------------------! 71 71 MODULE user 72 72 73 74 USE arrays_3d 75 76 USE control_parameters 77 78 USE cpulog 79 80 USE indices 73 81 74 82 USE kinds 83 84 USE pegrid 85 86 USE statistics 87 88 USE statistics, & 89 ONLY: statistic_regions, region 90 91 USE surface_mod 75 92 76 93 IMPLICIT NONE … … 93 110 SAVE 94 111 112 ! PRIVATE 113 114 ! 115 !- Public functions 116 PUBLIC & 117 user_parin, & 118 user_check_parameters, & 119 user_check_data_output_pr, & 120 user_check_data_output, & 121 user_init, & 122 user_header, & 123 user_actions, & 124 user_3d_data_averaging, & 125 user_data_output_2d, & 126 user_data_output_3d, & 127 user_statistics, & 128 user_rrd_global, & 129 user_rrd_local, & 130 user_wrd_global, & 131 user_wrd_local 132 133 ! 134 !- Public parameters, constants and initial values 135 ! PUBLIC & 136 ! user_module_enabled 137 138 INTERFACE user_parin 139 MODULE PROCEDURE user_parin 140 END INTERFACE user_parin 141 142 INTERFACE user_check_parameters 143 MODULE PROCEDURE user_check_parameters 144 END INTERFACE user_check_parameters 145 146 INTERFACE user_check_data_output_pr 147 MODULE PROCEDURE user_check_data_output_pr 148 END INTERFACE user_check_data_output_pr 149 150 INTERFACE user_check_data_output 151 MODULE PROCEDURE user_check_data_output 152 END INTERFACE user_check_data_output 153 154 INTERFACE user_init 155 MODULE PROCEDURE user_init 156 END INTERFACE user_init 157 158 INTERFACE user_header 159 MODULE PROCEDURE user_header 160 END INTERFACE user_header 161 162 INTERFACE user_actions 163 MODULE PROCEDURE user_actions 164 MODULE PROCEDURE user_actions_ij 165 END INTERFACE user_actions 166 167 INTERFACE user_3d_data_averaging 168 MODULE PROCEDURE user_3d_data_averaging 169 END INTERFACE user_3d_data_averaging 170 171 INTERFACE user_data_output_2d 172 MODULE PROCEDURE user_data_output_2d 173 END INTERFACE user_data_output_2d 174 175 INTERFACE user_data_output_3d 176 MODULE PROCEDURE user_data_output_3d 177 END INTERFACE user_data_output_3d 178 179 INTERFACE user_statistics 180 MODULE PROCEDURE user_statistics 181 END INTERFACE user_statistics 182 183 INTERFACE user_rrd_global 184 MODULE PROCEDURE user_rrd_global 185 END INTERFACE user_rrd_global 186 187 INTERFACE user_rrd_local 188 MODULE PROCEDURE user_rrd_local 189 END INTERFACE user_rrd_local 190 191 INTERFACE user_wrd_global 192 MODULE PROCEDURE user_wrd_global 193 END INTERFACE user_wrd_global 194 195 INTERFACE user_wrd_local 196 MODULE PROCEDURE user_wrd_local 197 END INTERFACE user_wrd_local 198 199 200 CONTAINS 201 202 203 !------------------------------------------------------------------------------! 204 ! Description: 205 ! ------------ 206 !> Parin for &user_parameters for user module 207 !------------------------------------------------------------------------------! 208 SUBROUTINE user_parin 209 210 211 CHARACTER (LEN=80) :: line !< 212 213 INTEGER(iwp) :: i !< 214 INTEGER(iwp) :: j !< 215 216 217 NAMELIST /userpar/ data_output_pr_user, data_output_user, region, & 218 data_output_masks_user 219 220 221 NAMELIST /user_parameters/ data_output_pr_user, data_output_user, region, & 222 data_output_masks_user 223 224 ! 225 !-- Set revision number of this default interface version. It will be checked within 226 !-- the main program (palm). Please change the revision number in case that the 227 !-- current revision does not match with previous revisions (e.g. if routines 228 !-- have been added/deleted or if parameter lists in subroutines have been changed). 229 user_interface_current_revision = 'r3240' 230 231 ! 232 !-- Position the namelist-file at the beginning (it was already opened in 233 !-- parin), search for user-defined namelist-group ("userpar", but any other 234 !-- name can be choosed) and position the file at this line. 235 REWIND ( 11 ) 236 237 line = ' ' 238 DO WHILE ( INDEX( line, '&user_parameters' ) == 0 ) 239 READ ( 11, '(A)', END=12 ) line 240 ENDDO 241 BACKSPACE ( 11 ) 242 243 ! 244 !-- Read user-defined namelist 245 READ ( 11, user_parameters, ERR = 10 ) 246 247 user_defined_namelist_found = .TRUE. 248 249 GOTO 14 250 251 10 BACKSPACE( 11 ) 252 READ( 11 , '(A)') line 253 CALL parin_fail_message( 'user_parameters', line ) 254 255 12 REWIND ( 11 ) 256 257 line = ' ' 258 DO WHILE ( INDEX( line, '&userpar' ) == 0 ) 259 READ ( 11, '(A)', END=14 ) line 260 ENDDO 261 BACKSPACE ( 11 ) 262 263 ! 264 !-- Read user-defined namelist 265 READ ( 11, userpar, ERR = 13, END = 14 ) 266 267 message_string = 'namelist userpar is deprecated and will be ' // & 268 'removed in near future. &Please use namelist ' // & 269 'user_parameters instead' 270 CALL message( 'user_parin', 'PA0487', 0, 1, 0, 6, 0 ) 271 272 user_defined_namelist_found = .TRUE. 273 274 GOTO 14 275 276 13 BACKSPACE( 11 ) 277 READ( 11 , '(A)') line 278 CALL parin_fail_message( 'userpar', line ) 279 280 14 CONTINUE 281 282 ! 283 !-- Determine the number of user-defined profiles and append them to the 284 !-- standard data output (data_output_pr) 285 IF ( user_defined_namelist_found ) THEN 286 IF ( data_output_pr_user(1) /= ' ' ) THEN 287 i = 1 288 DO WHILE ( data_output_pr(i) /= ' ' .AND. i <= 100 ) 289 i = i + 1 290 ENDDO 291 j = 1 292 DO WHILE ( data_output_pr_user(j) /= ' ' .AND. j <= 100 ) 293 data_output_pr(i) = data_output_pr_user(j) 294 max_pr_user_tmp = max_pr_user_tmp + 1 295 i = i + 1 296 j = j + 1 297 ENDDO 298 ENDIF 299 ENDIF 300 301 RETURN 302 303 END SUBROUTINE user_parin 304 305 306 !------------------------------------------------------------------------------! 307 ! Description: 308 ! ------------ 309 !> Check &userpar control parameters and deduce further quantities. 310 !------------------------------------------------------------------------------! 311 SUBROUTINE user_check_parameters 312 313 314 !-- Here the user may add code to check the validity of further &userpar 315 !-- control parameters or deduce further quantities. 316 317 318 END SUBROUTINE user_check_parameters 319 320 321 !------------------------------------------------------------------------------! 322 ! Description: 323 ! ------------ 324 !> Set the unit of user defined profile output quantities. For those variables 325 !> not recognized by the user, the parameter unit is set to "illegal", which 326 !> tells the calling routine that the output variable is not defined and leads 327 !> to a program abort. 328 !------------------------------------------------------------------------------! 329 SUBROUTINE user_check_data_output_pr( variable, var_count, unit ) 330 331 332 USE netcdf_interface, & 333 ONLY: dopr_unit 334 335 USE profil_parameter 336 337 338 CHARACTER (LEN=*) :: unit !< 339 CHARACTER (LEN=*) :: variable !< 340 341 INTEGER(iwp) :: user_pr_index !< 342 INTEGER(iwp) :: var_count !< 343 344 SELECT CASE ( TRIM( variable ) ) 345 346 ! 347 !-- Uncomment and extend the following lines, if necessary. 348 !-- Add additional CASE statements depending on the number of quantities 349 !-- for which profiles are to be calculated. The respective calculations 350 !-- to be performed have to be added in routine user_statistics. 351 !-- The quantities are (internally) identified by a user-profile-number 352 !-- (see variable "user_pr_index" below). The first user-profile must be assigned 353 !-- the number "pr_palm+1", the second one "pr_palm+2", etc. The respective 354 !-- user-profile-numbers have also to be used in routine user_statistics! 355 ! CASE ( 'u*v*' ) ! quantity string as given in 356 ! ! data_output_pr_user 357 ! user_pr_index = pr_palm + 1 358 ! dopr_index(var_count) = user_pr_index ! quantities' user-profile-number 359 ! dopr_unit(var_count) = 'm2/s2' ! quantity unit 360 ! hom(:,2,user_pr_index,:) = SPREAD( zu, 2, statistic_regions+1 ) 361 ! ! grid on which the quantity is 362 ! ! defined (use zu or zw) 363 364 CASE DEFAULT 365 unit = 'illegal' 366 367 END SELECT 368 369 370 END SUBROUTINE user_check_data_output_pr 371 372 373 !------------------------------------------------------------------------------! 374 ! Description: 375 ! ------------ 376 !> Set the unit of user defined output quantities. For those variables 377 !> not recognized by the user, the parameter unit is set to "illegal", which 378 !> tells the calling routine that the output variable is not defined and leads 379 !> to a program abort. 380 !------------------------------------------------------------------------------! 381 SUBROUTINE user_check_data_output( variable, unit ) 382 383 384 CHARACTER (LEN=*) :: unit !< 385 CHARACTER (LEN=*) :: variable !< 386 387 388 SELECT CASE ( TRIM( variable ) ) 389 390 ! 391 !-- Uncomment and extend the following lines, if necessary 392 ! CASE ( 'u2' ) 393 ! unit = 'm2/s2' 394 ! 395 ! CASE ( 'u*v*' ) 396 ! unit = 'm2/s2' 397 ! 398 CASE DEFAULT 399 unit = 'illegal' 400 401 END SELECT 402 403 404 END SUBROUTINE user_check_data_output 405 406 407 !------------------------------------------------------------------------------! 408 ! Description: 409 ! ------------ 410 !> Execution of user-defined initializing actions 411 !------------------------------------------------------------------------------! 412 SUBROUTINE user_init 413 414 415 USE netcdf_interface, & 416 ONLY: dots_label, dots_unit, dots_num 417 418 419 CHARACTER (LEN=20) :: field_char !< 420 ! 421 !-- Here the user-defined initializing actions follow: 422 !-- Sample for user-defined output 423 ! ALLOCATE( u2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 424 ! ALLOCATE( ustvst(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ); ustvst = 0.0_wp 425 426 !-- Sample for user-defined time series 427 !-- For each time series quantity you have to give a label and a unit, 428 !-- which will be used for the NetCDF file. They must not contain more than 429 !-- seven characters. The value of dots_num has to be increased by the 430 !-- number of new time series quantities. Its old value has to be store in 431 !-- dots_num_palm. See routine user_statistics on how to output calculate 432 !-- and output these quantities. 433 ! dots_label(dots_num+1) = 'abs_umx' 434 ! dots_unit(dots_num+1) = 'm/s' 435 ! dots_label(dots_num+2) = 'abs_vmx' 436 ! dots_unit(dots_num+2) = 'm/s' 437 ! 438 ! dots_num_palm = dots_num 439 ! dots_num = dots_num + 2 440 441 END SUBROUTINE user_init 442 443 444 !------------------------------------------------------------------------------! 445 ! Description: 446 ! ------------ 447 !> Print a header with user-defined information. 448 !------------------------------------------------------------------------------! 449 SUBROUTINE user_header( io ) 450 451 452 INTEGER(iwp) :: i !< 453 INTEGER(iwp) :: io !< 454 455 ! 456 !-- If no user-defined variables are read from the namelist-file, no 457 !-- information will be printed. 458 IF ( .NOT. user_defined_namelist_found ) THEN 459 WRITE ( io, 100 ) 460 RETURN 461 ENDIF 462 463 ! 464 !-- Printing the information. 465 WRITE ( io, 110 ) 466 467 IF ( statistic_regions /= 0 ) THEN 468 WRITE ( io, 200 ) 469 DO i = 0, statistic_regions 470 WRITE ( io, 201 ) i, region(i) 471 ENDDO 472 ENDIF 473 474 ! 475 !-- Format-descriptors 476 100 FORMAT (//' *** no user-defined variables found'/) 477 110 FORMAT (//1X,78('#') & 478 //' User-defined variables and actions:'/ & 479 ' -----------------------------------'//) 480 200 FORMAT (' Output of profiles and time series for following regions:' /) 481 201 FORMAT (4X,'Region ',I1,': ',A) 482 483 484 END SUBROUTINE user_header 485 486 487 !------------------------------------------------------------------------------! 488 ! Description: 489 ! ------------ 490 !> Call for all grid points 491 !------------------------------------------------------------------------------! 492 SUBROUTINE user_actions( location ) 493 494 495 CHARACTER (LEN=*) :: location !< 496 497 INTEGER(iwp) :: i !< 498 INTEGER(iwp) :: j !< 499 INTEGER(iwp) :: k !< 500 501 CALL cpu_log( log_point(24), 'user_actions', 'start' ) 502 503 ! 504 !-- Here the user-defined actions follow 505 !-- No calls for single grid points are allowed at locations before and 506 !-- after the timestep, since these calls are not within an i,j-loop 507 SELECT CASE ( location ) 508 509 CASE ( 'before_timestep' ) 510 ! 511 !-- Enter actions to be done before every timestep here 512 513 514 CASE ( 'after_integration' ) 515 ! 516 !-- Enter actions to be done after every time integration (before 517 !-- data output) 518 !-- Sample for user-defined output: 519 ! DO i = nxlg, nxrg 520 ! DO j = nysg, nyng 521 ! DO k = nzb, nzt 522 ! u2(k,j,i) = u(k,j,i)**2 523 ! ENDDO 524 ! ENDDO 525 ! ENDDO 526 ! DO i = nxlg, nxr 527 ! DO j = nysg, nyn 528 ! DO k = nzb, nzt+1 529 ! ustvst(k,j,i) = & 530 ! ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,0) ) * & 531 ! ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,0) ) 532 ! ENDDO 533 ! ENDDO 534 ! ENDDO 535 536 537 CASE ( 'after_timestep' ) 538 ! 539 !-- Enter actions to be done after every timestep here 540 541 542 CASE ( 'u-tendency' ) 543 ! 544 !-- Enter actions to be done in the u-tendency term here 545 546 547 CASE ( 'v-tendency' ) 548 549 550 CASE ( 'w-tendency' ) 551 552 553 CASE ( 'pt-tendency' ) 554 555 556 CASE ( 'sa-tendency' ) 557 558 559 CASE ( 'e-tendency' ) 560 561 562 CASE ( 'q-tendency' ) 563 564 565 CASE ( 's-tendency' ) 566 567 568 CASE DEFAULT 569 message_string = 'unknown location "' // location // '"' 570 CALL message( 'user_actions', 'UI0001', 1, 2, 0, 6, 0 ) 571 572 END SELECT 573 574 CALL cpu_log( log_point(24), 'user_actions', 'stop' ) 575 576 END SUBROUTINE user_actions 577 578 579 !------------------------------------------------------------------------------! 580 ! Description: 581 ! ------------ 582 !> Call for grid point i,j 583 !------------------------------------------------------------------------------! 584 SUBROUTINE user_actions_ij( i, j, location ) 585 586 587 CHARACTER (LEN=*) :: location 588 589 INTEGER(iwp) :: i 590 INTEGER(iwp) :: idum 591 INTEGER(iwp) :: j 592 593 ! 594 !-- Here the user-defined actions follow 595 SELECT CASE ( location ) 596 597 CASE ( 'u-tendency' ) 598 ! 599 !-- Enter actions to be done in the u-tendency term here 600 601 602 CASE ( 'v-tendency' ) 603 604 605 CASE ( 'w-tendency' ) 606 607 608 CASE ( 'pt-tendency' ) 609 610 611 CASE ( 'sa-tendency' ) 612 613 614 CASE ( 'e-tendency' ) 615 616 617 CASE ( 'q-tendency' ) 618 619 620 CASE ( 's-tendency' ) 621 622 623 CASE ( 'before_timestep', 'after_integration', 'after_timestep' ) 624 message_string = 'location "' // location // '" is not ' // & 625 'allowed to be called with parameters "i" and "j"' 626 CALL message( 'user_actions', 'UI0002', 1, 2, 0, 6, 0 ) 627 628 629 CASE DEFAULT 630 message_string = 'unknown location "' // location // '"' 631 CALL message( 'user_actions', 'UI0001', 1, 2, 0, 6, 0 ) 632 633 634 END SELECT 635 636 END SUBROUTINE user_actions_ij 637 638 639 !------------------------------------------------------------------------------! 640 ! Description: 641 ! ------------ 642 !> Sum up and time-average user-defined output quantities as well as allocate 643 !> the array necessary for storing the average. 644 !------------------------------------------------------------------------------! 645 SUBROUTINE user_3d_data_averaging( mode, variable ) 646 647 648 CHARACTER (LEN=*) :: mode !< 649 CHARACTER (LEN=*) :: variable !< 650 651 INTEGER(iwp) :: i !< 652 INTEGER(iwp) :: j !< 653 INTEGER(iwp) :: k !< 654 655 IF ( mode == 'allocate' ) THEN 656 657 SELECT CASE ( TRIM( variable ) ) 658 659 ! 660 !-- Uncomment and extend the following lines, if necessary. 661 !-- The arrays for storing the user defined quantities (here u2_av) have 662 !-- to be declared and defined by the user! 663 !-- Sample for user-defined output: 664 ! CASE ( 'u2' ) 665 ! IF ( .NOT. ALLOCATED( u2_av ) ) THEN 666 ! ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 667 ! ENDIF 668 ! u2_av = 0.0_wp 669 670 CASE DEFAULT 671 CONTINUE 672 673 END SELECT 674 675 ELSEIF ( mode == 'sum' ) THEN 676 677 SELECT CASE ( TRIM( variable ) ) 678 679 ! 680 !-- Uncomment and extend the following lines, if necessary. 681 !-- The arrays for storing the user defined quantities (here u2 and 682 !-- u2_av) have to be declared and defined by the user! 683 !-- Sample for user-defined output: 684 ! CASE ( 'u2' ) 685 ! IF ( ALLOCATED( u2_av ) ) THEN 686 ! DO i = nxlg, nxrg 687 ! DO j = nysg, nyng 688 ! DO k = nzb, nzt+1 689 ! u2_av(k,j,i) = u2_av(k,j,i) + u2(k,j,i) 690 ! ENDDO 691 ! ENDDO 692 ! ENDDO 693 ! ENDIF 694 695 CASE DEFAULT 696 CONTINUE 697 698 END SELECT 699 700 ELSEIF ( mode == 'average' ) THEN 701 702 SELECT CASE ( TRIM( variable ) ) 703 704 ! 705 !-- Uncomment and extend the following lines, if necessary. 706 !-- The arrays for storing the user defined quantities (here u2_av) have 707 !-- to be declared and defined by the user! 708 !-- Sample for user-defined output: 709 ! CASE ( 'u2' ) 710 ! IF ( ALLOCATED( u2_av ) ) THEN 711 ! DO i = nxlg, nxrg 712 ! DO j = nysg, nyng 713 ! DO k = nzb, nzt+1 714 ! u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 715 ! ENDDO 716 ! ENDDO 717 ! ENDDO 718 ! ENDIF 719 720 END SELECT 721 722 ENDIF 723 724 725 END SUBROUTINE user_3d_data_averaging 726 727 728 !------------------------------------------------------------------------------! 729 ! Description: 730 ! ------------ 731 !> Resorts the user-defined output quantity with indices (k,j,i) to a 732 !> temporary array with indices (i,j,k) and sets the grid on which it is defined. 733 !> Allowed values for grid are "zu" and "zw". 734 !------------------------------------------------------------------------------! 735 SUBROUTINE user_data_output_2d( av, variable, found, grid, local_pf, two_d, nzb_do, nzt_do ) 736 737 738 CHARACTER (LEN=*) :: grid !< 739 CHARACTER (LEN=*) :: variable !< 740 741 INTEGER(iwp) :: av !< flag to control data output of instantaneous or time-averaged data 742 INTEGER(iwp) :: i !< grid index along x-direction 743 INTEGER(iwp) :: j !< grid index along y-direction 744 INTEGER(iwp) :: k !< grid index along z-direction 745 INTEGER(iwp) :: m !< running index surface elements 746 INTEGER(iwp) :: nzb_do !< lower limit of the domain (usually nzb) 747 INTEGER(iwp) :: nzt_do !< upper limit of the domain (usually nzt+1) 748 749 LOGICAL :: found !< 750 LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections) 751 752 REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute 753 754 REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 755 756 757 found = .TRUE. 758 759 SELECT CASE ( TRIM( variable ) ) 760 761 ! 762 !-- Uncomment and extend the following lines, if necessary. 763 !-- The arrays for storing the user defined quantities (here u2 and u2_av) 764 !-- have to be declared and defined by the user! 765 !-- Sample for user-defined output: 766 ! CASE ( 'u2_xy', 'u2_xz', 'u2_yz' ) 767 ! IF ( av == 0 ) THEN 768 ! DO i = nxl, nxr 769 ! DO j = nys, nyn 770 ! DO k = nzb_do, nzt_do 771 ! local_pf(i,j,k) = u2(k,j,i) 772 ! ENDDO 773 ! ENDDO 774 ! ENDDO 775 ! ELSE 776 ! IF ( .NOT. ALLOCATED( u2_av ) ) THEN 777 ! ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 778 ! u2_av = REAL( fill_value, KIND = wp ) 779 ! ENDIF 780 ! DO i = nxl, nxr 781 ! DO j = nys, nyn 782 ! DO k = nzb_do, nzt_do 783 ! local_pf(i,j,k) = u2_av(k,j,i) 784 ! ENDDO 785 ! ENDDO 786 ! ENDDO 787 ! ENDIF 788 ! 789 ! grid = 'zu' 790 ! 791 !-- In case two-dimensional surface variables are output, the user 792 !-- has to access related surface-type. Uncomment and extend following lines 793 !-- appropriately (example output of vertical surface momentum flux of u- 794 !-- component). Please note, surface elements can be distributed over 795 !-- several data type, depending on their respective surface properties. 796 ! CASE ( 'usws_xy' ) 797 ! IF ( av == 0 ) THEN 798 ! 799 !-- Horizontal default-type surfaces 800 ! DO m = 1, surf_def_h(0)%ns 801 ! i = surf_def_h(0)%i(m) 802 ! j = surf_def_h(0)%j(m) 803 ! local_pf(i,j,1) = surf_def_h(0)%usws(m) 804 ! ENDDO 805 ! 806 !-- Horizontal natural-type surfaces 807 ! DO m = 1, surf_lsm_h%ns 808 ! i = surf_lsm_h%i(m) 809 ! j = surf_lsm_h%j(m) 810 ! local_pf(i,j,1) = surf_lsm_h%usws(m) 811 ! ENDDO 812 ! 813 !-- Horizontal urban-type surfaces 814 ! DO m = 1, surf_usm_h%ns 815 ! i = surf_usm_h%i(m) 816 ! j = surf_usm_h%j(m) 817 ! local_pf(i,j,1) = surf_usm_h%usws(m) 818 ! ENDDO 819 ! ENDIF 820 ! 821 ! grid = 'zu' 822 !-- 823 824 825 CASE DEFAULT 826 found = .FALSE. 827 grid = 'none' 828 829 END SELECT 830 831 832 END SUBROUTINE user_data_output_2d 833 834 835 !------------------------------------------------------------------------------! 836 ! Description: 837 ! ------------ 838 !> Resorts the user-defined output quantity with indices (k,j,i) to a 839 !> temporary array with indices (i,j,k). 840 !------------------------------------------------------------------------------! 841 SUBROUTINE user_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do ) 842 843 844 CHARACTER (LEN=*) :: variable !< 845 846 INTEGER(iwp) :: av !< 847 INTEGER(iwp) :: i !< 848 INTEGER(iwp) :: j !< 849 INTEGER(iwp) :: k !< 850 INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0) 851 INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d) 852 853 LOGICAL :: found !< 854 855 REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute 856 857 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 858 859 860 found = .TRUE. 861 862 SELECT CASE ( TRIM( variable ) ) 863 864 ! 865 !-- Uncomment and extend the following lines, if necessary. 866 !-- The arrays for storing the user defined quantities (here u2 and u2_av) 867 !-- have to be declared and defined by the user! 868 !-- Sample for user-defined output: 869 ! CASE ( 'u2' ) 870 ! IF ( av == 0 ) THEN 871 ! DO i = nxl, nxr 872 ! DO j = nys, nyn 873 ! DO k = nzb_do, nzt_do 874 ! local_pf(i,j,k) = u2(k,j,i) 875 ! ENDDO 876 ! ENDDO 877 ! ENDDO 878 ! ELSE 879 ! IF ( .NOT. ALLOCATED( u2_av ) ) THEN 880 ! ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 881 ! u2_av = REAL( fill_value, KIND = wp ) 882 ! ENDIF 883 ! DO i = nxl, nxr 884 ! DO j = nys, nyn 885 ! DO k = nzb_do, nzt_do 886 ! local_pf(i,j,k) = u2_av(k,j,i) 887 ! ENDDO 888 ! ENDDO 889 ! ENDDO 890 ! ENDIF 891 ! 892 893 CASE DEFAULT 894 found = .FALSE. 895 896 END SELECT 897 898 899 END SUBROUTINE user_data_output_3d 900 901 902 !------------------------------------------------------------------------------! 903 ! Description: 904 ! ------------ 905 !> Calculation of user-defined statistics, i.e. horizontally averaged profiles 906 !> and time series. 907 !> This routine is called for every statistic region sr defined by the user, 908 !> but at least for the region "total domain" (sr=0). 909 !> See section 3.5.4 on how to define, calculate, and output user defined 910 !> quantities. 911 !------------------------------------------------------------------------------! 912 SUBROUTINE user_statistics( mode, sr, tn ) 913 914 915 USE netcdf_interface, & 916 ONLY: dots_max 917 918 919 CHARACTER (LEN=*) :: mode !< 920 921 INTEGER(iwp) :: i !< 922 INTEGER(iwp) :: j !< 923 INTEGER(iwp) :: k !< 924 INTEGER(iwp) :: sr !< 925 INTEGER(iwp) :: tn !< 926 927 REAL(wp), & 928 DIMENSION(dots_num_palm+1:dots_max) :: & 929 ts_value_l !< 930 931 932 IF ( mode == 'profiles' ) THEN 933 934 ! 935 !-- Sample on how to calculate horizontally averaged profiles of user- 936 !-- defined quantities. Each quantity is identified by the index 937 !-- "pr_palm+#" where "#" is an integer starting from 1. These 938 !-- user-profile-numbers must also be assigned to the respective strings 939 !-- given by data_output_pr_user in routine user_check_data_output_pr. 940 ! !$OMP DO 941 ! DO i = nxl, nxr 942 ! DO j = nys, nyn 943 ! DO k = nzb+1, nzt 944 !! 945 !!-- Sample on how to calculate the profile of the resolved-scale 946 !!-- horizontal momentum flux u*v* 947 ! sums_l(k,pr_palm+1,tn) = sums_l(k,pr_palm+1,tn) + & 948 ! ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,sr) ) *& 949 ! ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,sr) ) & 950 ! * rmask(j,i,sr) & 951 ! * MERGE( 1.0_wp, 0.0_wp, & 952 ! BTEST( wall_flags_0(k,j,i), 0 ) ) 953 !! 954 !!-- Further profiles can be defined and calculated by increasing 955 !!-- the second index of array sums_l (replace ... appropriately) 956 ! sums_l(k,pr_palm+2,tn) = sums_l(k,pr_palm+2,tn) + ... & 957 ! * rmask(j,i,sr) 958 ! ENDDO 959 ! ENDDO 960 ! ENDDO 961 962 ELSEIF ( mode == 'time_series' ) THEN 963 964 ! 965 !-- Sample on how to add values for the user-defined time series quantities. 966 !-- These have to be defined before in routine user_init. This sample 967 !-- creates two time series for the absolut values of the horizontal 968 !-- velocities u and v. 969 ! ts_value_l = 0.0_wp 970 ! ts_value_l(dots_num_palm+1) = ABS( u_max ) 971 ! ts_value_l(dots_num_palm+2) = ABS( v_max ) 972 ! 973 !-- Collect / send values to PE0, because only PE0 outputs the time series. 974 !-- CAUTION: Collection is done by taking the sum over all processors. 975 !-- You may have to normalize this sum, depending on the quantity 976 !-- that you like to calculate. For serial runs, nothing has to be 977 !-- done. 978 !-- HINT: If the time series value that you are calculating has the same 979 !-- value on all PEs, you can omit the MPI_ALLREDUCE call and 980 !-- assign ts_value(dots_num_palm+1:,sr) = ts_value_l directly. 981 !#if defined( __parallel ) 982 ! IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 983 ! CALL MPI_ALLREDUCE( ts_value_l(dots_num_palm+1), & 984 ! ts_value(dots_num_palm+1,sr), & 985 ! dots_max-dots_num_palm, MPI_REAL, MPI_SUM, comm2d, & 986 ! ierr ) 987 !#else 988 ! ts_value(dots_num_palm+1:,sr) = ts_value_l 989 !#endif 990 991 ENDIF 992 993 END SUBROUTINE user_statistics 994 995 996 !------------------------------------------------------------------------------! 997 ! Description: 998 ! ------------ 999 !> Reading global restart data that has been defined by the user. 1000 !------------------------------------------------------------------------------! 1001 SUBROUTINE user_rrd_global( found ) 1002 1003 1004 USE control_parameters, & 1005 ONLY: length, restart_string 1006 1007 1008 LOGICAL, INTENT(OUT) :: found 1009 1010 1011 found = .TRUE. 1012 1013 1014 SELECT CASE ( restart_string(1:length) ) 1015 1016 CASE ( 'global_paramter' ) 1017 ! READ ( 13 ) global_parameter 1018 1019 CASE DEFAULT 1020 1021 found = .FALSE. 1022 1023 END SELECT 1024 1025 1026 END SUBROUTINE user_rrd_global 1027 1028 1029 !------------------------------------------------------------------------------! 1030 ! Description: 1031 ! ------------ 1032 !> Reading processor specific restart data from file(s) that has been defined 1033 !> by the user. 1034 !> Subdomain index limits on file are given by nxl_on_file, etc. 1035 !> Indices nxlc, etc. indicate the range of gridpoints to be mapped from the 1036 !> subdomain on file (f) to the subdomain of the current PE (c). They have been 1037 !> calculated in routine rrd_local. 1038 !------------------------------------------------------------------------------! 1039 SUBROUTINE user_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, & 1040 nxr_on_file, nynf, nync, nyn_on_file, nysf, & 1041 nysc, nys_on_file, tmp_3d, found ) 1042 1043 1044 INTEGER(iwp) :: i !< 1045 INTEGER(iwp) :: k !< 1046 INTEGER(iwp) :: nxlc !< 1047 INTEGER(iwp) :: nxlf !< 1048 INTEGER(iwp) :: nxl_on_file !< 1049 INTEGER(iwp) :: nxrc !< 1050 INTEGER(iwp) :: nxrf !< 1051 INTEGER(iwp) :: nxr_on_file !< 1052 INTEGER(iwp) :: nync !< 1053 INTEGER(iwp) :: nynf !< 1054 INTEGER(iwp) :: nyn_on_file !< 1055 INTEGER(iwp) :: nysc !< 1056 INTEGER(iwp) :: nysf !< 1057 INTEGER(iwp) :: nys_on_file !< 1058 1059 LOGICAL, INTENT(OUT) :: found 1060 1061 REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !< 1062 1063 ! 1064 !-- Here the reading of user-defined restart data follows: 1065 !-- Sample for user-defined output 1066 1067 1068 found = .TRUE. 1069 1070 1071 SELECT CASE ( restart_string(1:length) ) 1072 1073 CASE ( 'u2_av' ) 1074 ! IF ( .NOT. ALLOCATED( u2_av ) ) THEN 1075 ! ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 1076 ! ENDIF 1077 ! IF ( k == 1 ) READ ( 13 ) tmp_3d 1078 ! u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 1079 ! tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 1080 ! 1081 CASE DEFAULT 1082 1083 found = .FALSE. 1084 1085 END SELECT 1086 1087 1088 END SUBROUTINE user_rrd_local 1089 1090 1091 !------------------------------------------------------------------------------! 1092 ! Description: 1093 ! ------------ 1094 !> Writes global and user-defined restart data into binary file(s) for restart 1095 !> runs. 1096 !------------------------------------------------------------------------------! 1097 SUBROUTINE user_wrd_global 1098 1099 1100 ! CALL wrd_write_string( 'global_parameter' ) 1101 ! WRITE ( 14 ) global_parameter 1102 1103 1104 END SUBROUTINE user_wrd_global 1105 1106 1107 !------------------------------------------------------------------------------! 1108 ! Description: 1109 ! ------------ 1110 !> Writes processor specific and user-defined restart data into binary file(s) 1111 !> for restart runs. 1112 !------------------------------------------------------------------------------! 1113 SUBROUTINE user_wrd_local 1114 1115 1116 ! 1117 !-- Here the user-defined actions at the end of a job follow. 1118 !-- Sample for user-defined output: 1119 ! IF ( ALLOCATED( u2_av ) ) THEN 1120 ! CALL wrd_write_string( 'u2_av' ) 1121 ! WRITE ( 14 ) u2_av 1122 ! ENDIF 1123 1124 1125 1126 END SUBROUTINE user_wrd_local 1127 1128 1129 !------------------------------------------------------------------------------! 1130 ! Description: 1131 ! ------------ 1132 !> Execution of user-defined actions at the end of a job. 1133 !------------------------------------------------------------------------------! 1134 SUBROUTINE user_last_actions 1135 1136 ! 1137 !-- Here the user-defined actions at the end of a job might follow. 1138 1139 1140 END SUBROUTINE user_last_actions 1141 1142 95 1143 END MODULE user
Note: See TracChangeset
for help on using the changeset viewer.
