Changeset 3739 for palm/trunk/SOURCE


Ignore:
Timestamp:
Feb 13, 2019 8:05:17 AM (3 years ago)
Author:
dom_dwd_user
Message:

biometeorology_mod.f90:
(N) Auto-adjusting thermal_comfort flag if not set by user, but thermal_indices set as output quantities.
(C) Renamed flags "bio_<index>" to "do_calculate_<index>" for better readability
(C) Removed everything related to "time_bio_results" as this is never used.
(C) Moved humidity warning to check_data_output so it will also be triggered if thermal_comofrt flag was auto-set later.
(B) Fixed bug in mrt calculation introduced with my commit yesterday.

time_integration.f90:
(C) Removed everything related to "time_bio_results" as this is never used

module_interface.f90:
(C) Removed call to empty method bio_check_parameters.

Location:
palm/trunk/SOURCE
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/biometeorology_mod.f90

    r3735 r3739  
    2727! -----------------
    2828! $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
    2937! - Fixed auto-setting of thermal index calculation flags by output
    3038!  as originally proposed by resler.
     
    173181    INTEGER( iwp ) ::  bio_cell_level     !< cell level biom calculates for
    174182    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 for
    176183    REAL ( wp ), PARAMETER ::  human_absorb = 0.7_wp  !< SW absorbtivity of a human body (Fanger 1972)
    177184    REAL ( wp ), PARAMETER ::  human_emiss = 0.97_wp  !< LW emissivity of a human body after (Fanger 1972)
     
    189196    LOGICAL ::  average_trigger_pet   = .FALSE.  !< update averaged input on call to bio_pet?
    190197
    191     LOGICAL ::  thermal_comfort = .FALSE.  !< Turn all thermal indices on or off
    192     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
     198    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
    198205
    199206!
     
    254261    bio_check_parameters, bio_data_output_3d, bio_data_output_2d,              &
    255262    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,                     &
    257264    bio_nmrtbl, bio_wrd_local, bio_rrd_local, bio_wrd_global, bio_rrd_global
    258265!
     
    486493                IF ( mrt_include_sw )  THEN
    487494                   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
    490498                ELSE
    491499                   mrt_av_grid(:) = mrt_av_grid(:) +                           &
    492                       (human_emiss * mrtinlw(:) / sigma_sb) ** .25_wp          &
    493                       - degc_to_k
     500                      ( mrtinlw(:) /                             &  ! ( human_emiss * mrtinlw(:) /
     501                      ( human_emiss * sigma_sb ) ) ** .25_wp - degc_to_k
    494502                ENDIF
    495503             ENDIF
     
    559567                IF ( mrt_include_sw )  THEN
    560568                   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
    563572                ELSE
    564573                   mrt_av_grid(:) = mrt_av_grid(:) +                           &
    565                       (human_emiss * mrtinlw(:) / sigma_sb) ** .25_wp          &
    566                       - degc_to_k
     574                      ( mrtinlw(:) /                             &  ! ( human_emiss * mrtinlw(:) /
     575                      ( human_emiss * sigma_sb ) ) ** .25_wp - degc_to_k
    567576                ENDIF
    568577             ENDIF
     
    693702    CHARACTER (LEN=*) ::  var      !< The variable in question
    694703
    695     INTEGER(iwp) ::  i      !<
    696     INTEGER(iwp), INTENT(IN)  :: j   !< average quantity? 0 = no, 1 = yes
    697     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
    699708
    700709    SELECT CASE ( TRIM( var ) )
     
    707716       CASE ( 'bio_mrt' )
    708717          unit = 'degree_C'
     718          thermal_comfort = .TRUE.  !< enable thermal_comfort if user forgot to do so
    709719          IF ( .NOT. ALLOCATED( tmrt_grid ) )  THEN
    710720             ALLOCATE( tmrt_grid (nys:nyn,nxl:nxr) )
     
    714724       CASE ( 'bio_perct*' )
    715725          unit = 'degree_C'
     726          thermal_comfort = .TRUE.
    716727          IF ( j == 0 ) THEN                !< if instantaneous input
    717              bio_perct = .TRUE.
     728             do_calculate_perct = .TRUE.
    718729             IF ( .NOT. ALLOCATED( perct ) )  THEN
    719730                ALLOCATE( perct (nys:nyn,nxl:nxr) )
     
    721732             ENDIF
    722733          ELSE                              !< if averaged input
    723              bio_perct_av = .TRUE.
     734             do_calculate_perct_av = .TRUE.
    724735             IF ( .NOT. ALLOCATED( perct_av ) )  THEN
    725736                ALLOCATE( perct_av (nys:nyn,nxl:nxr) )
     
    730741       CASE ( 'bio_utci*' )
    731742          unit = 'degree_C'
     743          thermal_comfort = .TRUE.
    732744          IF ( j == 0 ) THEN
    733              bio_utci = .TRUE.
     745             do_calculate_utci = .TRUE.
    734746             IF ( .NOT. ALLOCATED( utci ) )  THEN
    735747                ALLOCATE( utci (nys:nyn,nxl:nxr) )
     
    737749             ENDIF
    738750          ELSE
    739              bio_utci_av = .TRUE.
     751             do_calculate_utci_av = .TRUE.
    740752             IF ( .NOT. ALLOCATED( utci_av ) )  THEN
    741753                ALLOCATE( utci_av (nys:nyn,nxl:nxr) )
     
    746758       CASE ( 'bio_pet*' )
    747759          unit = 'degree_C'
     760          thermal_comfort = .TRUE.
    748761          IF ( j == 0 ) THEN
    749              bio_pet = .TRUE.
     762             do_calculate_pet = .TRUE.
    750763             IF ( .NOT. ALLOCATED( pet ) )  THEN
    751764                ALLOCATE( pet (nys:nyn,nxl:nxr) )
     
    753766             ENDIF
    754767          ELSE
    755              bio_pet_av = .TRUE.
     768             do_calculate_pet_av = .TRUE.
    756769             IF ( .NOT. ALLOCATED( pet_av ) )  THEN
    757770                ALLOCATE( pet_av (nys:nyn,nxl:nxr) )
     
    812825          unit = 'illegal'
    813826       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
    814834       IF ( mrt_nlevels == 0 ) THEN
    815835          message_string = 'output of "' // TRIM( var ) // '" require'         &
     
    838858    IMPLICIT NONE
    839859
    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
    849861
    850862 END SUBROUTINE bio_check_parameters
     
    904916              IF ( av == 0 )  THEN
    905917                 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
    909922                 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
    912926                 ENDIF
    913927              ELSE
     
    10561070                  IF ( mrt_include_sw )  THEN
    10571071                     local_pf(i,j,k) = REAL( ( ( human_absorb * mrtinsw(l) +   &
    1058                                     human_emiss * mrtinlw(l) ) /               &
     1072                                    mrtinlw(l) ) /               &  ! human_emiss * mrtinlw(l) ) /
    10591073                                    ( human_emiss * sigma_sb ) ) ** .25_wp -   &
    10601074                                    degc_to_k, KIND = sp )
    10611075                  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) ) /
    10631077                                    ( human_emiss * sigma_sb ) ) ** .25_wp -   &
    10641078                                    degc_to_k, KIND = sp )
     
    11791193!   (gravimetric center of sample human)
    11801194
    1181     time_bio_results = 0.0_wp
    11821195    bio_cell_level = 0_iwp
    11831196    bio_output_height = 0.5_wp * dz(1)
     
    14671480
    14681481    ELSE
    1469 
    14701482!
    14711483!-- Calculate biometeorology MRT from local radiation fluxes calculated by RTM and assign
     
    14851497             IF ( mrt_include_sw )  THEN
    14861498                 tmrt_grid(j,i) = ( ( human_absorb * mrtinsw(l) +              &
    1487                                   human_emiss * mrtinlw(l) )  /                &
     1499                                  mrtinlw(l) )  /                &  ! human_emiss * mrtinlw(l) )  /
    14881500                                  ( human_emiss * sigma_sb ) ) ** .25_wp -     &
    14891501                                  degc_to_k
    14901502             ELSE
    1491                  tmrt_grid(j,i) = ( ( human_emiss * mrtinlw(l) )  /            &
     1503                 tmrt_grid(j,i) = ( mrtinlw(l)  /            &  ! ( ( human_emiss * mrtinlw(l) )  /
    14921504                                  ( human_emiss * sigma_sb ) ) ** .25_wp -     &
    14931505                                  degc_to_k
     
    16491661             clo = bio_fill_value
    16501662
    1651              IF ( bio_perct .OR. bio_perct_av ) THEN
     1663             IF ( do_calculate_perct .OR. do_calculate_perct_av ) THEN
    16521664!
    16531665!--          Estimate local perceived temperature
     
    16561668             ENDIF
    16571669
    1658              IF ( bio_utci  .OR. bio_utci_av ) THEN
     1670             IF ( do_calculate_utci  .OR. do_calculate_utci_av ) THEN
    16591671!
    16601672!--          Estimate local universal thermal climate index
     
    16631675             ENDIF
    16641676
    1665              IF ( bio_pet .OR. bio_pet_av ) THEN
     1677             IF ( do_calculate_pet .OR. do_calculate_pet_av ) THEN
    16661678!
    16671679!--          Estimate local physiologically equivalent temperature
     
    16741686!
    16751687!--          Write results for selected averaged indices
    1676              IF ( bio_perct_av )  THEN
     1688             IF ( do_calculate_perct_av )  THEN
    16771689                perct_av(j, i) = perct_ij
    16781690             END IF
    1679              IF ( bio_utci_av ) THEN
     1691             IF ( do_calculate_utci_av ) THEN
    16801692                utci_av(j, i) = utci_ij
    16811693             END IF
    1682              IF ( bio_pet_av ) THEN
     1694             IF ( do_calculate_pet_av ) THEN
    16831695                pet_av(j, i)  = pet_ij
    16841696             END IF
     
    16861698!
    16871699!--          Write result for selected indices
    1688              IF ( bio_perct )  THEN
     1700             IF ( do_calculate_perct )  THEN
    16891701                perct(j, i) = perct_ij
    16901702             END IF
    1691              IF ( bio_utci ) THEN
     1703             IF ( do_calculate_utci ) THEN
    16921704                utci(j, i) = utci_ij
    16931705             END IF
    1694              IF ( bio_pet ) THEN
     1706             IF ( do_calculate_pet ) THEN
    16951707                pet(j, i)  = pet_ij
    16961708             END IF
  • palm/trunk/SOURCE/module_interface.f90

    r3735 r3739  
    2525! -----------------
    2626! $Id$
     27! Removed bio_check_parameters as the method is empty.
     28!
     29! 3735 2019-02-12 09:52:40Z dom_dwd_user
    2730! Accepting variable j from check_parameters and passing it to
    2831! bio_check_data_output
     
    9699   USE biometeorology_mod,                                                     &
    97100       ONLY:  bio_parin,                                                       &
    98               bio_check_parameters,                                            &
    99101              bio_check_data_output,                                           &
    100102              bio_init,                                                        &
     
    492494
    493495
    494    IF ( biometeorology )       CALL bio_check_parameters
    495496   IF ( bulk_cloud_model )     CALL bcm_check_parameters
    496497   IF ( air_chemistry )        CALL chem_check_parameters
  • palm/trunk/SOURCE/time_integration.f90

    r3724 r3739  
    2525! -----------------
    2626! $Id$
     27! Removed everything related to "time_bio_results" as this is never used.
     28!
     29! 3724 2019-02-06 16:28:23Z kanani
    2730! Correct double-used log_point_s unit
    2831!
     
    460463
    461464    USE biometeorology_mod,                                                    &
    462         ONLY:  bio_calculate_thermal_index_maps, time_bio_results,             &
     465        ONLY:  bio_calculate_thermal_index_maps,                               &
    463466               thermal_comfort, uvem_calc_exposure, uv_exposure
    464467
     
    15241527          IF ( thermal_comfort )  THEN
    15251528             CALL bio_calculate_thermal_index_maps ( .FALSE. )
    1526              time_bio_results = time_since_reference_point
    15271529          ENDIF
    15281530!
Note: See TracChangeset for help on using the changeset viewer.