Changeset 3735 for palm/trunk
- Timestamp:
- Feb 12, 2019 9:52:40 AM (6 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 4 edited
-
biometeorology_mod.f90 (modified) (15 diffs)
-
check_parameters.f90 (modified) (2 diffs)
-
module_interface.f90 (modified) (3 diffs)
-
surface_data_output_mod.f90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/biometeorology_mod.f90
r3711 r3735 27 27 ! ----------------- 28 28 ! $Id$ 29 ! - Fixed auto-setting of thermal index calculation flags by output 30 ! as originally proposed by resler. 31 ! - removed bio_pet and outher configuration variables. 32 ! - Updated namelist. 33 ! 34 ! 3711 2019-01-31 13:44:26Z knoop 29 35 ! Introduced interface routine bio_init_checks + small error message changes 30 36 ! … … 184 190 185 191 LOGICAL :: thermal_comfort = .FALSE. !< Turn all thermal indices on or off 186 LOGICAL :: bio_perct = . TRUE. !< Turn index PT (instant. input) on or off187 LOGICAL :: bio_perct_av = . TRUE. !< Turn index PT (averaged input) on or off188 LOGICAL :: bio_pet = . TRUE. !< Turn index PET (instant. input) on or off189 LOGICAL :: bio_pet_av = . TRUE. !< Turn index PET (averaged input) on or off190 LOGICAL :: bio_utci = . TRUE. !< Turn index UTCI (instant. input) on or off191 LOGICAL :: bio_utci_av = . TRUE. !< Turn index UTCI (averaged input) on or off192 LOGICAL :: bio_perct = .FALSE. !< Turn index PT (instant. input) on or off 193 LOGICAL :: bio_perct_av = .FALSE. !< Turn index PT (averaged input) on or off 194 LOGICAL :: bio_pet = .FALSE. !< Turn index PET (instant. input) on or off 195 LOGICAL :: bio_pet_av = .FALSE. !< Turn index PET (averaged input) on or off 196 LOGICAL :: bio_utci = .FALSE. !< Turn index UTCI (instant. input) on or off 197 LOGICAL :: bio_utci_av = .FALSE. !< Turn index UTCI (averaged input) on or off 192 198 193 199 ! … … 248 254 bio_check_parameters, bio_data_output_3d, bio_data_output_2d, & 249 255 bio_define_netcdf_grid, bio_get_thermal_index_input_ij, bio_header, & 250 bio_init, bio_init_checks, bio_parin, bio_perct, bio_perct_av, bio_pet, & 251 bio_pet_av, bio_utci, bio_utci_av, thermal_comfort, time_bio_results, & 256 bio_init, bio_init_checks, bio_parin, thermal_comfort, time_bio_results, & 252 257 bio_nmrtbl, bio_wrd_local, bio_rrd_local, bio_wrd_global, bio_rrd_global 253 258 ! … … 678 683 !> Check data output for biometeorology model 679 684 !------------------------------------------------------------------------------! 680 SUBROUTINE bio_check_data_output( var, unit, i, ilen, k )685 SUBROUTINE bio_check_data_output( var, unit, i, j, ilen, k ) 681 686 682 687 USE control_parameters, & … … 689 694 690 695 INTEGER(iwp) :: i !< 696 INTEGER(iwp), INTENT(IN) :: j !< average quantity? 0 = no, 1 = yes 691 697 INTEGER(iwp) :: ilen !< 692 698 INTEGER(iwp) :: k !< … … 708 714 CASE ( 'bio_perct*' ) 709 715 unit = 'degree_C' 710 IF ( .NOT. ALLOCATED( perct ) ) THEN 711 ALLOCATE( perct (nys:nyn,nxl:nxr) ) 712 perct = REAL( bio_fill_value, KIND = wp ) 713 ENDIF 714 IF ( .NOT. ALLOCATED( perct_av ) ) THEN 715 ALLOCATE( perct_av (nys:nyn,nxl:nxr) ) 716 perct_av = REAL( bio_fill_value, KIND = wp ) 716 IF ( j == 0 ) THEN !< if instantaneous input 717 bio_perct = .TRUE. 718 IF ( .NOT. ALLOCATED( perct ) ) THEN 719 ALLOCATE( perct (nys:nyn,nxl:nxr) ) 720 perct = REAL( bio_fill_value, KIND = wp ) 721 ENDIF 722 ELSE !< if averaged input 723 bio_perct_av = .TRUE. 724 IF ( .NOT. ALLOCATED( perct_av ) ) THEN 725 ALLOCATE( perct_av (nys:nyn,nxl:nxr) ) 726 perct_av = REAL( bio_fill_value, KIND = wp ) 727 ENDIF 717 728 ENDIF 718 729 719 730 CASE ( 'bio_utci*' ) 720 731 unit = 'degree_C' 721 IF ( .NOT. ALLOCATED( utci ) ) THEN 722 ALLOCATE( utci (nys:nyn,nxl:nxr) ) 723 utci = REAL( bio_fill_value, KIND = wp ) 724 ENDIF 725 IF ( .NOT. ALLOCATED( utci_av ) ) THEN 726 ALLOCATE( utci_av (nys:nyn,nxl:nxr) ) 727 utci_av = REAL( bio_fill_value, KIND = wp ) 732 IF ( j == 0 ) THEN 733 bio_utci = .TRUE. 734 IF ( .NOT. ALLOCATED( utci ) ) THEN 735 ALLOCATE( utci (nys:nyn,nxl:nxr) ) 736 utci = REAL( bio_fill_value, KIND = wp ) 737 ENDIF 738 ELSE 739 bio_utci_av = .TRUE. 740 IF ( .NOT. ALLOCATED( utci_av ) ) THEN 741 ALLOCATE( utci_av (nys:nyn,nxl:nxr) ) 742 utci_av = REAL( bio_fill_value, KIND = wp ) 743 ENDIF 728 744 ENDIF 729 745 730 746 CASE ( 'bio_pet*' ) 731 747 unit = 'degree_C' 732 IF ( .NOT. ALLOCATED( pet ) ) THEN 733 ALLOCATE( pet (nys:nyn,nxl:nxr) ) 734 pet = REAL( bio_fill_value, KIND = wp ) 735 ENDIF 736 IF ( .NOT. ALLOCATED( pet_av ) ) THEN 737 ALLOCATE( pet_av (nys:nyn,nxl:nxr) ) 738 pet_av = REAL( bio_fill_value, KIND = wp ) 748 IF ( j == 0 ) THEN 749 bio_pet = .TRUE. 750 IF ( .NOT. ALLOCATED( pet ) ) THEN 751 ALLOCATE( pet (nys:nyn,nxl:nxr) ) 752 pet = REAL( bio_fill_value, KIND = wp ) 753 ENDIF 754 ELSE 755 bio_pet_av = .TRUE. 756 IF ( .NOT. ALLOCATED( pet_av ) ) THEN 757 ALLOCATE( pet_av (nys:nyn,nxl:nxr) ) 758 pet_av = REAL( bio_fill_value, KIND = wp ) 759 ENDIF 739 760 ENDIF 740 761 … … 1034 1055 IF ( av == 0 ) THEN 1035 1056 IF ( mrt_include_sw ) THEN 1036 local_pf(i,j,k) = REAL( ((human_absorb * mrtinsw(l) +&1037 human_emiss * mrtinlw(l) ) /&1038 ( human_emiss * sigma_sb)) ** .25_wp -&1039 degc_to_k, kind=sp )1057 local_pf(i,j,k) = REAL( ( ( human_absorb * mrtinsw(l) + & 1058 human_emiss * mrtinlw(l) ) / & 1059 ( human_emiss * sigma_sb ) ) ** .25_wp - & 1060 degc_to_k, KIND = sp ) 1040 1061 ELSE 1041 local_pf(i,j,k) = REAL((human_emiss * mrtinlw(l) / & 1042 sigma_sb) ** .25_wp - degc_to_k, kind=sp ) !< why not (human_emiss * sigma_sb) as above? 1062 local_pf(i,j,k) = REAL( ( ( human_emiss * mrtinlw(l) ) / & 1063 ( human_emiss * sigma_sb ) ) ** .25_wp - & 1064 degc_to_k, KIND = sp ) 1043 1065 ENDIF 1044 1066 ELSE 1045 local_pf(i,j,k) = REAL( mrt_av_grid(l), kind=sp)1067 local_pf(i,j,k) = REAL( mrt_av_grid(l), KIND = sp ) 1046 1068 ENDIF 1047 1069 ENDDO … … 1168 1190 !-- Init UVEM and load lookup tables 1169 1191 IF ( uv_exposure ) CALL netcdf_data_input_uvem 1170 1192 1171 1193 CALL location_message( 'finished', .TRUE. ) 1172 1194 … … 1208 1230 CHARACTER (LEN=80) :: line !< Dummy string for current line in parameter file 1209 1231 1210 NAMELIST /biometeorology_parameters/ bio_pet, & 1211 bio_pet_av, & 1212 bio_perct, & 1213 bio_perct_av, & 1214 bio_utci, & 1215 bio_utci_av, & 1216 thermal_comfort, & 1232 NAMELIST /biometeorology_parameters/ thermal_comfort, & 1233 1217 1234 ! 1218 1235 !-- UVEM namelist parameters … … 1435 1452 ALLOCATE( tmrt_av_grid (nys:nyn,nxl:nxr) ) 1436 1453 ENDIF 1454 tmrt_av_grid = REAL( bio_fill_value, KIND = wp ) 1437 1455 1438 1456 DO l = 1, nmrtbl … … 1463 1481 j = mrtbl(iy,l) 1464 1482 k = mrtbl(iz,l) 1465 IF ( k - get_topography_top_index_ji( j, i, 's' ) == bio_cell_level +&1466 1_iwp) THEN1483 IF ( k - get_topography_top_index_ji( j, i, 's' ) == & 1484 bio_cell_level + 1_iwp) THEN 1467 1485 IF ( mrt_include_sw ) THEN 1468 tmrt_grid(j,i) = ((human_absorb*mrtinsw(l) + & 1469 human_emiss*mrtinlw(l)) / & 1470 (human_emiss*sigma_sb)) ** .25_wp - degc_to_k 1486 tmrt_grid(j,i) = ( ( human_absorb * mrtinsw(l) + & 1487 human_emiss * mrtinlw(l) ) / & 1488 ( human_emiss * sigma_sb ) ) ** .25_wp - & 1489 degc_to_k 1471 1490 ELSE 1472 tmrt_grid(j,i) = (human_emiss*mrtinlw(l) / sigma_sb) ** .25_wp & 1473 - degc_to_k 1491 tmrt_grid(j,i) = ( ( human_emiss * mrtinlw(l) ) / & 1492 ( human_emiss * sigma_sb ) ) ** .25_wp - & 1493 degc_to_k 1474 1494 ENDIF 1475 1495 ENDIF … … 1617 1637 ! 1618 1638 !-- Determine input only if 1619 CALL bio_get_thermal_index_input_ij ( av, i, j, ta, vp, &1639 CALL bio_get_thermal_index_input_ij ( av, i, j, ta, vp, & 1620 1640 ws, pair, tmrt_ij ) 1621 1641 ! … … 1629 1649 clo = bio_fill_value 1630 1650 1631 IF ( bio_perct ) THEN1651 IF ( bio_perct .OR. bio_perct_av ) THEN 1632 1652 ! 1633 1653 !-- Estimate local perceived temperature … … 1636 1656 ENDIF 1637 1657 1638 IF ( bio_utci ) THEN1658 IF ( bio_utci .OR. bio_utci_av ) THEN 1639 1659 ! 1640 1660 !-- Estimate local universal thermal climate index … … 1643 1663 ENDIF 1644 1664 1645 IF ( bio_pet ) THEN1665 IF ( bio_pet .OR. bio_pet_av ) THEN 1646 1666 ! 1647 1667 !-- Estimate local physiologically equivalent temperature -
palm/trunk/SOURCE/check_parameters.f90
r3705 r3735 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Passing variable j (averaged output?) to 28 ! module_interface.f90:chem_check_data_output. 29 ! 30 ! 3705 2019-01-29 19:56:39Z suehring 27 31 ! bugfix: renamed thetav_t to vtheta_t 28 32 ! … … 3141 3145 ! 3142 3146 !-- Check for other modules 3143 CALL module_interface_check_data_output( var, unit, i, ilen, k )3147 CALL module_interface_check_data_output( var, unit, i, j, ilen, k ) 3144 3148 3145 3149 IF ( unit == 'illegal' ) THEN -
palm/trunk/SOURCE/module_interface.f90
r3731 r3735 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! Add required restart data for surface output module22 ! 23 23 ! 24 24 ! Former revisions: 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Accepting variable j from check_parameters and passing it to 28 ! bio_check_data_output 29 ! Add required restart data for surface output module 30 ! 31 ! 3731 2019-02-11 13:06:27Z suehring 27 32 ! Add check_parameters routine for virtual measurements 28 33 ! … … 592 597 !> Check module-specific 2D and 3D data output 593 598 !------------------------------------------------------------------------------! 594 SUBROUTINE module_interface_check_data_output( variable, unit, i, ilen, k )599 SUBROUTINE module_interface_check_data_output( variable, unit, i, j, ilen, k ) 595 600 596 601 … … 599 604 600 605 INTEGER(iwp), INTENT(IN) :: i !< ToDo: remove dummy argument, instead pass string from data_output 606 INTEGER(iwp), INTENT(IN) :: j !< average quantity? 0 = no, 1 = yes 601 607 INTEGER(iwp), INTENT(IN) :: ilen !< ToDo: remove dummy argument, instead pass string from data_output 602 608 INTEGER(iwp), INTENT(IN) :: k !< ToDo: remove dummy argument, instead pass string from data_output 603 609 604 610 IF ( unit == 'illegal' .AND. biometeorology ) THEN 605 CALL bio_check_data_output( variable, unit, i, ilen, k )611 CALL bio_check_data_output( variable, unit, i, j, ilen, k ) 606 612 ENDIF 607 613 -
palm/trunk/SOURCE/surface_data_output_mod.f90
r3731 r3735 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 23 ! 24 ! Former revisions: 25 ! ----------------- 26 ! $Id$ 22 27 ! - Split initialization into initialization of arrays and further initialization 23 28 ! in order to enable reading of restart data. … … 25 30 ! - Correct error message numbers 26 31 ! 27 ! Former revisions: 28 ! ----------------- 29 ! $Id$ 32 ! 3731 2019-02-11 13:06:27Z suehring 30 33 ! Bugfix: add cpp options 31 34 !
Note: See TracChangeset
for help on using the changeset viewer.
