Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Changeset 3735 for palm


Ignore:
Timestamp:
Feb 12, 2019 9:52:40 AM (6 years ago)
Author:
dom_dwd_user
Message:

biometeorology_mod.f90:
(N) Fixed auto-setting of thermal index calculation flags by output as
originally proposed by resler.
(C) removed bio_pet and outher configuration variables.
(C) Updated namelist.
(B) Forcing initialization of tmrt_av_grid to avoid mysterious mrt
values at i==0, j==0

module_interface_mod.f90:
(C) Receiving parameter j (averaging 0==.F./1==.T.) in
module_interface_check_data_output from check_parameters.f90.
(C) Passing j to bio_check_parameters.

check_parameters.f90:
(C) Passing j to module_interface_check_data_output

Location:
palm/trunk/SOURCE
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/biometeorology_mod.f90

    r3711 r3735  
    2727! -----------------
    2828! $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
    2935! Introduced interface routine bio_init_checks + small error message changes
    3036!
    … …  
    184190
    185191    LOGICAL ::  thermal_comfort = .FALSE.  !< Turn all thermal indices on or off
    186     LOGICAL ::  bio_perct     = .TRUE.   !< Turn index PT (instant. input) on or off
    187     LOGICAL ::  bio_perct_av  = .TRUE.   !< Turn index PT (averaged input) on or off
    188     LOGICAL ::  bio_pet       = .TRUE.   !< Turn index PET (instant. input) on or off
    189     LOGICAL ::  bio_pet_av    = .TRUE.   !< Turn index PET (averaged input) on or off
    190     LOGICAL ::  bio_utci      = .TRUE.   !< Turn index UTCI (instant. input) on or off
    191     LOGICAL ::  bio_utci_av   = .TRUE.   !< Turn index UTCI (averaged input) 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
    192198
    193199!
    … …  
    248254    bio_check_parameters, bio_data_output_3d, bio_data_output_2d,              &
    249255    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,   &
    252257    bio_nmrtbl, bio_wrd_local, bio_rrd_local, bio_wrd_global, bio_rrd_global
    253258!
    … …  
    678683!> Check data output for biometeorology model
    679684!------------------------------------------------------------------------------!
    680  SUBROUTINE bio_check_data_output( var, unit, i, ilen, k )
     685 SUBROUTINE bio_check_data_output( var, unit, i, j, ilen, k )
    681686
    682687    USE control_parameters,                                                    &
    … …  
    689694
    690695    INTEGER(iwp) ::  i      !<
     696    INTEGER(iwp), INTENT(IN)  :: j   !< average quantity? 0 = no, 1 = yes
    691697    INTEGER(iwp) ::  ilen   !<   
    692698    INTEGER(iwp) ::  k      !<
    … …  
    708714       CASE ( 'bio_perct*' )
    709715          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
    717728          ENDIF
    718729
    719730       CASE ( 'bio_utci*' )
    720731          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
    728744          ENDIF
    729745
    730746       CASE ( 'bio_pet*' )
    731747          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
    739760          ENDIF
    740761
    … …  
    10341055               IF ( av == 0 )  THEN
    10351056                  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 )
    10401061                  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 )
    10431065                  ENDIF
    10441066               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 )
    10461068               ENDIF
    10471069            ENDDO
    … …  
    11681190!-- Init UVEM and load lookup tables
    11691191    IF ( uv_exposure )  CALL netcdf_data_input_uvem
    1170    
     1192
    11711193    CALL location_message( 'finished', .TRUE. )
    11721194
    … …  
    12081230    CHARACTER (LEN=80) ::  line  !< Dummy string for current line in parameter file
    12091231
    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
    12171234!
    12181235!-- UVEM namelist parameters
    … …  
    14351452          ALLOCATE( tmrt_av_grid (nys:nyn,nxl:nxr) )
    14361453       ENDIF
     1454       tmrt_av_grid = REAL( bio_fill_value, KIND = wp )
    14371455
    14381456       DO  l = 1, nmrtbl
    … …  
    14631481          j = mrtbl(iy,l)
    14641482          k = mrtbl(iz,l)
    1465           IF ( k - get_topography_top_index_ji( j, i, 's' ) == bio_cell_level +   &
    1466                 1_iwp) THEN
     1483          IF ( k - get_topography_top_index_ji( j, i, 's' ) ==                 &
     1484                bio_cell_level + 1_iwp) THEN
    14671485             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
    14711490             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
    14741494             ENDIF
    14751495          ENDIF
    … …  
    16171637!
    16181638!--       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,              &
    16201640                                                ws, pair, tmrt_ij )
    16211641!
    … …  
    16291649             clo = bio_fill_value
    16301650
    1631              IF ( bio_perct ) THEN
     1651             IF ( bio_perct .OR. bio_perct_av ) THEN
    16321652!
    16331653!--          Estimate local perceived temperature
    … …  
    16361656             ENDIF
    16371657
    1638              IF ( bio_utci ) THEN
     1658             IF ( bio_utci  .OR. bio_utci_av ) THEN
    16391659!
    16401660!--          Estimate local universal thermal climate index
    … …  
    16431663             ENDIF
    16441664
    1645              IF ( bio_pet ) THEN
     1665             IF ( bio_pet .OR. bio_pet_av ) THEN
    16461666!
    16471667!--          Estimate local physiologically equivalent temperature

  • palm/trunk/SOURCE/check_parameters.f90

    r3705 r3735  
    2525! -----------------
    2626! $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
    2731! bugfix: renamed thetav_t to vtheta_t
    2832!
    … …  
    31413145!
    31423146!--          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 )
    31443148
    31453149             IF ( unit == 'illegal' )  THEN

  • palm/trunk/SOURCE/module_interface.f90

    r3731 r3735  
    2020! Current revisions:
    2121! -----------------
    22 ! Add required restart data for surface output module
     22!
    2323!
    2424! Former revisions:
    2525! -----------------
    2626! $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
    2732! Add check_parameters routine for virtual measurements
    2833!
    … …  
    592597!> Check module-specific 2D and 3D data output
    593598!------------------------------------------------------------------------------!
    594 SUBROUTINE module_interface_check_data_output( variable, unit, i, ilen, k )
     599SUBROUTINE module_interface_check_data_output( variable, unit, i, j, ilen, k )
    595600
    596601
    … …  
    599604
    600605   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
    601607   INTEGER(iwp),      INTENT(IN)    :: ilen      !< ToDo: remove dummy argument, instead pass string from data_output
    602608   INTEGER(iwp),      INTENT(IN)    :: k         !< ToDo: remove dummy argument, instead pass string from data_output
    603609
    604610   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 )
    606612   ENDIF
    607613

  • palm/trunk/SOURCE/surface_data_output_mod.f90

    r3731 r3735  
    2020! Current revisions:
    2121! ------------------
     22!
     23!
     24! Former revisions:
     25! -----------------
     26! $Id$
    2227! - Split initialization into initialization of arrays and further initialization
    2328!   in order to enable reading of restart data.
    … …  
    2530! - Correct error message numbers
    2631!
    27 ! Former revisions:
    28 ! -----------------
    29 ! $Id$
     32! 3731 2019-02-11 13:06:27Z suehring
    3033! Bugfix: add cpp options
    3134!
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |