Changeset 3739 for palm/trunk
- Timestamp:
- Feb 13, 2019 8:05:17 AM (6 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 3 edited
-
biometeorology_mod.f90 (modified) (26 diffs)
-
module_interface.f90 (modified) (3 diffs)
-
time_integration.f90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/biometeorology_mod.f90
r3735 r3739 27 27 ! ----------------- 28 28 ! $Id$ 29 ! - Auto-adjusting thermal_comfort flag if not set by user, but thermal_indices 30 ! set as output quantities. 31 ! - Renamed flags "bio_<index>" to "do_calculate_<index>" for better readability 32 ! - Removed everything related to "time_bio_results" as this is never used. 33 ! - Moved humidity warning to check_data_output 34 ! - Fixed bug in mrt calculation introduced with my commit yesterday. 35 ! 36 ! 3735 2019-02-12 09:52:40Z dom_dwd_user 29 37 ! - Fixed auto-setting of thermal index calculation flags by output 30 38 ! as originally proposed by resler. … … 173 181 INTEGER( iwp ) :: bio_cell_level !< cell level biom calculates for 174 182 REAL ( wp ) :: bio_output_height !< height output is calculated in m 175 REAL ( wp ) :: time_bio_results !< the time, the last set of biom results have been calculated for176 183 REAL ( wp ), PARAMETER :: human_absorb = 0.7_wp !< SW absorbtivity of a human body (Fanger 1972) 177 184 REAL ( wp ), PARAMETER :: human_emiss = 0.97_wp !< LW emissivity of a human body after (Fanger 1972) … … 189 196 LOGICAL :: average_trigger_pet = .FALSE. !< update averaged input on call to bio_pet? 190 197 191 LOGICAL :: thermal_comfort = .FALSE. !< Turn all thermal indices on or off192 LOGICAL :: bio_perct = .FALSE. !< Turn index PT (instant. input) on or off193 LOGICAL :: bio_perct_av = .FALSE. !< Turn index PT (averaged input) on or off194 LOGICAL :: bio_pet = .FALSE. !< Turn index PET (instant. input) on or off195 LOGICAL :: bio_pet_av = .FALSE. !< Turn index PET (averaged input) on or off196 LOGICAL :: bio_utci = .FALSE. !< Turn index UTCI (instant. input) on or off197 LOGICAL :: bio_utci_av = .FALSE. !< Turn index UTCI (averaged input) on or off198 LOGICAL :: thermal_comfort = .FALSE. !< Enables or disables thermal comfort part 199 LOGICAL :: do_calculate_perct = .FALSE. !< Turn index PT (instant. input) on or off 200 LOGICAL :: do_calculate_perct_av = .FALSE. !< Turn index PT (averaged input) on or off 201 LOGICAL :: do_calculate_pet = .FALSE. !< Turn index PET (instant. input) on or off 202 LOGICAL :: do_calculate_pet_av = .FALSE. !< Turn index PET (averaged input) on or off 203 LOGICAL :: do_calculate_utci = .FALSE. !< Turn index UTCI (instant. input) on or off 204 LOGICAL :: do_calculate_utci_av = .FALSE. !< Turn index UTCI (averaged input) on or off 198 205 199 206 ! … … 254 261 bio_check_parameters, bio_data_output_3d, bio_data_output_2d, & 255 262 bio_define_netcdf_grid, bio_get_thermal_index_input_ij, bio_header, & 256 bio_init, bio_init_checks, bio_parin, thermal_comfort, time_bio_results,&263 bio_init, bio_init_checks, bio_parin, thermal_comfort, & 257 264 bio_nmrtbl, bio_wrd_local, bio_rrd_local, bio_wrd_global, bio_rrd_global 258 265 ! … … 486 493 IF ( mrt_include_sw ) THEN 487 494 mrt_av_grid(:) = mrt_av_grid(:) + & 488 (( human_absorb * mrtinsw(:) + human_emiss * mrtinlw(:)) & 489 / (human_emiss * sigma_sb)) ** .25_wp - degc_to_k 495 ( ( human_absorb * mrtinsw(:) + & 496 mrtinlw(:) ) / & ! human_emiss * mrtinlw(:) / 497 ( human_emiss * sigma_sb ) ) ** .25_wp - degc_to_k 490 498 ELSE 491 499 mrt_av_grid(:) = mrt_av_grid(:) + & 492 ( human_emiss * mrtinlw(:) / sigma_sb) ** .25_wp &493 - degc_to_k500 ( mrtinlw(:) / & ! ( human_emiss * mrtinlw(:) / 501 ( human_emiss * sigma_sb ) ) ** .25_wp - degc_to_k 494 502 ENDIF 495 503 ENDIF … … 559 567 IF ( mrt_include_sw ) THEN 560 568 mrt_av_grid(:) = mrt_av_grid(:) + & 561 (( human_absorb * mrtinsw(:) + human_emiss * mrtinlw(:)) & 562 / (human_emiss * sigma_sb)) ** .25_wp - degc_to_k 569 ( ( human_absorb * mrtinsw(:) + & 570 mrtinlw(:) ) / & ! human_emiss * mrtinlw(:) / 571 ( human_emiss * sigma_sb ) ) ** .25_wp - degc_to_k 563 572 ELSE 564 573 mrt_av_grid(:) = mrt_av_grid(:) + & 565 ( human_emiss * mrtinlw(:) / sigma_sb) ** .25_wp &566 - degc_to_k574 ( mrtinlw(:) / & ! ( human_emiss * mrtinlw(:) / 575 ( human_emiss * sigma_sb ) ) ** .25_wp - degc_to_k 567 576 ENDIF 568 577 ENDIF … … 693 702 CHARACTER (LEN=*) :: var !< The variable in question 694 703 695 INTEGER(iwp) :: i !<696 INTEGER(iwp), INTENT(IN) :: j !< average quantity? 0 = no, 1 = yes697 INTEGER(iwp) :: ilen !<698 INTEGER(iwp) :: k !<704 INTEGER(iwp), INTENT(IN) :: i !< Current element of data_output 705 INTEGER(iwp), INTENT(IN) :: j !< Average quantity? 0 = no, 1 = yes 706 INTEGER(iwp), INTENT(IN) :: ilen !< Length of current entry in data_output 707 INTEGER(iwp), INTENT(IN) :: k !< Output is xy mode? 0 = no, 1 = yes 699 708 700 709 SELECT CASE ( TRIM( var ) ) … … 707 716 CASE ( 'bio_mrt' ) 708 717 unit = 'degree_C' 718 thermal_comfort = .TRUE. !< enable thermal_comfort if user forgot to do so 709 719 IF ( .NOT. ALLOCATED( tmrt_grid ) ) THEN 710 720 ALLOCATE( tmrt_grid (nys:nyn,nxl:nxr) ) … … 714 724 CASE ( 'bio_perct*' ) 715 725 unit = 'degree_C' 726 thermal_comfort = .TRUE. 716 727 IF ( j == 0 ) THEN !< if instantaneous input 717 bio_perct = .TRUE.728 do_calculate_perct = .TRUE. 718 729 IF ( .NOT. ALLOCATED( perct ) ) THEN 719 730 ALLOCATE( perct (nys:nyn,nxl:nxr) ) … … 721 732 ENDIF 722 733 ELSE !< if averaged input 723 bio_perct_av = .TRUE.734 do_calculate_perct_av = .TRUE. 724 735 IF ( .NOT. ALLOCATED( perct_av ) ) THEN 725 736 ALLOCATE( perct_av (nys:nyn,nxl:nxr) ) … … 730 741 CASE ( 'bio_utci*' ) 731 742 unit = 'degree_C' 743 thermal_comfort = .TRUE. 732 744 IF ( j == 0 ) THEN 733 bio_utci = .TRUE.745 do_calculate_utci = .TRUE. 734 746 IF ( .NOT. ALLOCATED( utci ) ) THEN 735 747 ALLOCATE( utci (nys:nyn,nxl:nxr) ) … … 737 749 ENDIF 738 750 ELSE 739 bio_utci_av = .TRUE.751 do_calculate_utci_av = .TRUE. 740 752 IF ( .NOT. ALLOCATED( utci_av ) ) THEN 741 753 ALLOCATE( utci_av (nys:nyn,nxl:nxr) ) … … 746 758 CASE ( 'bio_pet*' ) 747 759 unit = 'degree_C' 760 thermal_comfort = .TRUE. 748 761 IF ( j == 0 ) THEN 749 bio_pet = .TRUE.762 do_calculate_pet = .TRUE. 750 763 IF ( .NOT. ALLOCATED( pet ) ) THEN 751 764 ALLOCATE( pet (nys:nyn,nxl:nxr) ) … … 753 766 ENDIF 754 767 ELSE 755 bio_pet_av = .TRUE.768 do_calculate_pet_av = .TRUE. 756 769 IF ( .NOT. ALLOCATED( pet_av ) ) THEN 757 770 ALLOCATE( pet_av (nys:nyn,nxl:nxr) ) … … 812 825 unit = 'illegal' 813 826 ENDIF 827 IF ( .NOT. humidity ) THEN 828 message_string = 'The estimation of thermal comfort requires ' // & 829 'air humidity information, but humidity module ' // & 830 'is disabled!' 831 CALL message( 'check_parameters', 'PA0561', 1, 2, 0, 6, 0 ) 832 unit = 'illegal' 833 ENDIF 814 834 IF ( mrt_nlevels == 0 ) THEN 815 835 message_string = 'output of "' // TRIM( var ) // '" require' & … … 838 858 IMPLICIT NONE 839 859 840 ! 841 !-- Disabled as long as radiation model not available 842 843 IF ( thermal_comfort .AND. .NOT. humidity ) THEN 844 message_string = 'The estimation of thermal comfort requires ' // & 845 'air humidity information, but humidity module ' // & 846 'is disabled!' 847 CALL message( 'bio_check_parameters', 'PA0561', 1, 2, 0, 6, 0 ) 848 ENDIF 860 849 861 850 862 END SUBROUTINE bio_check_parameters … … 904 916 IF ( av == 0 ) THEN 905 917 IF ( mrt_include_sw ) THEN 906 local_pf(i,j,k) = ((human_absorb * mrtinsw(l) + & 907 human_emiss * mrtinlw(l)) / & 908 (human_emiss * sigma_sb)) ** .25_wp - degc_to_k 918 local_pf(i,j,k) = ( ( human_absorb * mrtinsw(l) + & 919 mrtinlw(l) ) / & ! human_emiss * mrtinlw(l) ) / 920 ( human_emiss * sigma_sb ) ) ** .25_wp - & 921 degc_to_k 909 922 ELSE 910 local_pf(i,j,k) = (human_emiss * mrtinlw(l) / & 911 sigma_sb) ** .25_wp - degc_to_k 923 local_pf(i,j,k) = ( mrtinlw(l) / & ! ( (human_emiss * mrtinlw(l) ) / 924 ( human_emiss * sigma_sb ) ) ** .25_wp - & 925 degc_to_k 912 926 ENDIF 913 927 ELSE … … 1056 1070 IF ( mrt_include_sw ) THEN 1057 1071 local_pf(i,j,k) = REAL( ( ( human_absorb * mrtinsw(l) + & 1058 human_emiss * mrtinlw(l) ) / &1072 mrtinlw(l) ) / & ! human_emiss * mrtinlw(l) ) / 1059 1073 ( human_emiss * sigma_sb ) ) ** .25_wp - & 1060 1074 degc_to_k, KIND = sp ) 1061 1075 ELSE 1062 local_pf(i,j,k) = REAL( ( ( human_emiss * mrtinlw(l) ) / &1076 local_pf(i,j,k) = REAL( ( mrtinlw(l) / & ! REAL( ( ( human_emiss * mrtinlw(l) ) / 1063 1077 ( human_emiss * sigma_sb ) ) ** .25_wp - & 1064 1078 degc_to_k, KIND = sp ) … … 1179 1193 ! (gravimetric center of sample human) 1180 1194 1181 time_bio_results = 0.0_wp1182 1195 bio_cell_level = 0_iwp 1183 1196 bio_output_height = 0.5_wp * dz(1) … … 1467 1480 1468 1481 ELSE 1469 1470 1482 ! 1471 1483 !-- Calculate biometeorology MRT from local radiation fluxes calculated by RTM and assign … … 1485 1497 IF ( mrt_include_sw ) THEN 1486 1498 tmrt_grid(j,i) = ( ( human_absorb * mrtinsw(l) + & 1487 human_emiss * mrtinlw(l) ) / &1499 mrtinlw(l) ) / & ! human_emiss * mrtinlw(l) ) / 1488 1500 ( human_emiss * sigma_sb ) ) ** .25_wp - & 1489 1501 degc_to_k 1490 1502 ELSE 1491 tmrt_grid(j,i) = ( ( human_emiss * mrtinlw(l) ) / &1503 tmrt_grid(j,i) = ( mrtinlw(l) / & ! ( ( human_emiss * mrtinlw(l) ) / 1492 1504 ( human_emiss * sigma_sb ) ) ** .25_wp - & 1493 1505 degc_to_k … … 1649 1661 clo = bio_fill_value 1650 1662 1651 IF ( bio_perct .OR. bio_perct_av ) THEN1663 IF ( do_calculate_perct .OR. do_calculate_perct_av ) THEN 1652 1664 ! 1653 1665 !-- Estimate local perceived temperature … … 1656 1668 ENDIF 1657 1669 1658 IF ( bio_utci .OR. bio_utci_av ) THEN1670 IF ( do_calculate_utci .OR. do_calculate_utci_av ) THEN 1659 1671 ! 1660 1672 !-- Estimate local universal thermal climate index … … 1663 1675 ENDIF 1664 1676 1665 IF ( bio_pet .OR. bio_pet_av ) THEN1677 IF ( do_calculate_pet .OR. do_calculate_pet_av ) THEN 1666 1678 ! 1667 1679 !-- Estimate local physiologically equivalent temperature … … 1674 1686 ! 1675 1687 !-- Write results for selected averaged indices 1676 IF ( bio_perct_av ) THEN1688 IF ( do_calculate_perct_av ) THEN 1677 1689 perct_av(j, i) = perct_ij 1678 1690 END IF 1679 IF ( bio_utci_av ) THEN1691 IF ( do_calculate_utci_av ) THEN 1680 1692 utci_av(j, i) = utci_ij 1681 1693 END IF 1682 IF ( bio_pet_av ) THEN1694 IF ( do_calculate_pet_av ) THEN 1683 1695 pet_av(j, i) = pet_ij 1684 1696 END IF … … 1686 1698 ! 1687 1699 !-- Write result for selected indices 1688 IF ( bio_perct ) THEN1700 IF ( do_calculate_perct ) THEN 1689 1701 perct(j, i) = perct_ij 1690 1702 END IF 1691 IF ( bio_utci ) THEN1703 IF ( do_calculate_utci ) THEN 1692 1704 utci(j, i) = utci_ij 1693 1705 END IF 1694 IF ( bio_pet ) THEN1706 IF ( do_calculate_pet ) THEN 1695 1707 pet(j, i) = pet_ij 1696 1708 END IF -
palm/trunk/SOURCE/module_interface.f90
r3735 r3739 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Removed bio_check_parameters as the method is empty. 28 ! 29 ! 3735 2019-02-12 09:52:40Z dom_dwd_user 27 30 ! Accepting variable j from check_parameters and passing it to 28 31 ! bio_check_data_output … … 96 99 USE biometeorology_mod, & 97 100 ONLY: bio_parin, & 98 bio_check_parameters, &99 101 bio_check_data_output, & 100 102 bio_init, & … … 492 494 493 495 494 IF ( biometeorology ) CALL bio_check_parameters495 496 IF ( bulk_cloud_model ) CALL bcm_check_parameters 496 497 IF ( air_chemistry ) CALL chem_check_parameters -
palm/trunk/SOURCE/time_integration.f90
r3724 r3739 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Removed everything related to "time_bio_results" as this is never used. 28 ! 29 ! 3724 2019-02-06 16:28:23Z kanani 27 30 ! Correct double-used log_point_s unit 28 31 ! … … 460 463 461 464 USE biometeorology_mod, & 462 ONLY: bio_calculate_thermal_index_maps, time_bio_results,&465 ONLY: bio_calculate_thermal_index_maps, & 463 466 thermal_comfort, uvem_calc_exposure, uv_exposure 464 467 … … 1524 1527 IF ( thermal_comfort ) THEN 1525 1528 CALL bio_calculate_thermal_index_maps ( .FALSE. ) 1526 time_bio_results = time_since_reference_point1527 1529 ENDIF 1528 1530 !
Note: See TracChangeset
for help on using the changeset viewer.
