Changeset 4540 for palm

Timestamp:

May 18, 2020 3:23:29 PM (4 years ago)

Author:

raasch

Message:

files re-formatted to follow the PALM coding standard

Location:

palm/trunk/SOURCE

Files:

• biometeorology_mod.f90 (modified) (195 diffs)
• time_integration_spinup.f90 (modified) (26 diffs)
• time_to_string.f90 (modified) (5 diffs)
• timestep.f90 (modified) (18 diffs)
• timestep_scheme_steering.f90 (modified) (5 diffs)
• transpose.f90 (modified) (33 diffs)

palm/trunk/SOURCE/biometeorology_mod.f90

@@ -1 +1 @@
 !> @file biometeorology_mod.f90
-!--------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! This file is part of PALM-4U.
 !
-! PALM-4U is free software: you can redistribute it and/or modify it under the
-! terms of the GNU General Public License as published by the Free Software
-! Foundation, either version 3 of the License, or (at your option) any later
-! version.
-!
-! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
+! PALM-4U is free software: You can redistribute it and/or modify it under the terms of the GNU
+! General Public License as published by the Free Software Foundation, either version 3 of the
+! License, or (at your option) any later version.
+!
+! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even
+! the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
+! Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with PALM. If not, see
+! <http://www.gnu.org/licenses/>.
 !
 ! Copyright 2018-2020 Deutscher Wetterdienst (DWD)
 ! Copyright 2018-2020 Institute of Computer Science, Academy of Sciences, Prague
 ! Copyright 2018-2020 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 !
 ! Current revisions:
@@ -27 +26 @@
 ! -----------------
 ! $Id$
+! file re-formatted to follow the PALM coding standard
+!
+! 4535 2020-05-15 12:07:23Z raasch
 ! bugfix for restart data format query
-! 
+!
 ! 4517 2020-05-03 14:29:30Z raasch
 ! added restart with MPI-IO for reading local arrays
-! 
+!
 ! 4495 2020-04-13 20:11:20Z raasch
 ! restart data handling with MPI-IO added
-! 
+!
 ! 4493 2020-04-10 09:49:43Z pavelkrc
 ! Revise bad formatting
-! 
+!
 ! 4286 2019-10-30 16:01:14Z resler
 ! implement new palm_date_time_mod
-! 
+!
 ! 4223 2019-09-10 09:20:47Z gronemeier
 ! Corrected "Former revisions" section
-! 
+!
 ! 4168 2019-08-16 13:50:17Z suehring
 ! Replace function get_topography_top_index by topo_top_ind
-! 
+!
 ! 4144 2019-08-06 09:11:47Z raasch
 ! relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
-! 
+!
 ! 4127 2019-07-30 14:47:10Z suehring
 ! Output for bio_mrt added (merge from branch resler)
-! 
+!
 ! 4126 2019-07-30 11:09:11Z gronemeier
 ! renamed vitd3_exposure_av into vitd3_dose,
 ! renamed uvem_calc_exposure into bio_calculate_uv_exposure
-! 
+!
 ! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction 
-! of additional debug messages
-! 
+! Changes related to global restructuring of location messages and introduction of additional debug
+! messages
+!
 ! 3753 2019-02-19 14:48:54Z dom_dwd_user
-! - Added automatic setting of mrt_nlevels in case it was not part of 
-! radiation_parameters namelist (or set to 0 accidentially).
+! - Added automatic setting of mrt_nlevels in case it was not part of radiation_parameters namelist
+!   (or set to 0 accidentially).
 ! - Minor speed improvoemnts in perceived temperature calculations.
 ! - Perceived temperature regression arrays now declared as PARAMETERs.
-! 
+!
 ! 3750 2019-02-19 07:29:39Z dom_dwd_user
 ! - Added addittional safety meassures to bio_calculate_thermal_index_maps.
 ! - Replaced several REAL (un-)equality comparisons.
-! 
+!
 ! 3742 2019-02-14 11:25:22Z dom_dwd_user
-! - Allocation of the input _av grids was moved to the "sum" section of
-! bio_3d_data_averaging to make sure averaging is only done once!
-! - Moved call of bio_calculate_thermal_index_maps from biometeorology module to
-! time_integration to make sure averaged input is updated before calculating.
-! 
+! - Allocation of the input _av grids was moved to the "sum" section of bio_3d_data_averaging to
+!   make sure averaging is only done once!
+! - Moved call of bio_calculate_thermal_index_maps from biometeorology module to time_integration to
+!   make sure averaged input is updated before calculating.
+!
 ! 3740 2019-02-13 12:35:12Z dom_dwd_user
-! - Added safety-meassure to catch the case that 'bio_mrt_av' is stated after
-! 'bio_<index>' in the output section of the p3d file.
-! 
+! - Added safety-meassure to catch the case that 'bio_mrt_av' is stated after 'bio_<index>' in the
+!   output section of the p3d file.
+!
 ! 3739 2019-02-13 08:05:17Z dom_dwd_user
-! - Auto-adjusting thermal_comfort flag if not set by user, but thermal_indices
-! set as output quantities.
+! - Auto-adjusting thermal_comfort flag if not set by user, but thermal_indices set as output
+!   quantities.
 ! - Renamed flags "bio_<index>" to "do_calculate_<index>" for better readability
 ! - Removed everything related to "time_bio_results" as this is never used.
-! - Moved humidity warning to check_data_output
+! - Moved humidity warning to check_data_output.
 ! - Fixed bug in mrt calculation introduced with my commit yesterday.
-! 
+!
 ! 3735 2019-02-12 09:52:40Z dom_dwd_user
-! - Fixed auto-setting of thermal index calculation flags by output
-!  as originally proposed by resler.
+! - Fixed auto-setting of thermal index calculation flags by output as originally proposed by
+!   resler.
 ! - removed bio_pet and outher configuration variables.
 ! - Updated namelist.
-! 
+!
 ! 3711 2019-01-31 13:44:26Z knoop
 ! Introduced interface routine bio_init_checks + small error message changes
-! 
+!
 ! 3693 2019-01-23 15:20:53Z dom_dwd_user
-! Added usage of time_averaged mean radiant temperature, together with calculation, 
-! grid and restart routines. General cleanup and commenting.
-! 
+! Added usage of time_averaged mean radiant temperature, together with calculation, grid and restart
+! routines. General cleanup and commenting.
+!
 ! 3685 2019-01-21 01:02:11Z knoop
 ! Some interface calls moved to module_interface + cleanup
-! 
+!
 ! 3650 2019-01-04 13:01:33Z kanani
 ! Bugfixes and additions for enabling restarts with biometeorology
-! 
+!
 ! 3448 2018-10-29 18:14:31Z kanani
 ! Initial revision
 !
-! 
+!
 !
 ! Authors:
@@ -123 +125 @@
 ! ------------
 !> Biometeorology module consisting of two parts:
-!> 1.: Human thermal comfort module calculating thermal perception of a sample
-!> human being under the current meteorological conditions.
+!> 1.: Human thermal comfort module calculating thermal perception of a sample human being under the
+!> current meteorological conditions.
 !> 2.: Calculation of vitamin-D weighted UV exposure
 !>
 !> @todo Alphabetical sorting of "USE ..." lists, "ONLY" list, variable declarations
 !>       (per subroutine: first all CHARACTERs, then INTEGERs, LOGICALs, REALs, )
-!> @todo Comments start with capital letter --> "!-- Include..." 
+!> @todo Comments start with capital letter --> "!-- Include..."
 !> @todo uv_vitd3dose-->new output type necessary (cumulative)
 !> @todo consider upwelling radiation in UV
@@ -136 +138 @@
 !>
 !> @bug  no known bugs by now
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  MODULE biometeorology_mod
 
-    USE arrays_3d,                                                             &
+    USE arrays_3d,                                                                                 &
         ONLY:  pt, p, u, v, w, q
 
-    USE averaging,                                                             &
+    USE averaging,                                                                                 &
         ONLY:  pt_av, q_av, u_av, v_av, w_av
 
-    USE basic_constants_and_equations_mod,                                     &
-        ONLY:  c_p, degc_to_k, l_v, magnus, sigma_sb, pi
-
-    USE control_parameters,                                                    &
-        ONLY:  average_count_3d, biometeorology,                               &
-               debug_output,                                                   &
-               dz, dz_stretch_factor,                                          &
-               dz_stretch_level, humidity, initializing_actions, nz_do3d,      &
+    USE basic_constants_and_equations_mod,                                                         &
+        ONLY: degc_to_k, c_p, l_v, magnus, pi, sigma_sb
+
+    USE control_parameters,                                                                        &
+        ONLY:  average_count_3d, biometeorology,                                                   &
+               debug_output,                                                                       &
+               dz, dz_stretch_factor,                                                              &
+               dz_stretch_level, humidity, initializing_actions, nz_do3d,                          &
                restart_data_format_output, surface_pressure
 
-    USE grid_variables,                                                        &
+    USE grid_variables,                                                                            &
         ONLY:  ddx, dx, ddy, dy
 
-    USE indices,                                                               &
-        ONLY:  nxl, nxr, nys, nyn, nzb, nzt, nys, nyn, nxl, nxr, nxlg, nxrg,   &
-               nysg, nyng, topo_top_ind
+    USE indices,                                                                                   &
+        ONLY:  nxl, nxr, nys, nyn, nzb, nzt, nys, nyn, nxl, nxr, nxlg, nxrg, nysg, nyng,           &
+               topo_top_ind
 
     USE kinds  !< Set precision of INTEGER and REAL arrays according to PALM
 
-    USE netcdf_data_input_mod,                                                 &
-        ONLY:  netcdf_data_input_uvem, uvem_projarea_f, uvem_radiance_f,       &
-               uvem_irradiance_f, uvem_integration_f, building_obstruction_f
-
-    USE palm_date_time_mod,                                                    &
+    USE netcdf_data_input_mod,                                                                     &
+        ONLY: building_obstruction_f, netcdf_data_input_uvem, uvem_integration_f,                  &
+              uvem_irradiance_f, uvem_projarea_f, uvem_radiance_f
+
+    USE palm_date_time_mod,                                                                        &
         ONLY:  get_date_time
 !
 !-- Import radiation model to obtain input for mean radiant temperature
-    USE radiation_model_mod,                                                   &
-        ONLY:  ix, iy, iz, id, mrt_nlevels, mrt_include_sw,                    &
-               mrtinsw, mrtinlw, mrtbl, nmrtbl, radiation,                     &
-               radiation_interactions, rad_sw_in,                              &
-               rad_sw_out, rad_lw_in, rad_lw_out
+    USE radiation_model_mod,                                                                       &
+        ONLY:  id, ix, iy, iz, mrt_include_sw, mrt_nlevels,                                        &
+               mrtbl, mrtinlw, mrtinsw, nmrtbl, radiation,                                         &
+               rad_lw_in, rad_lw_out, rad_sw_in, rad_sw_out, radiation_interactions
 
     USE restart_data_mpi_io_mod,                                                                   &
@@ -184 +185 @@
     IMPLICIT NONE
 
-    PRIVATE
-
 !
 !-- Declare all global variables within the module (alphabetical order)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tmrt_grid  !< tmrt results (degree_C)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  perct      !< PT results   (degree_C)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  utci       !< UTCI results (degree_C)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pet        !< PET results  (degree_C)
-!
-!-- Grids for averaged thermal indices
-    REAL(wp), DIMENSION(:), ALLOCATABLE   ::  mrt_av_grid   !< time average mean
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tmrt_av_grid  !< tmrt results (degree_C)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  perct_av      !< PT results (aver. input)   (degree_C)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  utci_av       !< UTCI results (aver. input) (degree_C)
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pet_av        !< PET results (aver. input)  (degree_C)
-
-
-    INTEGER( iwp ) ::  bio_cell_level     !< cell level biom calculates for
-    REAL ( wp )    ::  bio_output_height  !< height output is calculated in m
-    REAL ( wp ), PARAMETER ::  human_absorb = 0.7_wp  !< SW absorbtivity of a human body (Fanger 1972)
-    REAL ( wp ), PARAMETER ::  human_emiss = 0.97_wp  !< LW emissivity of a human body after (Fanger 1972)
-    REAL ( wp ), PARAMETER ::  bio_fill_value = -9999._wp  !< set module fill value, replace by global fill value as soon as available
-!
-!--
-    LOGICAL ::  thermal_comfort  = .FALSE.  !< Enables or disables the entire thermal comfort part
-    LOGICAL ::  do_average_theta = .FALSE.  !< switch: do theta averaging in this module? (if .FALSE. this is done globally)
-    LOGICAL ::  do_average_q     = .FALSE.  !< switch: do e averaging in this module?
-    LOGICAL ::  do_average_u     = .FALSE.  !< switch: do u averaging in this module?
-    LOGICAL ::  do_average_v     = .FALSE.  !< switch: do v averaging in this module?
-    LOGICAL ::  do_average_w     = .FALSE.  !< switch: do w averaging in this module?
-    LOGICAL ::  do_average_mrt   = .FALSE.  !< switch: do mrt averaging in this module?
+    INTEGER(iwp) ::  bio_cell_level     !< cell level biom calculates for
+
+    LOGICAL ::  thermal_comfort        = .FALSE.  !< Enables or disables the entire thermal comfort part
+    LOGICAL ::  do_average_theta       = .FALSE.  !< switch: do theta averaging in this module? (if .FALSE. this is done globally)
+    LOGICAL ::  do_average_q           = .FALSE.  !< switch: do e averaging in this module?
+    LOGICAL ::  do_average_u           = .FALSE.  !< switch: do u averaging in this module?
+    LOGICAL ::  do_average_v           = .FALSE.  !< switch: do v averaging in this module?
+    LOGICAL ::  do_average_w           = .FALSE.  !< switch: do w averaging in this module?
+    LOGICAL ::  do_average_mrt         = .FALSE.  !< switch: do mrt averaging in this module?
     LOGICAL ::  average_trigger_perct  = .FALSE.  !< update averaged input on call to bio_perct?
     LOGICAL ::  average_trigger_utci   = .FALSE.  !< update averaged input on call to bio_utci?
@@ -227 +208 @@
     LOGICAL ::  do_calculate_mrt2d     = .FALSE.  !< Turn index MRT 2D (averaged or inst) on or off
 
+    REAL(wp)    ::  bio_output_height  !< height output is calculated in m
+
+    REAL(wp), PARAMETER ::  bio_fill_value = -9999.0_wp  !< set module fill value, replace by global fill value as soon as available
+    REAL(wp), PARAMETER ::  human_absorb = 0.7_wp  !< SW absorbtivity of a human body (Fanger 1972)
+    REAL(wp), PARAMETER ::  human_emiss = 0.97_wp  !< LW emissivity of a human body after (Fanger 1972)
+
+    REAL(wp), DIMENSION(:), ALLOCATABLE   ::  mrt_av_grid   !< time average mean
+
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  perct      !< PT results   (degree_C)
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pet        !< PET results  (degree_C)
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tmrt_grid  !< tmrt results (degree_C)
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  utci       !< UTCI results (degree_C)
+!
+!-- Grids for averaged thermal indices
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  perct_av      !< PT results (aver. input)   (degree_C)
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pet_av        !< PET results (aver. input)  (degree_C)
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tmrt_av_grid  !< tmrt results (degree_C)
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  utci_av       !< UTCI results (aver. input) (degree_C)
+
 !
 !-- UVEM parameters from here
-!
-!-- Declare all global variables within the module (alphabetical order)
-    INTEGER(iwp) ::  bio_nmrtbl
     INTEGER(iwp) ::  ai                      = 0  !< loop index in azimuth direction
     INTEGER(iwp) ::  bi                      = 0  !< loop index of bit location within an 8bit-integer (one Byte)
+    INTEGER(iwp) ::  bio_nmrtbl
     INTEGER(iwp) ::  clothing                = 1  !< clothing (0=unclothed, 1=Arms,Hands,Face free, 3=Hand,Face free)
     INTEGER(iwp) ::  iq                      = 0  !< loop index of irradiance quantity
     INTEGER(iwp) ::  pobi                    = 0  !< loop index of the position of corresponding byte within ibset byte vektor
-    INTEGER(iwp) ::  obstruction_direct_beam = 0  !< Obstruction information for direct beam    
+    INTEGER(iwp) ::  obstruction_direct_beam = 0  !< Obstruction information for direct beam
     INTEGER(iwp) ::  zi                      = 0  !< loop index in zenith direction
 
-    INTEGER(KIND=1), DIMENSION(0:44)  ::  obstruction_temp1 = 0  !< temporary obstruction information stored with ibset 
+    INTEGER(KIND=1), DIMENSION(0:44)  ::  obstruction_temp1 = 0  !< temporary obstruction information stored with ibset
     INTEGER(iwp),    DIMENSION(0:359) ::  obstruction_temp2 = 0  !< restored temporary obstruction information from ibset file
 
@@ -251 +249 @@
 
     REAL(wp) ::  diffuse_exposure            =   0.0_wp  !< calculated exposure by diffuse radiation
-    REAL(wp) ::  direct_exposure             =   0.0_wp  !< calculated exposure by direct solar beam   
-    REAL(wp) ::  orientation_angle           =   0.0_wp  !< orientation of front/face of the human model    
+    REAL(wp) ::  direct_exposure             =   0.0_wp  !< calculated exposure by direct solar beam
+    REAL(wp) ::  orientation_angle           =   0.0_wp  !< orientation of front/face of the human model
     REAL(wp) ::  projection_area_direct_beam =   0.0_wp  !< projection area for direct solar beam
     REAL(wp) ::  saa                         = 180.0_wp  !< solar azimuth angle
@@ -261 +259 @@
     REAL(wp) ::  yfactor                     =   0.0_wp  !< relative y-position used for interpolation
 
-    REAL(wp), DIMENSION(0:2)  ::  irradiance =   0.0_wp  !< iradiance values extracted from irradiance lookup table  
+    REAL(wp), DIMENSION(0:2)  ::  irradiance =   0.0_wp  !< iradiance values extracted from irradiance lookup table
 
     REAL(wp), DIMENSION(0:2,0:90) ::  irradiance_lookup_table      = 0.0_wp  !< irradiance lookup table
@@ -269 +267 @@
     REAL(wp), DIMENSION(0:71,0:9) ::  projection_area_direct_temp  = 0.0_wp  !< temporary projection area for direct solar beam
     REAL(wp), DIMENSION(0:71,0:9) ::  projection_area_temp         = 0.0_wp  !< temporary projection area for all directions
-    REAL(wp), DIMENSION(0:35,0:9) ::  radiance_array               = 0.0_wp  !< radiance extracted from radiance_lookup_table  
+    REAL(wp), DIMENSION(0:35,0:9) ::  radiance_array               = 0.0_wp  !< radiance extracted from radiance_lookup_table
     REAL(wp), DIMENSION(0:71,0:9) ::  radiance_array_temp          = 0.0_wp  !< temporary radiance data
 
@@ -277 +275 @@
     REAL(wp), DIMENSION(0:35,0:9,0:90) ::  radiance_lookup_table   = 0.0_wp  !< radiance lookup table
 
+
+    PRIVATE
+
 !
 !-- INTERFACES that must be available to other modules (alphabetical order)
-
-    PUBLIC bio_3d_data_averaging, bio_check_data_output,                       &
-    bio_calculate_mrt_grid, bio_calculate_thermal_index_maps, bio_calc_ipt,    &
-    bio_check_parameters, bio_data_output_3d, bio_data_output_2d,              &
-    bio_define_netcdf_grid, bio_get_thermal_index_input_ij, bio_header,        &
-    bio_init, bio_init_checks, bio_parin, thermal_comfort,                     &
-    bio_nmrtbl, bio_wrd_local, bio_rrd_local, bio_wrd_global, bio_rrd_global
+    PUBLIC bio_3d_data_averaging,  bio_calculate_mrt_grid, bio_calculate_thermal_index_maps,       &
+           bio_calc_ipt, bio_check_data_output, bio_check_parameters,                              &
+           bio_data_output_2d, bio_data_output_3d,  bio_define_netcdf_grid,                        &
+           bio_get_thermal_index_input_ij, bio_header, bio_init, bio_init_checks, bio_nmrtbl,      &
+           bio_parin, bio_rrd_global, bio_rrd_local, bio_wrd_global, bio_wrd_local, thermal_comfort
 !
 !-- UVEM PUBLIC variables and methods
@@ -348 +347 @@
     END INTERFACE bio_header
 !
-!-- Initialization actions 
+!-- Initialization actions
     INTERFACE bio_init
        MODULE PROCEDURE bio_init
@@ -393 +392 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Sum up and time-average biom input quantities as well as allocate
-!> the array necessary for storing the average.
-!> There is a considerable difference to the 3d_data_averaging subroutines
-!> used by other modules:
-!> For the thermal indices, the module needs to average the input conditions
-!> not the result!
-!------------------------------------------------------------------------------!
+!> Sum up and time-average biom input quantities as well as allocate the array necessary for storing
+!> the average.
+!> There is a considerable difference to the 3d_data_averaging subroutines used by other modules:
+!> For the thermal indices, the module needs to average the input conditions, not the result!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_3d_data_averaging( mode, variable )
 
     IMPLICIT NONE
 
-    CHARACTER (LEN=*) ::  mode     !< averaging mode: allocate, sum, or average
+    CHARACTER (LEN=*) ::  mode     !< Averaging mode: allocate, sum, or average
     CHARACTER (LEN=*) ::  variable !< The variable in question
 
@@ -425 +422 @@
                 ENDIF
                 mrt_av_grid = 0.0_wp
-                do_average_mrt = .FALSE.  !< overwrite if that was enabled somehow
+                do_average_mrt = .FALSE.  !< Overwrite if that was enabled somehow
 
 
@@ -431 +428 @@
 
 !
-!--          Averaging, as well as the allocation of the required grids must be
-!--          done only once, independent from for how many thermal indices 
-!--          averaged output is desired.
-!--          Therefore wee need to memorize which index is the one that controls
-!--          the averaging (what must be the first thermal index called).
-!--          Indices are in unknown order as depending on the input file,
-!--          determine first index to average und update only once
-!
-!--          Only proceed here if this was not done for any index before. This
-!--          is done only once during the whole model run.
-             IF ( .NOT. average_trigger_perct  .AND.                           &
-                  .NOT. average_trigger_utci   .AND.                           &
-                  .NOT. average_trigger_pet    .AND.                           &
+!--          Averaging, as well as the allocation of the required grids must be done only once,
+!--          independent of for how many thermal indices averaged output is desired.
+!--          Therefore we need to memorize which index is the one that controls the averaging
+!--          (what must be the first thermal index called).
+!--          Indices are in unknown order as depending on the input file, determine first index to
+!--          average und update only once.
+!
+!--          Only proceed here if this was not done for any index before. This is done only once
+!--          during the whole model run.
+             IF ( .NOT. average_trigger_perct  .AND.                                               &
+                  .NOT. average_trigger_utci   .AND.                                               &
+                  .NOT. average_trigger_pet    .AND.                                               &
                   .NOT. average_trigger_mrt )  THEN
 !
@@ -461 +457 @@
              ENDIF
 !
-!--          Allocation of the input _av grids was moved to the "sum" section to
-!--          make sure averaging is only done once!
-
+!--          Allocation of the input _av grids was moved to the "sum" section to make sure averaging
+!--          is only done once!
 
           CASE ( 'uvem_vitd3dose*' )
+
              IF ( .NOT. ALLOCATED( vitd3_dose ) )  THEN
                 ALLOCATE( vitd3_dose(nysg:nyng,nxlg:nxrg) )
@@ -482 +478 @@
           CASE ( 'bio_mrt' )
 !
-!--          Consider the case 'bio_mrt' is called after some thermal index. In 
-!--          that case do_average_mrt will be .TRUE. leading to a double-
-!--          averaging. 
+!--          Consider the case 'bio_mrt' is called after some thermal index. In that case
+!            do_average_mrt will be .TRUE. leading to a double-averaging.
              IF ( .NOT. do_average_mrt  .AND.  ALLOCATED( mrt_av_grid ) )  THEN
 
                 IF ( mrt_include_sw )  THEN
-                   mrt_av_grid(:) = mrt_av_grid(:) +                           &
-                      ( ( human_absorb * mrtinsw(:) +                          &
-                      mrtinlw(:) ) /                                           &
-                      ( human_emiss * sigma_sb ) )**.25_wp - degc_to_k
+                   mrt_av_grid(:) = mrt_av_grid(:)  +                                              &
+                                    ( ( human_absorb * mrtinsw(:) +                                &
+                                    mrtinlw(:) ) / ( human_emiss * sigma_sb ) )**.25_wp - degc_to_k
                 ELSE
-                   mrt_av_grid(:) = mrt_av_grid(:) +                           &
-                      ( mrtinlw(:) /                                           &
-                      ( human_emiss * sigma_sb ) )**.25_wp - degc_to_k
+                   mrt_av_grid(:) = mrt_av_grid(:) +                                               &
+                                    ( mrtinlw(:) / ( human_emiss * sigma_sb ) )**.25_wp - degc_to_k
                 ENDIF
              ENDIF
@@ -501 +494 @@
           CASE ( 'bio_perct*', 'bio_utci*', 'bio_pet*', 'bio_mrt*' )
 !
-!--          Only continue if the current index is the one to trigger the input 
-!--          averaging, see above
-             IF ( average_trigger_perct  .AND.  TRIM( variable ) /=            &
-                'bio_perct*')  RETURN
-             IF ( average_trigger_utci   .AND.  TRIM( variable ) /=            &
-                'bio_utci*')   RETURN
-             IF ( average_trigger_pet    .AND.  TRIM( variable ) /=            &
-                'bio_pet*')    RETURN
-             IF ( average_trigger_mrt    .AND.  TRIM( variable ) /=            &
-                'bio_mrt*')    RETURN
-!
-!--          Now memorize which of the input grids are not averaged by other 
-!--          modules. Set averaging switch to .TRUE. and allocate the respective
-!--          grid in that case.
+!--          Only continue if the current index is the one to trigger the input averaging, see
+!--          above.
+             IF ( average_trigger_perct  .AND.  TRIM( variable ) /= 'bio_perct*')    RETURN
+             IF ( average_trigger_utci   .AND.  TRIM( variable ) /= 'bio_utci*' )    RETURN
+             IF ( average_trigger_pet    .AND.  TRIM( variable ) /= 'bio_pet*'  )    RETURN
+             IF ( average_trigger_mrt    .AND.  TRIM( variable ) /= 'bio_mrt*'  )    RETURN
+!
+!--          Now memorize which of the input grids are not averaged by other modules. Set averaging
+!--          switch to .TRUE. and allocate the respective grid in that case.
              IF ( .NOT. ALLOCATED( pt_av ) )  THEN  !< if not averaged by other module
                 ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
@@ -546 +534 @@
 
 !
-!-- u_av, v_av and w_av are always allocated
+!--          u_av, v_av and w_av are always allocated
              IF ( .NOT. ALLOCATED( u_av ) )  THEN
                 ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
@@ -600 +588 @@
 
                 IF ( mrt_include_sw )  THEN
-                   mrt_av_grid(:) = mrt_av_grid(:) +                           &
-                      ( ( human_absorb * mrtinsw(:) +                          &
-                      mrtinlw(:) ) /                                           &
-                      ( human_emiss * sigma_sb ) )**.25_wp - degc_to_k
-                ELSE
-                   mrt_av_grid(:) = mrt_av_grid(:) +                           &
-                      ( mrtinlw(:) /                                           &
-                      ( human_emiss * sigma_sb ) )**.25_wp - degc_to_k
+                   mrt_av_grid(:) = mrt_av_grid(:) +                                               &
+                                    ( ( human_absorb * mrtinsw(:) +                                &
+                                    mrtinlw(:) ) /                                                 &
+                                      ( human_emiss  * sigma_sb ) )**0.25_wp - degc_to_k
+               ELSE
+                   mrt_av_grid(:) = mrt_av_grid(:) +                                               &
+                                    ( mrtinlw(:) /                                                 &
+                                    ( human_emiss * sigma_sb ) )**0.25_wp - degc_to_k
                 ENDIF
              ENDIF
@@ -632 +620 @@
           CASE ( 'bio_mrt' )
 !
-!--          Consider the case 'bio_mrt' is called after some thermal index. In 
-!--          that case do_average_mrt will be .TRUE. leading to a double-
-!--          averaging. 
+!--          Consider the case 'bio_mrt' is called after some thermal index. In that case
+!--          do_average_mrt will be .TRUE. leading to a double-averaging.
              IF ( .NOT. do_average_mrt  .AND.  ALLOCATED( mrt_av_grid ) )  THEN
                 mrt_av_grid(:) = mrt_av_grid(:) / REAL( average_count_3d, KIND=wp )
@@ -642 +629 @@
 !
 !--          Only continue if update index, see above
-             IF ( average_trigger_perct  .AND.                                 &
+             IF ( average_trigger_perct  .AND.                                                     &
                 TRIM( variable ) /= 'bio_perct*' )  RETURN
-             IF ( average_trigger_utci  .AND.                                  &
+             IF ( average_trigger_utci  .AND.                                                      &
                 TRIM( variable ) /= 'bio_utci*' )  RETURN
-             IF ( average_trigger_pet   .AND.                                  &
+             IF ( average_trigger_pet   .AND.                                                      &
                 TRIM( variable ) /= 'bio_pet*' )  RETURN
-             IF ( average_trigger_mrt   .AND.                                  &
+             IF ( average_trigger_mrt   .AND.                                                      &
                 TRIM( variable ) /= 'bio_mrt*' )  RETURN
 
@@ -655 +642 @@
                    DO  j = nys, nyn
                       DO  k = nzb, nzt+1
-                         pt_av(k,j,i) = pt_av(k,j,i) /                         &
-                            REAL( average_count_3d, KIND=wp )
+                         pt_av(k,j,i) = pt_av(k,j,i) /  REAL( average_count_3d, KIND = wp )
                       ENDDO
                    ENDDO
@@ -666 +652 @@
                    DO  j = nys, nyn
                       DO  k = nzb, nzt+1
-                         q_av(k,j,i) = q_av(k,j,i) /                           &
-                            REAL( average_count_3d, KIND=wp )
+                         q_av(k,j,i) = q_av(k,j,i) / REAL( average_count_3d, KIND = wp )
                       ENDDO
                    ENDDO
@@ -677 +662 @@
                    DO  j = nysg, nyng
                       DO  k = nzb, nzt+1
-                         u_av(k,j,i) = u_av(k,j,i) /                           &
-                            REAL( average_count_3d, KIND=wp )
+                         u_av(k,j,i) = u_av(k,j,i) / REAL( average_count_3d, KIND = wp )
                       ENDDO
                    ENDDO
@@ -688 +672 @@
                    DO  j = nysg, nyng
                       DO  k = nzb, nzt+1
-                         v_av(k,j,i) = v_av(k,j,i) /                           &
-                            REAL( average_count_3d, KIND=wp )
+                         v_av(k,j,i) = v_av(k,j,i) / REAL( average_count_3d, KIND = wp )
                       ENDDO
                    ENDDO
@@ -699 +682 @@
                    DO  j = nysg, nyng
                       DO  k = nzb, nzt+1
-                         w_av(k,j,i) = w_av(k,j,i) /                           &
-                            REAL( average_count_3d, KIND=wp )
+                         w_av(k,j,i) = w_av(k,j,i) / REAL( average_count_3d, KIND = wp )
                       ENDDO
                    ENDDO
@@ -707 +689 @@
 
              IF ( ALLOCATED( mrt_av_grid )  .AND.  do_average_mrt )  THEN
-                mrt_av_grid(:) = mrt_av_grid(:) / REAL( average_count_3d,      &
-                KIND=wp )
+                mrt_av_grid(:) = mrt_av_grid(:) / REAL( average_count_3d, KIND = wp )
              ENDIF
 
 !
-!--     No averaging for UVEM since we are calculating a dose (only sum is
-!--     calculated and saved to av.nc file)
-
+!--     No averaging for UVEM SINce we are calculating a dose (only sum is calculated and saved to
+!--     av.nc file)
         END SELECT
 
@@ -724 +704 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Check data output for biometeorology model
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_check_data_output( var, unit, i, j, ilen, k )
 
-    USE control_parameters,                                                    &
+    USE control_parameters,                                                                        &
         ONLY: data_output, message_string
 
@@ -747 +727 @@
 !
 !--    Allocate a temporary array with the desired output dimensions.
-!--    Arrays for time-averaged thermal indices are also allocated here because
-!--    they are not running through the standard averaging procedure in
-!--    bio_3d_data_averaging as the values of the averaged thermal indices are
-!--    derived in a single step based on priorly averaged arrays (see
+!--    Arrays for time-averaged thermal indices are also allocated here because they are not running
+!--    through the standard averaging procedure in bio_3d_data_averaging as the values of the
+!--    averaged thermal indices are derived in a SINgle step based on priorly averaged arrays (see
 !--    bio_calculate_thermal_index_maps).
        CASE ( 'bio_mrt', 'bio_mrt*' )
@@ -772 +751 @@
                 perct = REAL( bio_fill_value, KIND = wp )
              ENDIF
-          ELSE                              !< if averaged input
+          ELSE                               !< if averaged input
              do_calculate_perct_av = .TRUE.
              IF ( .NOT. ALLOCATED( perct_av ) )  THEN
@@ -816 +795 @@
 
        CASE ( 'uvem_vitd3*' )
-!           IF (  .NOT.  uv_exposure )  THEN
-!              message_string = 'output of "' // TRIM( var ) // '" requi' //     &
+!           IF ( .NOT. uv_exposure )  THEN
+!              message_string = 'output of "' // TRIM( var ) // '" requi' //                       &
 !                       'res a namelist &uvexposure_par'
 !              CALL message( 'uvem_check_data_output', 'UV0001', 1, 2, 0, 6, 0 )
 !           ENDIF
           IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
-             message_string = 'illegal value for data_output: "' //            &
-                              TRIM( var ) // '" & only 2d-horizontal ' //      &
+             message_string = 'illegal value for data_output: "' //                                &
+                              TRIM( var ) // '" & only 2d-horizontal ' //                          &
                               'cross sections are allowed for this value'
              CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 )
@@ -840 +819 @@
 !           ENDIF
           IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
-             message_string = 'illegal value for data_output: "' //            &
-                              TRIM( var ) // '" & only 2d-horizontal ' //      &
+             message_string = 'illegal value for data_output: "' //                                &
+                              TRIM( var ) // '" & only 2d-horizontal ' //                          &
                               'cross sections are allowed for this value'
              CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 )
@@ -857 +836 @@
 
 !
-!--    Further checks if thermal comfort output is desired.
+!-- Further checks if thermal comfort output is desired.
     IF ( thermal_comfort  .AND.  unit == 'degree_C' )  THEN
 !
-!--    Break if required modules "radiation" is not avalable.
+!--    Break if required modules "radiation" is not available.
        IF ( .NOT.  radiation )  THEN
-          message_string = 'output of "' // TRIM( var ) // '" require'         &
-                           // 's radiation = .TRUE.'
+          message_string = 'output of "' // TRIM( var ) // '" require' // 's radiation = .TRUE.'
           CALL message( 'check_parameters', 'PA0509', 1, 2, 0, 6, 0 )
           unit = 'illegal'
        ENDIF
 !
-!--    All "thermal_comfort" outputs except from 'bio_mrt' will also need 
-!--    humidity input. Check also for that.
+!--    All "thermal_comfort" outputs except from 'bio_mrt' will also need  humidity input. Check
+!--    also for that.
        IF ( TRIM( var ) /= 'bio_mrt' )  THEN
           IF ( .NOT.  humidity )  THEN
-             message_string = 'The estimation of thermal comfort '    //       &
-                              'requires air humidity information, but ' //     &
+             message_string = 'The estimation of thermal comfort '    //                           &
+                              'requires air humidity information, but ' //                         &
                               'humidity module is disabled!'
              CALL message( 'check_parameters', 'PA0561', 1, 2, 0, 6, 0 )
@@ -885 +863 @@
  END SUBROUTINE bio_check_data_output
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Check parameters routine for biom module
 !> Currently unused but might come in handy for future checks?
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_check_parameters
 
@@ -897 +875 @@
 
 
-
  END SUBROUTINE bio_check_parameters
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Subroutine defining 2D output variables
 !> data_output_2d 1188ff
-!------------------------------------------------------------------------------!
- SUBROUTINE bio_data_output_2d( av, variable, found, grid, local_pf,           &
-                                two_d, nzb_do, nzt_do )
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE bio_data_output_2d( av, variable, found, grid, local_pf, two_d, nzb_do, nzt_do)
 
 
@@ -924 +900 @@
 !-- Output variables
     CHARACTER (LEN=*), INTENT(OUT) ::  grid   !< Grid type (always "zu1" for biom)
+
     LOGICAL, INTENT(OUT)           ::  found  !< Output found?
     LOGICAL, INTENT(OUT)           ::  two_d  !< Flag parameter that indicates 2D variables,
@@ -950 +927 @@
               j = mrtbl(iy,l)
               k = mrtbl(iz,l)
-              IF ( k < nzb_do  .OR.  k > nzt_do  .OR.  j < nys  .OR.           &
+              IF ( k < nzb_do  .OR.  k > nzt_do  .OR.  j < nys  .OR.                               &
                  j > nyn  .OR.  i < nxl  .OR.  i > nxr )  CYCLE
               IF ( av == 0 )  THEN
                  IF ( mrt_include_sw )  THEN
-                    local_pf(i,j,k) = ( ( human_absorb * mrtinsw(l) +          &
-                                    mrtinlw(l) ) /                             &
-                                    ( human_emiss * sigma_sb ) )**.25_wp -     &
-                                    degc_to_k
+                    local_pf(i,j,k) = ( ( human_absorb * mrtinsw(l) +                              &
+                                      mrtinlw(l) ) /                                               &
+                                      ( human_emiss * sigma_sb ) )**0.25_wp - degc_to_k
                  ELSE
-                    local_pf(i,j,k) = ( mrtinlw(l)  /                          &
-                                    ( human_emiss * sigma_sb ) )**.25_wp -     &
-                                    degc_to_k
+                    local_pf(i,j,k) = ( mrtinlw(l) /                                               &
+                                      ( human_emiss * sigma_sb ) )**0.25_wp - degc_to_k
                  ENDIF
               ELSE
@@ -1040 +1015 @@
 
 !
-!--    Before data is transfered to local_pf, transfer is it 2D dummy variable and exchange ghost points therein. 
-!--    However, at this point this is only required for instantaneous arrays, time-averaged quantities are already exchanged. 
+!--    Before data is transfered to local_pf, transfer is in 2D dummy variable and exchange ghost
+!--    points therein. However, at this point this is only required for instantaneous arrays,
+!--    time-averaged quantities are already exchanged.
        CASE ( 'uvem_vitd3*_xy' )        ! 2d-array
           IF ( av == 0 )  THEN
@@ -1077 +1053 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Subroutine defining 3D output variables (dummy, always 2d!)
 !> data_output_3d 709ff
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
 
@@ -1094 +1070 @@
 !-- Input variables
     CHARACTER (LEN=*), INTENT(IN) ::  variable   !< Char identifier to select var for output
+
     INTEGER(iwp), INTENT(IN) ::  av       !< Use averaged data? 0 = no, 1 = yes?
     INTEGER(iwp), INTENT(IN) ::  nzb_do   !< Unused. 2D. nz bottom to nz top
@@ -1100 +1077 @@
 !-- Output variables
     LOGICAL, INTENT(OUT) ::  found   !< Output found?
+
     REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf   !< Temp. result grid to return
 !
@@ -1108 +1086 @@
     INTEGER(iwp) ::  k    !< Running index, z-dir
 
-!     REAL(wp) ::  mrt  !< Buffer for mean radiant temperature
+!    REAL(wp) ::  mrt  !< Buffer for mean radiant temperature
 
     found = .TRUE.
@@ -1120 +1098 @@
                j = mrtbl(iy,l)
                k = mrtbl(iz,l)
-               IF ( k < nzb_do  .OR.  k > nzt_do  .OR.  j < nys  .OR.          &
+               IF ( k < nzb_do  .OR.  k > nzt_do  .OR.  j < nys  .OR.                              &
                   j > nyn  .OR.  i < nxl  .OR.  i > nxr )  CYCLE
                IF ( av == 0 )  THEN
                   IF ( mrt_include_sw )  THEN
-                     local_pf(i,j,k) = REAL( ( ( human_absorb * mrtinsw(l) +   &
-                                    mrtinlw(l) ) /                             &
-                                    ( human_emiss * sigma_sb ) )**.25_wp -     &
-                                    degc_to_k, KIND = sp )
+                     local_pf(i,j,k) = REAL( ( ( human_absorb * mrtinsw(l) +                       &
+                                       mrtinlw(l) ) /                                              &
+                                       ( human_emiss * sigma_sb ) )**0.25_wp - degc_to_k,          &
+                                         KIND = sp )
                   ELSE
-                     local_pf(i,j,k) = REAL( ( mrtinlw(l) /                    &
-                                    ( human_emiss * sigma_sb ) )**.25_wp -     &
-                                    degc_to_k, KIND = sp )
+                     local_pf(i,j,k) = REAL( ( mrtinlw(l) /                                        &
+                                       ( human_emiss * sigma_sb ) )**0.25_wp - degc_to_k,          &
+                                         KIND = sp )
                   ENDIF
                ELSE
@@ -1145 +1123 @@
  END SUBROUTINE bio_data_output_3d
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
@@ -1151 +1129 @@
 !> It is called out from subroutine netcdf_interface_mod.
 !> netcdf_interface_mod 918ff
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
 
@@ -1167 +1145 @@
 !
 !-- Local variables
+    INTEGER(iwp) :: l     !< Length of the var array
+
     LOGICAL      :: is2d  !< Var is 2d?
-
-    INTEGER(iwp) :: l     !< Length of the var array
-
 
     found  = .FALSE.
@@ -1196 +1173 @@
  END SUBROUTINE bio_define_netcdf_grid
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Header output for biom module
 !> header 982
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_header( io )
 
@@ -1219 +1196 @@
     WRITE( io, 3 )  TRIM( ACHAR( bio_cell_level ) )
 
-1   FORMAT (//' Human thermal comfort module information:'/                    &
+1   FORMAT (//' Human thermal comfort module information:'/                                        &
               ' ------------------------------'/)
 2   FORMAT ('    --> All indices calculated for a height of (m): ', A )
@@ -1227 +1204 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Initialization of the HTCM
 !> init_3d_model 1987ff
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_init
 
-    USE netcdf_data_input_mod,                                                 &
+    USE netcdf_data_input_mod,                                                                     &
         ONLY:  netcdf_data_input_uvem
 
@@ -1245 +1222 @@
     IF ( debug_output )  CALL debug_message( 'bio_init', 'start' )
 !
-!-- Determine cell level corresponding to 1.1 m above ground level
-!   (gravimetric center of sample human)
+!-- Determine cell level corresponding to 1.1 m above ground level (gravimetric center of sample
+!-- human)
 
     bio_cell_level = 0_iwp
@@ -1268 +1245 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Checks done after the Initialization
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_init_checks
 
-    USE control_parameters,                                                    &
+    USE control_parameters,                                                                        &
         ONLY: message_string
 
     IF ( (.NOT. radiation_interactions) .AND. ( thermal_comfort ) )  THEN
-       message_string = 'The mrt calculation requires ' //                     &
-                        'enabled radiation_interactions but it ' //            &
+       message_string = 'The mrt calculation requires ' //                                         &
+                        'enabled radiation_interactions but it ' //                                &
                         'is disabled!'
        CALL message( 'bio_init_checks', 'PAHU03', 1, 2, 0, 6, 0 )
@@ -1289 +1266 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Parin for &biometeorology_parameters for reading biomet parameters
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_parin
 
@@ -1300 +1277 @@
 !
 !-- Internal variables
-    CHARACTER (LEN=80) ::  line  !< Dummy string for current line in parameter file 
-
-    NAMELIST /biometeorology_parameters/  thermal_comfort,                     &
-                                          clothing,                            &
-                                          consider_obstructions,               &
-                                          orientation_angle,                   &
-                                          sun_in_south,                        &
-                                          turn_to_sun,                         &
+    CHARACTER (LEN=80) ::  line  !< Dummy string for current line in parameter file
+
+    NAMELIST /biometeorology_parameters/  clothing,                                                &
+                                          consider_obstructions,                                   &
+                                          orientation_angle,                                       &
+                                          sun_in_south,                                            &
+                                          thermal_comfort,                                         &
+                                          turn_to_sun,                                             &
                                           uv_exposure
 
@@ -1342 +1319 @@
  END SUBROUTINE bio_parin
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Read module-specific global restart data (Fortran binary format).
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_rrd_global_ftn( found )
 
-    USE control_parameters,                                                    &
+    USE control_parameters,                                                                        &
         ONLY:  length, restart_string
 
@@ -1363 +1340 @@
 
 !
-!--    read control flags to determine if input grids need to be averaged
+!--    Read control flags to determine if input grids need to be averaged.
        CASE ( 'do_average_theta' )
           READ ( 13 )  do_average_theta
@@ -1383 +1360 @@
 
 !
-!--    read control flags to determine which thermal index needs to trigger averaging
+!--    Read control flags to determine which thermal index needs to trigger averaging.
        CASE ( 'average_trigger_perct' )
           READ ( 13 )  average_trigger_perct
@@ -1407 +1384 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Read module-specific global restart data (MPI-IO).
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_rrd_global_mpi
 
@@ -1433 +1410 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Read module-specific local restart data arrays (Fortran binary format).
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_rrd_local_ftn( found )
 
 
-    USE control_parameters,                                                    &
+    USE control_parameters,                                                                        &
         ONLY:  length, restart_string
 
@@ -1448 +1425 @@
 
 
-    LOGICAL, INTENT(OUT) ::  found      !< variable found? yes = .T., no = .F.
+    LOGICAL, INTENT(OUT) ::  found      !< variable found? yes = .TRUE., no = .FALSE.
 
     found = .TRUE.
@@ -1487 +1464 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Write global restart data for the biometeorology module.
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_wrd_global
 
@@ -1519 +1496 @@
        WRITE ( 14 )  average_trigger_mrt
 
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
+    ELSEIF ( TRIM( restart_data_format_output(1:3) ) == 'mpi' )  THEN
 
        CALL wrd_mpi_io( 'do_average_theta', do_average_theta )
@@ -1531 +1508 @@
        CALL wrd_mpi_io( 'average_trigger_pet', average_trigger_pet )
        CALL wrd_mpi_io( 'average_trigger_mrt', average_trigger_mrt )
+
     ENDIF
 
@@ -1536 +1514 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Write local restart data for the biometeorology module.
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_wrd_local
 
@@ -1558 +1536 @@
        ENDIF
 
-    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
+    ELSEIF ( TRIM( restart_data_format_output(1:3) ) == 'mpi' )  THEN
 
 !
@@ -1573 +1551 @@
  END SUBROUTINE bio_wrd_local
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Calculate biometeorology MRT for all 2D grid
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_calculate_mrt_grid ( av )
 
@@ -1605 +1583 @@
        IF ( ALLOCATED( mrt_av_grid ) )  THEN
 !
-!-- Iterate over the radiation grid (radiation coordinates) and fill the 
-!-- tmrt_av_grid (x, y coordinates) where appropriate:
-!-- tmrt_av_grid is written for all i / j if level (k) matches output height.
+!--       Iterate over the radiation grid (radiation coordinates) and fill the tmrt_av_grid
+!--       (x, y coordinates) where appropriate: tmrt_av_grid is written for all i / j if level (k)
+!--       matches output height.
           DO  l = 1, nmrtbl
              i = mrtbl(ix,l)
@@ -1614 +1592 @@
              IF ( k - topo_top_ind(j,i,0) == bio_cell_level + 1_iwp)  THEN
 !
-!-- Averaging was done before, so we can just copy the result here
+!--             Averaging was done before, so we can just copy the result here.
                 tmrt_av_grid(j,i) = mrt_av_grid(l)
 
@@ -1625 +1603 @@
     ELSE
 !
-!-- Calculate biometeorology MRT from local radiation fluxes calculated by RTM and assign
-!-- into 2D grid. Depending on selected output quantities, tmrt_grid might not have been
-!-- allocated in bio_check_data_output yet.
+!--    Calculate biometeorology MRT from local radiation fluxes calculated by RTM and assign into 2D
+!--    grid. Depending on selected output quantities, tmrt_grid might not have been allocated in
+!--    bio_check_data_output yet.
        IF ( .NOT. ALLOCATED( tmrt_grid ) )  THEN
           ALLOCATE( tmrt_grid (nys:nyn,nxl:nxr) )
@@ -1639 +1617 @@
           IF ( k - topo_top_ind(j,i,0) == bio_cell_level + 1_iwp)  THEN
              IF ( mrt_include_sw )  THEN
-                 tmrt_grid(j,i) = ( ( human_absorb * mrtinsw(l) +              &
-                                  mrtinlw(l) )  /                              &
-                                  ( human_emiss * sigma_sb ) )**.25_wp -       &
-                                  degc_to_k
+                tmrt_grid(j,i) = ( ( human_absorb * mrtinsw(l) +                                   &
+                                 mrtinlw(l) )  /                                                   &
+                                 ( human_emiss * sigma_sb ) )**0.25_wp -                           &
+                                 degc_to_k
              ELSE
-                 tmrt_grid(j,i) = ( mrtinlw(l)  /                              &
-                                  ( human_emiss * sigma_sb ) )**.25_wp -       &
-                                  degc_to_k
+                tmrt_grid(j,i) = ( mrtinlw(l)  /                                                   &
+                                 ( human_emiss * sigma_sb ) )**0.25_wp -                           &
+                                 degc_to_k
              ENDIF
           ENDIF
@@ -1652 +1630 @@
     ENDIF
 
-END SUBROUTINE bio_calculate_mrt_grid
-
-
-!------------------------------------------------------------------------------!
+ END SUBROUTINE bio_calculate_mrt_grid
+
+
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Calculate static thermal indices for 2D grid point i, j
-!------------------------------------------------------------------------------!
- SUBROUTINE bio_get_thermal_index_input_ij( average_input, i, j, ta, vp, ws,   &
-                                            pair, tmrt )
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE bio_get_thermal_index_input_ij( average_input, i, j, ta, vp, ws, pair, tmrt )
 
     IMPLICIT NONE
@@ -1671 +1648 @@
 !
 !-- Output parameters
+    REAL(wp), INTENT ( OUT )    ::  pair  !< Air pressure                    (hPa)
+    REAL(wp), INTENT ( OUT )    ::  ta    !< Air temperature                 (degree_C)
     REAL(wp), INTENT ( OUT )    ::  tmrt  !< Mean radiant temperature        (degree_C)
-    REAL(wp), INTENT ( OUT )    ::  ta    !< Air temperature                 (degree_C)
     REAL(wp), INTENT ( OUT )    ::  vp    !< Vapour pressure                 (hPa)
     REAL(wp), INTENT ( OUT )    ::  ws    !< Wind speed    (local level)     (m/s)
-    REAL(wp), INTENT ( OUT )    ::  pair  !< Air pressure                    (hPa)
 !
 !-- Internal variables
@@ -1684 +1661 @@
 
 !
-!-- Determine cell level closest to 1.1m above ground
-!   by making use of truncation due to int cast
+!-- Determine cell level closest to 1.1m above ground by making use of truncation due to int cast.
     k = INT( topo_top_ind(j,i,0) + bio_cell_level )  !< Vertical cell center closest to 1.1m
 
@@ -1701 +1677 @@
        ta = bio_fill_value
        IF ( ALLOCATED( pt_av ) )  THEN
-          ta = pt_av(k,j,i) - ( 0.0098_wp * dz(1) * ( k + .5_wp ) ) - degc_to_k
+          ta = pt_av(k,j,i) - ( 0.0098_wp * dz(1) * ( k + 0.5_wp ) ) - degc_to_k
        ENDIF
 
@@ -1710 +1686 @@
 
        ws = bio_fill_value
-       IF ( ALLOCATED( u_av )  .AND.  ALLOCATED( v_av )  .AND.                 &
+       IF ( ALLOCATED( u_av )  .AND.  ALLOCATED( v_av )  .AND.                                     &
           ALLOCATED( w_av ) )  THEN
-             ws = ( 0.5_wp * ABS( u_av(k_wind,j,i) + u_av(k_wind,j,i+1) )  +   &
-             0.5_wp * ABS( v_av(k_wind,j,i) + v_av(k_wind,j+1,i) )  +          &
-             0.5_wp * ABS( w_av(k_wind,j,i) + w_av(k_wind+1,j,i) ) )
+             ws = ( 0.5_wp * ABS( u_av(k_wind,j,i) + u_av(k_wind,j,i+1) ) +                        &
+                    0.5_wp * ABS( v_av(k_wind,j,i) + v_av(k_wind,j+1,i) ) +                        &
+                    0.5_wp * ABS( w_av(k_wind,j,i) + w_av(k_wind+1,j,i) ) )
        ENDIF
     ELSE
 !
-!-- Calculate ta from Tp assuming dry adiabatic laps rate
-       ta = pt(k,j,i) - ( 0.0098_wp * dz(1) * (  k + .5_wp ) ) - degc_to_k
+!--    Calculate ta from Tp assuming dry adiabatic laps rate
+       ta = pt(k,j,i) - ( 0.0098_wp * dz(1) * (  k + 0.5_wp ) ) - degc_to_k
 
        vp = bio_fill_value
@@ -1726 +1702 @@
        ENDIF
 
-       ws = ( 0.5_wp * ABS( u(k_wind,j,i) + u(k_wind,j,i+1) )  +               &
-          0.5_wp * ABS( v(k_wind,j,i) + v(k_wind,j+1,i) )  +                   &
-          0.5_wp * ABS( w(k_wind,j,i) + w(k_wind+1,j,i) ) )
+       ws = ( 0.5_wp * ABS( u(k_wind,j,i) + u(k_wind,j,i+1) )  +                                   &
+              0.5_wp * ABS( v(k_wind,j,i) + v(k_wind,j+1,i) )  +                                   &
+              0.5_wp * ABS( w(k_wind,j,i) + w(k_wind+1,j,i) ) )
 
     ENDIF
@@ -1735 +1711 @@
     pair = surface_pressure
 !
-!-- Calculate water vapour pressure at saturation and convert to hPa
-!-- The magnus formula is limited to temperatures up to 333.15 K to
-!   avoid negative values of vp_sat
-    IF ( vp > -998._wp )  THEN
+!-- Calculate water vapour pressure at saturation and convert to hPa.
+!-- The magnus formula is limited to temperatures up to 333.15 K to avoid negative values of vp_sat.
+    IF ( vp > -998.0_wp )  THEN
        vp_sat = 0.01_wp * magnus( MIN( ta + degc_to_k, 333.15_wp ) )
        vp  = vp * pair / ( vp + 0.622_wp )
@@ -1744 +1719 @@
     ENDIF
 !
-!-- local mtr value at [i,j]
+!-- Local mtr value at [i,j]
     tmrt = bio_fill_value  !< this can be a valid result (e.g. for inside some ostacle)
     IF ( .NOT. average_input )  THEN
@@ -1757 +1732 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Calculate static thermal indices for any point within a 2D grid
-!> time_integration.f90: 1065ff
-!------------------------------------------------------------------------------!
+!> Calculate static thermal indices for any point within a 2D grid time_integration.f90: 1065ff
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_calculate_thermal_index_maps( av )
 
@@ -1774 +1748 @@
 
     REAL(wp) ::  clo          !< Clothing index                (no dimension)
+    REAL(wp) ::  pair         !< Air pressure                     (hPa)
+    REAL(wp) ::  perct_ij     !< Perceived temperature            (degree_C)
+    REAL(wp) ::  pet_ij       !< Physiologically equivalent temperature  (degree_C)
     REAL(wp) ::  ta           !< Air temperature                  (degree_C)
+    REAL(wp) ::  tmrt_ij      !< Mean radiant temperature         (degree_C)
+    REAL(wp) ::  utci_ij      !< Universal thermal climate index  (degree_C)
     REAL(wp) ::  vp           !< Vapour pressure                  (hPa)
     REAL(wp) ::  ws           !< Wind speed    (local level)      (m/s)
-    REAL(wp) ::  pair         !< Air pressure                     (hPa)
-    REAL(wp) ::  perct_ij     !< Perceived temperature            (degree_C)
-    REAL(wp) ::  utci_ij      !< Universal thermal climate index  (degree_C)
-    REAL(wp) ::  pet_ij       !< Physiologically equivalent temperature  (degree_C)
-    REAL(wp) ::  tmrt_ij      !< Mean radiant temperature         (degree_C)
-
-!
-!-- Check if some thermal index is desired. Don't do anything if, e.g. only
-!-- bio_mrt is desired.
-    IF ( do_calculate_perct  .OR.  do_calculate_perct_av  .OR.                 &
-       do_calculate_utci  .OR.  do_calculate_utci_av  .OR.                     &
-       do_calculate_pet  .OR.  do_calculate_pet_av  .OR.                       &
-       do_calculate_mrt2d )  THEN
+
+!
+!-- Check if some thermal index is desired. Don't do anything if, e.g. only bio_mrt is desired.
+    IF ( do_calculate_perct    .OR.  do_calculate_perct_av  .OR.  do_calculate_utci    .OR.        &
+         do_calculate_utci_av  .OR.  do_calculate_pet       .OR.  do_calculate_pet_av  .OR.        &
+         do_calculate_mrt2d )  THEN
 
 !
@@ -1803 +1775 @@
 !
 !--          Determine local meteorological conditions
-             CALL bio_get_thermal_index_input_ij ( av, i, j, ta, vp,           &
-                                                   ws, pair, tmrt_ij )
+             CALL bio_get_thermal_index_input_ij ( av, i, j, ta, vp, ws, pair, tmrt_ij )
 !
 !--          Only proceed if input is available
@@ -1810 +1781 @@
              perct_ij = bio_fill_value   !< within some obstacle
              utci_ij  = bio_fill_value
-             IF ( .NOT. ( tmrt_ij <= -998._wp  .OR.  vp <= -998._wp  .OR.      &
-                ws <= -998._wp  .OR.  ta <= -998._wp ) )  THEN
+             IF ( .NOT. ( tmrt_ij <= -998.0_wp  .OR.  vp <= -998.0_wp  .OR.   ws <= -998.0_wp  .OR.&
+                  ta <= -998.0_wp ) )  THEN
 !
 !--             Calculate static thermal indices based on local tmrt
@@ -1819 +1790 @@
 !
 !--                Estimate local perceived temperature
-                   CALL calculate_perct_static( ta, vp, ws, tmrt_ij, pair,     &
-                      clo, perct_ij )
+                   CALL calculate_perct_static( ta, vp, ws, tmrt_ij, pair, clo, perct_ij )
                 ENDIF
 
@@ -1826 +1796 @@
 !
 !--                Estimate local universal thermal climate index
-                   CALL calculate_utci_static( ta, vp, ws, tmrt_ij,            &
-                      bio_output_height, utci_ij )
+                   CALL calculate_utci_static( ta, vp, ws, tmrt_ij, bio_output_height, utci_ij )
                 ENDIF
 
@@ -1833 +1802 @@
 !
 !--                Estimate local physiologically equivalent temperature
-                   CALL calculate_pet_static( ta, vp, ws, tmrt_ij, pair,       &
-                      pet_ij )
+                   CALL calculate_pet_static( ta, vp, ws, tmrt_ij, pair, pet_ij )
                 ENDIF
              ENDIF
@@ -1871 +1839 @@
  END SUBROUTINE bio_calculate_thermal_index_maps
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Calculate dynamic thermal indices (currently only iPT, but expandable)
-!------------------------------------------------------------------------------!
- SUBROUTINE bio_calc_ipt( ta, vp, ws, pair, tmrt, dt, energy_storage,          &
-    t_clo, clo, actlev, age, weight, height, work, sex, ipt )
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE bio_calc_ipt( ta, vp, ws, pair, tmrt, dt, energy_storage, t_clo, clo, actlev, age,     &
+                          weight, height, work, sex, ipt )
 
     IMPLICIT NONE
 !
 !-- Input parameters
-    REAL(wp), INTENT ( IN )  ::  ta   !< Air temperature                  (degree_C)
-    REAL(wp), INTENT ( IN )  ::  vp   !< Vapour pressure                  (hPa)
-    REAL(wp), INTENT ( IN )  ::  ws   !< Wind speed    (local level)      (m/s)
-    REAL(wp), INTENT ( IN )  ::  pair !< Air pressure                     (hPa)
-    REAL(wp), INTENT ( IN )  ::  tmrt !< Mean radiant temperature         (degree_C)
-    REAL(wp), INTENT ( IN )  ::  dt   !< Time past since last calculation (s)
-    REAL(wp), INTENT ( IN )  ::  age  !< Age of agent                     (y)
-    REAL(wp), INTENT ( IN )  ::  weight  !< Weight of agent               (Kg)
-    REAL(wp), INTENT ( IN )  ::  height  !< Height of agent               (m)
-    REAL(wp), INTENT ( IN )  ::  work    !< Mechanical workload of agent
-                                         !  (without metabolism!)         (W)
     INTEGER(iwp), INTENT ( IN ) ::  sex  !< Sex of agent (1 = male, 2 = female)
+
+    REAL(wp), INTENT ( IN )  ::  age     !< Age of agent                     (y)
+    REAL(wp), INTENT ( IN )  ::  dt      !< Time past SINce last calculation (s)
+    REAL(wp), INTENT ( IN )  ::  height  !< Height of agent                  (m)
+    REAL(wp), INTENT ( IN )  ::  pair    !< Air pressure                     (hPa)
+    REAL(wp), INTENT ( IN )  ::  ta      !< Air temperature                  (degree_C)
+    REAL(wp), INTENT ( IN )  ::  tmrt    !< Mean radiant temperature         (degree_C)
+    REAL(wp), INTENT ( IN )  ::  vp      !< Vapour pressure                  (hPa)
+    REAL(wp), INTENT ( IN )  ::  weight  !< Weight of agent                  (Kg)
+    REAL(wp), INTENT ( IN )  ::  work    !< Mechanical workload of agent  (without metabolism!) (W)
+    REAL(wp), INTENT ( IN )  ::  ws      !< Wind speed  (local level)        (m/s)
+
 !
 !-- Both, input and output parameters
+    Real(wp), INTENT ( INOUT )  ::  actlev            !< Individuals activity level
+                                                      !< per unit surface area      (W/m²)
+    Real(wp), INTENT ( INOUT )  ::  clo               !< Current clothing in sulation
     Real(wp), INTENT ( INOUT )  ::  energy_storage    !< Energy storage   (W/m²)
-    Real(wp), INTENT ( INOUT )  ::  t_clo   !< Clothing temperature       (degree_C)
-    Real(wp), INTENT ( INOUT )  ::  clo     !< Current clothing in sulation
-    Real(wp), INTENT ( INOUT )  ::  actlev  !< Individuals activity level
-                                            !  per unit surface area      (W/m²)
+    Real(wp), INTENT ( INOUT )  ::  t_clo             !< Clothing temperature       (degree_C)
 !
 !-- Output parameters
     REAL(wp), INTENT ( OUT ) ::  ipt    !< Instationary perceived temp.   (degree_C)
 !
-!-- return immediatelly if nothing to do!
+!-- Return immediatelly if nothing to do!
     IF ( .NOT. thermal_comfort )  THEN
         RETURN
@@ -1911 +1880 @@
 !
 !-- If clo equals the initial value, this is the initial call
-    IF ( clo <= -998._wp )  THEN
-!
-!--    Initialize instationary perceived temperature with personalized 
-!      PT as an initial guess, set actlev and clo
-       CALL ipt_init( age, weight, height, sex, work, actlev, clo,            &
-          ta, vp, ws, tmrt, pair, dt, energy_storage, t_clo,                   &
-          ipt )
+    IF ( clo <= -998.0_wp )  THEN
+!
+!--    Initialize instationary perceived temperature with personalized PT as an initial guess, set
+!--    actlev and clo
+       CALL ipt_init( age, weight, height, sex, work, actlev, clo, ta, vp, ws, tmrt, pair, dt,     &
+                      energy_storage, t_clo, ipt )
     ELSE
 !
 !--    Estimate local instatinoary perceived temperature
-       CALL ipt_cycle ( ta, vp, ws, tmrt, pair, dt, energy_storage, t_clo,     &
-          clo, actlev, work, ipt )
+       CALL ipt_cycle ( ta, vp, ws, tmrt, pair, dt, energy_storage, t_clo, clo, actlev, work, ipt )
     ENDIF
 
@@ -1929 +1896 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
@@ -1935 +1902 @@
 !> computed by a 6th order approximation
 !>
-!> UTCI regression equation after
-!> Bröde P, Fiala D, Blazejczyk K, Holmér I, Jendritzky G, Kampmann B, Tinz B, 
-!> Havenith G (2012) Deriving the operational procedure for the Universal Thermal
-!> Climate Index (UTCI). International Journal of Biometeorology 56 (3):481-494. 
-!> doi:10.1007/s00484-011-0454-1
+!> UTCI regression equation according to
+!> Bröde P, Fiala D, Blazejczyk K, Holmér I, Jendritzky G, Kampmann B, Tinz B, Havenith G (2012)
+!> Deriving the operational procedure for the Universal Thermal Climate Index (UTCI). International
+!> Journal of Biometeorology 56 (3):481-494. doi:10.1007/s00484-011-0454-1
 !>
 !> original source available at:
 !> www.utci.org
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE calculate_utci_static( ta_in, vp, ws_hag, tmrt, hag, utci_ij )
 
@@ -1949 +1915 @@
 !
 !-- Type of input of the argument list
+    REAL(WP), INTENT ( IN )  ::  hag      !< Height of wind speed input (m)
     REAL(WP), INTENT ( IN )  ::  ta_in    !< Local air temperature (degree_C)
+    REAL(WP), INTENT ( IN )  ::  tmrt     !< Local mean radiant temperature (degree_C)
     REAL(WP), INTENT ( IN )  ::  vp       !< Loacl vapour pressure (hPa)
     REAL(WP), INTENT ( IN )  ::  ws_hag   !< Incident wind speed (m/s)
-    REAL(WP), INTENT ( IN )  ::  tmrt     !< Local mean radiant temperature (degree_C)
-    REAL(WP), INTENT ( IN )  ::  hag      !< Height of wind speed input (m)
 !
 !-- Type of output of the argument list
-    REAL(wp), INTENT ( OUT ) ::  utci_ij  !< Universal Thermal Climate Index (degree_C)
-
+    REAL(WP) ::  d_tmrt       !< delta-tmrt               (degree_C)
+    REAL(WP) ::  d_tmrt2      !< 2 times d_tmrt
+    REAL(WP) ::  d_tmrt3      !< 3 times d_tmrt
+    REAL(WP) ::  d_tmrt4      !< 4 times d_tmrt
+    REAL(WP) ::  d_tmrt5      !< 5 times d_tmrt
+    REAL(WP) ::  d_tmrt6      !< 6 times d_tmrt
+    REAL(WP) ::  offset       !< utci deviation by ta cond. exceeded      (degree_C)
+    REAL(WP) ::  pa           !< air pressure in kPa      (kPa)
+    REAL(WP) ::  pa2          !< 2 times pa
+    REAL(WP) ::  pa3          !< 3 times pa
+    REAL(WP) ::  pa4          !< 4 times pa
+    REAL(WP) ::  pa5          !< 5 times pa
+    REAL(WP) ::  pa6          !< 6 times pa
+    REAL(WP) ::  part_d_tmrt  !< Mean radiant temp. related part of the reg.
+    REAL(WP) ::  part_pa      !< Air pressure related part of the regression
+    REAL(WP) ::  part_pa2     !< Air pressure^2 related part of the regression
+    REAL(WP) ::  part_pa3     !< Air pressure^3 related part of the regression
+    REAL(WP) ::  part_pa46    !< Air pressure^4-6 related part of the regression
+    REAL(WP) ::  part_ta      !< Air temperature related part of the regression
+    REAL(WP) ::  part_va      !< Vapour pressure related part of the regression
     REAL(WP) ::  ta           !< air temperature modified by offset (degree_C)
-    REAL(WP) ::  pa           !< air pressure in kPa      (kPa)
-    REAL(WP) ::  d_tmrt       !< delta-tmrt               (degree_C)
-    REAL(WP) ::  va           !< wind speed at 10 m above ground level    (m/s)
-    REAL(WP) ::  offset       !< utci deviation by ta cond. exceeded      (degree_C)
-    REAL(WP) ::  part_ta      !< Air temperature related part of the regression
     REAL(WP) ::  ta2          !< 2 times ta
     REAL(WP) ::  ta3          !< 3 times ta
@@ -1969 +1948 @@
     REAL(WP) ::  ta5          !< 5 times ta
     REAL(WP) ::  ta6          !< 6 times ta
-    REAL(WP) ::  part_va      !< Vapour pressure related part of the regression
+    REAL(WP) ::  va           !< wind speed at 10 m above ground level    (m/s)
     REAL(WP) ::  va2          !< 2 times va
     REAL(WP) ::  va3          !< 3 times va
@@ -1975 +1954 @@
     REAL(WP) ::  va5          !< 5 times va
     REAL(WP) ::  va6          !< 6 times va
-    REAL(WP) ::  part_d_tmrt  !< Mean radiant temp. related part of the reg.
-    REAL(WP) ::  d_tmrt2      !< 2 times d_tmrt
-    REAL(WP) ::  d_tmrt3      !< 3 times d_tmrt
-    REAL(WP) ::  d_tmrt4      !< 4 times d_tmrt
-    REAL(WP) ::  d_tmrt5      !< 5 times d_tmrt
-    REAL(WP) ::  d_tmrt6      !< 6 times d_tmrt
-    REAL(WP) ::  part_pa      !< Air pressure related part of the regression
-    REAL(WP) ::  pa2          !< 2 times pa
-    REAL(WP) ::  pa3          !< 3 times pa
-    REAL(WP) ::  pa4          !< 4 times pa
-    REAL(WP) ::  pa5          !< 5 times pa
-    REAL(WP) ::  pa6          !< 6 times pa
-    REAL(WP) ::  part_pa2     !< Air pressure^2 related part of the regression
-    REAL(WP) ::  part_pa3     !< Air pressure^3 related part of the regression
-    REAL(WP) ::  part_pa46    !< Air pressure^4-6 related part of the regression
+
+
+    REAL(wp), INTENT ( OUT ) ::  utci_ij  !< Universal Thermal Climate Index (degree_C)
 
 !
 !-- Initialize
-    offset = 0._wp
+    offset = 0.0_wp
     ta = ta_in
     d_tmrt = tmrt - ta_in
@@ -2005 +1972 @@
 !
 !-- Check if input values in range after Broede et al. (2012)
-    IF ( ( d_tmrt > 70._wp )  .OR.  ( d_tmrt < -30._wp )  .OR.                 &
-       ( vp >= 50._wp ) )  THEN
+    IF ( ( d_tmrt > 70.0_wp )  .OR.  ( d_tmrt < -30.0_wp )  .OR.  ( vp >= 50.0_wp ) )  THEN
        utci_ij = bio_fill_value
        RETURN
@@ -2012 +1978 @@
 !
 !-- Apply eq. 2 in Broede et al. (2012) for ta out of bounds
-    IF ( ta > 50._wp )  THEN
-       offset = ta - 50._wp
-       ta = 50._wp
-    ENDIF
-    IF ( ta < -50._wp )  THEN
-       offset = ta + 50._wp
-       ta = -50._wp
-    ENDIF
-!
-!-- For routine application. For wind speeds and relative
-!-- humidity values below 0.5 m/s or 5%, respectively, the
-!-- user is advised to use the lower bounds for the calculations.
+    IF ( ta > 50.0_wp )  THEN
+       offset = ta - 50.0_wp
+       ta = 50.0_wp
+    ENDIF
+    IF ( ta < -50.0_wp )  THEN
+       offset = ta + 50.0_wp
+       ta = -50.0_wp
+    ENDIF
+!
+!-- For routine application. For wind speeds and relative humidity values below 0.5 m/s or 5%,
+!-- respectively, the user is advised to use the lower bounds for the calculations.
     IF ( va < 0.5_wp )  va = 0.5_wp
-    IF ( va > 17._wp )  va = 17._wp
+    IF ( va > 17.0_wp )  va = 17.0_wp
 
 !
 !-- Pre-calculate multiples of input parameters to save time later
-
     ta2 = ta  * ta
     ta3 = ta2 * ta
@@ -2056 +2020 @@
 !
 !-- Pre-calculate parts of the regression equation
-    part_ta = (  6.07562052e-01_wp )       +                                   &
-              ( -2.27712343e-02_wp ) * ta  +                                   &
-              (  8.06470249e-04_wp ) * ta2 +                                   &
-              ( -1.54271372e-04_wp ) * ta3 +                                   &
-              ( -3.24651735e-06_wp ) * ta4 +                                   &
-              (  7.32602852e-08_wp ) * ta5 +                                   &
+    part_ta = (  6.07562052e-01_wp )       +                                                       &
+              ( -2.27712343e-02_wp ) * ta  +                                                       &
+              (  8.06470249e-04_wp ) * ta2 +                                                       &
+              ( -1.54271372e-04_wp ) * ta3 +                                                       &
+              ( -3.24651735e-06_wp ) * ta4 +                                                       &
+              (  7.32602852e-08_wp ) * ta5 +                                                       &
               (  1.35959073e-09_wp ) * ta6
 
-    part_va = ( -2.25836520e+00_wp ) * va +                                    &
-        (  8.80326035e-02_wp ) * ta  * va +                                    &
-        (  2.16844454e-03_wp ) * ta2 * va +                                    &
-        ( -1.53347087e-05_wp ) * ta3 * va +                                    &
-        ( -5.72983704e-07_wp ) * ta4 * va +                                    &
-        ( -2.55090145e-09_wp ) * ta5 * va +                                    &
-        ( -7.51269505e-01_wp ) *       va2 +                                   &
-        ( -4.08350271e-03_wp ) * ta  * va2 +                                   &
-        ( -5.21670675e-05_wp ) * ta2 * va2 +                                   &
-        (  1.94544667e-06_wp ) * ta3 * va2 +                                   &
-        (  1.14099531e-08_wp ) * ta4 * va2 +                                   &
-        (  1.58137256e-01_wp ) *       va3 +                                   &
-        ( -6.57263143e-05_wp ) * ta  * va3 +                                   &
-        (  2.22697524e-07_wp ) * ta2 * va3 +                                   &
-        ( -4.16117031e-08_wp ) * ta3 * va3 +                                   &
-        ( -1.27762753e-02_wp ) *       va4 +                                   &
-        (  9.66891875e-06_wp ) * ta  * va4 +                                   &
-        (  2.52785852e-09_wp ) * ta2 * va4 +                                   &
-        (  4.56306672e-04_wp ) *       va5 +                                   &
-        ( -1.74202546e-07_wp ) * ta  * va5 +                                   &
-        ( -5.91491269e-06_wp ) * va6
-
-    part_d_tmrt = (  3.98374029e-01_wp ) *       d_tmrt +                      &
-            (  1.83945314e-04_wp ) * ta  *       d_tmrt +                      &
-            ( -1.73754510e-04_wp ) * ta2 *       d_tmrt +                      &
-            ( -7.60781159e-07_wp ) * ta3 *       d_tmrt +                      &
-            (  3.77830287e-08_wp ) * ta4 *       d_tmrt +                      &
-            (  5.43079673e-10_wp ) * ta5 *       d_tmrt +                      &
-            ( -2.00518269e-02_wp ) *       va  * d_tmrt +                      &
-            (  8.92859837e-04_wp ) * ta  * va  * d_tmrt +                      &
-            (  3.45433048e-06_wp ) * ta2 * va  * d_tmrt +                      &
-            ( -3.77925774e-07_wp ) * ta3 * va  * d_tmrt +                      &
-            ( -1.69699377e-09_wp ) * ta4 * va  * d_tmrt +                      &
-            (  1.69992415e-04_wp ) *       va2 * d_tmrt +                      &
-            ( -4.99204314e-05_wp ) * ta  * va2 * d_tmrt +                      &
-            (  2.47417178e-07_wp ) * ta2 * va2 * d_tmrt +                      &
-            (  1.07596466e-08_wp ) * ta3 * va2 * d_tmrt +                      &
-            (  8.49242932e-05_wp ) *       va3 * d_tmrt +                      &
-            (  1.35191328e-06_wp ) * ta  * va3 * d_tmrt +                      &
-            ( -6.21531254e-09_wp ) * ta2 * va3 * d_tmrt +                      &
-            ( -4.99410301e-06_wp ) * va4 *       d_tmrt +                      &
-            ( -1.89489258e-08_wp ) * ta  * va4 * d_tmrt +                      &
-            (  8.15300114e-08_wp ) *       va5 * d_tmrt +                      &
-            (  7.55043090e-04_wp ) *             d_tmrt2 +                     &
-            ( -5.65095215e-05_wp ) * ta  *       d_tmrt2 +                     &
-            ( -4.52166564e-07_wp ) * ta2 *       d_tmrt2 +                     &
-            (  2.46688878e-08_wp ) * ta3 *       d_tmrt2 +                     &
-            (  2.42674348e-10_wp ) * ta4 *       d_tmrt2 +                     &
-            (  1.54547250e-04_wp ) *       va  * d_tmrt2 +                     &
-            (  5.24110970e-06_wp ) * ta  * va  * d_tmrt2 +                     &
-            ( -8.75874982e-08_wp ) * ta2 * va  * d_tmrt2 +                     &
-            ( -1.50743064e-09_wp ) * ta3 * va  * d_tmrt2 +                     &
-            ( -1.56236307e-05_wp ) *       va2 * d_tmrt2 +                     &
-            ( -1.33895614e-07_wp ) * ta  * va2 * d_tmrt2 +                     &
-            (  2.49709824e-09_wp ) * ta2 * va2 * d_tmrt2 +                     &
-            (  6.51711721e-07_wp ) *       va3 * d_tmrt2 +                     &
-            (  1.94960053e-09_wp ) * ta  * va3 * d_tmrt2 +                     &
-            ( -1.00361113e-08_wp ) *       va4 * d_tmrt2 +                     &
-            ( -1.21206673e-05_wp ) *             d_tmrt3 +                     &
-            ( -2.18203660e-07_wp ) * ta  *       d_tmrt3 +                     &
-            (  7.51269482e-09_wp ) * ta2 *       d_tmrt3 +                     &
-            (  9.79063848e-11_wp ) * ta3 *       d_tmrt3 +                     &
-            (  1.25006734e-06_wp ) *       va  * d_tmrt3 +                     &
-            ( -1.81584736e-09_wp ) * ta  * va  * d_tmrt3 +                     &
-            ( -3.52197671e-10_wp ) * ta2 * va  * d_tmrt3 +                     &
-            ( -3.36514630e-08_wp ) *       va2 * d_tmrt3 +                     &
-            (  1.35908359e-10_wp ) * ta  * va2 * d_tmrt3 +                     &
-            (  4.17032620e-10_wp ) *       va3 * d_tmrt3 +                     &
-            ( -1.30369025e-09_wp ) *             d_tmrt4 +                     &
-            (  4.13908461e-10_wp ) * ta  *       d_tmrt4 +                     &
-            (  9.22652254e-12_wp ) * ta2 *       d_tmrt4 +                     &
-            ( -5.08220384e-09_wp ) *       va  * d_tmrt4 +                     &
-            ( -2.24730961e-11_wp ) * ta  * va  * d_tmrt4 +                     &
-            (  1.17139133e-10_wp ) *       va2 * d_tmrt4 +                     &
-            (  6.62154879e-10_wp ) *             d_tmrt5 +                     &
-            (  4.03863260e-13_wp ) * ta  *       d_tmrt5 +                     &
-            (  1.95087203e-12_wp ) *       va  * d_tmrt5 +                     &
-            ( -4.73602469e-12_wp ) *             d_tmrt6
-
-    part_pa = (  5.12733497e+00_wp ) *                pa +                     &
-       ( -3.12788561e-01_wp ) * ta  *                 pa +                     &
-       ( -1.96701861e-02_wp ) * ta2 *                 pa +                     &
-       (  9.99690870e-04_wp ) * ta3 *                 pa +                     &
-       (  9.51738512e-06_wp ) * ta4 *                 pa +                     &
-       ( -4.66426341e-07_wp ) * ta5 *                 pa +                     &
-       (  5.48050612e-01_wp ) *       va  *           pa +                     &
-       ( -3.30552823e-03_wp ) * ta  * va  *           pa +                     &
-       ( -1.64119440e-03_wp ) * ta2 * va  *           pa +                     &
-       ( -5.16670694e-06_wp ) * ta3 * va  *           pa +                     &
-       (  9.52692432e-07_wp ) * ta4 * va  *           pa +                     &
-       ( -4.29223622e-02_wp ) *       va2 *           pa +                     &
-       (  5.00845667e-03_wp ) * ta  * va2 *           pa +                     &
-       (  1.00601257e-06_wp ) * ta2 * va2 *           pa +                     &
-       ( -1.81748644e-06_wp ) * ta3 * va2 *           pa +                     &
-       ( -1.25813502e-03_wp ) *       va3 *           pa +                     &
-       ( -1.79330391e-04_wp ) * ta  * va3 *           pa +                     &
-       (  2.34994441e-06_wp ) * ta2 * va3 *           pa +                     &
-       (  1.29735808e-04_wp ) *       va4 *           pa +                     &
-       (  1.29064870e-06_wp ) * ta  * va4 *           pa +                     &
-       ( -2.28558686e-06_wp ) *       va5 *           pa +                     &
-       ( -3.69476348e-02_wp ) *             d_tmrt  * pa +                     &
-       (  1.62325322e-03_wp ) * ta  *       d_tmrt  * pa +                     &
-       ( -3.14279680e-05_wp ) * ta2 *       d_tmrt  * pa +                     &
-       (  2.59835559e-06_wp ) * ta3 *       d_tmrt  * pa +                     &
-       ( -4.77136523e-08_wp ) * ta4 *       d_tmrt  * pa +                     &
-       (  8.64203390e-03_wp ) *       va  * d_tmrt  * pa +                     &
-       ( -6.87405181e-04_wp ) * ta  * va  * d_tmrt  * pa +                     &
-       ( -9.13863872e-06_wp ) * ta2 * va  * d_tmrt  * pa +                     &
-       (  5.15916806e-07_wp ) * ta3 * va  * d_tmrt  * pa +                     &
-       ( -3.59217476e-05_wp ) *       va2 * d_tmrt  * pa +                     &
-       (  3.28696511e-05_wp ) * ta  * va2 * d_tmrt  * pa +                     &
-       ( -7.10542454e-07_wp ) * ta2 * va2 * d_tmrt  * pa +                     &
-       ( -1.24382300e-05_wp ) *       va3 * d_tmrt  * pa +                     &
-       ( -7.38584400e-09_wp ) * ta  * va3 * d_tmrt  * pa +                     &
-       (  2.20609296e-07_wp ) *       va4 * d_tmrt  * pa +                     &
-       ( -7.32469180e-04_wp ) *             d_tmrt2 * pa +                     &
-       ( -1.87381964e-05_wp ) * ta  *       d_tmrt2 * pa +                     &
-       (  4.80925239e-06_wp ) * ta2 *       d_tmrt2 * pa +                     &
-       ( -8.75492040e-08_wp ) * ta3 *       d_tmrt2 * pa +                     &
-       (  2.77862930e-05_wp ) *       va  * d_tmrt2 * pa +                     &
-       ( -5.06004592e-06_wp ) * ta  * va  * d_tmrt2 * pa +                     &
-       (  1.14325367e-07_wp ) * ta2 * va  * d_tmrt2 * pa +                     &
-       (  2.53016723e-06_wp ) *       va2 * d_tmrt2 * pa +                     &
-       ( -1.72857035e-08_wp ) * ta  * va2 * d_tmrt2 * pa +                     &
-       ( -3.95079398e-08_wp ) *       va3 * d_tmrt2 * pa +                     &
-       ( -3.59413173e-07_wp ) *             d_tmrt3 * pa +                     &
-       (  7.04388046e-07_wp ) * ta  *       d_tmrt3 * pa +                     &
-       ( -1.89309167e-08_wp ) * ta2 *       d_tmrt3 * pa +                     &
-       ( -4.79768731e-07_wp ) *       va  * d_tmrt3 * pa +                     &
-       (  7.96079978e-09_wp ) * ta  * va  * d_tmrt3 * pa +                     &
-       (  1.62897058e-09_wp ) *       va2 * d_tmrt3 * pa +                     &
-       (  3.94367674e-08_wp ) *             d_tmrt4 * pa +                     &
-       ( -1.18566247e-09_wp ) * ta *        d_tmrt4 * pa +                     &
-       (  3.34678041e-10_wp ) *       va  * d_tmrt4 * pa +                     &
-       ( -1.15606447e-10_wp ) *             d_tmrt5 * pa
-
-    part_pa2 = ( -2.80626406e+00_wp ) *               pa2 +                    &
-       (  5.48712484e-01_wp ) * ta  *                 pa2 +                    &
-       ( -3.99428410e-03_wp ) * ta2 *                 pa2 +                    &
-       ( -9.54009191e-04_wp ) * ta3 *                 pa2 +                    &
-       (  1.93090978e-05_wp ) * ta4 *                 pa2 +                    &
-       ( -3.08806365e-01_wp ) *       va *            pa2 +                    &
-       (  1.16952364e-02_wp ) * ta  * va *            pa2 +                    &
-       (  4.95271903e-04_wp ) * ta2 * va *            pa2 +                    &
-       ( -1.90710882e-05_wp ) * ta3 * va *            pa2 +                    &
-       (  2.10787756e-03_wp ) *       va2 *           pa2 +                    &
-       ( -6.98445738e-04_wp ) * ta  * va2 *           pa2 +                    &
-       (  2.30109073e-05_wp ) * ta2 * va2 *           pa2 +                    &
-       (  4.17856590e-04_wp ) *       va3 *           pa2 +                    &
-       ( -1.27043871e-05_wp ) * ta  * va3 *           pa2 +                    &
-       ( -3.04620472e-06_wp ) *       va4 *           pa2 +                    &
-       (  5.14507424e-02_wp ) *             d_tmrt  * pa2 +                    &
-       ( -4.32510997e-03_wp ) * ta  *       d_tmrt  * pa2 +                    &
-       (  8.99281156e-05_wp ) * ta2 *       d_tmrt  * pa2 +                    &
-       ( -7.14663943e-07_wp ) * ta3 *       d_tmrt  * pa2 +                    &
-       ( -2.66016305e-04_wp ) *       va  * d_tmrt  * pa2 +                    &
-       (  2.63789586e-04_wp ) * ta  * va  * d_tmrt  * pa2 +                    &
-       ( -7.01199003e-06_wp ) * ta2 * va  * d_tmrt  * pa2 +                    &
-       ( -1.06823306e-04_wp ) *       va2 * d_tmrt  * pa2 +                    &
-       (  3.61341136e-06_wp ) * ta  * va2 * d_tmrt  * pa2 +                    &
-       (  2.29748967e-07_wp ) *       va3 * d_tmrt  * pa2 +                    &
-       (  3.04788893e-04_wp ) *             d_tmrt2 * pa2 +                    &
-       ( -6.42070836e-05_wp ) * ta  *       d_tmrt2 * pa2 +                    &
-       (  1.16257971e-06_wp ) * ta2 *       d_tmrt2 * pa2 +                    &
-       (  7.68023384e-06_wp ) *       va  * d_tmrt2 * pa2 +                    &
-       ( -5.47446896e-07_wp ) * ta  * va  * d_tmrt2 * pa2 +                    &
-       ( -3.59937910e-08_wp ) *       va2 * d_tmrt2 * pa2 +                    &
-       ( -4.36497725e-06_wp ) *             d_tmrt3 * pa2 +                    &
-       (  1.68737969e-07_wp ) * ta  *       d_tmrt3 * pa2 +                    &
-       (  2.67489271e-08_wp ) *       va  * d_tmrt3 * pa2 +                    &
-       (  3.23926897e-09_wp ) *             d_tmrt4 * pa2
-
-    part_pa3 = ( -3.53874123e-02_wp ) *               pa3 +                    &
-       ( -2.21201190e-01_wp ) * ta  *                 pa3 +                    &
-       (  1.55126038e-02_wp ) * ta2 *                 pa3 +                    &
-       ( -2.63917279e-04_wp ) * ta3 *                 pa3 +                    &
-       (  4.53433455e-02_wp ) *       va  *           pa3 +                    &
-       ( -4.32943862e-03_wp ) * ta  * va  *           pa3 +                    &
-       (  1.45389826e-04_wp ) * ta2 * va  *           pa3 +                    &
-       (  2.17508610e-04_wp ) *       va2 *           pa3 +                    &
-       ( -6.66724702e-05_wp ) * ta  * va2 *           pa3 +                    &
-       (  3.33217140e-05_wp ) *       va3 *           pa3 +                    &
-       ( -2.26921615e-03_wp ) *             d_tmrt  * pa3 +                    &
-       (  3.80261982e-04_wp ) * ta  *       d_tmrt  * pa3 +                    &
-       ( -5.45314314e-09_wp ) * ta2 *       d_tmrt  * pa3 +                    &
-       ( -7.96355448e-04_wp ) *       va  * d_tmrt  * pa3 +                    &
-       (  2.53458034e-05_wp ) * ta  * va  * d_tmrt  * pa3 +                    &
-       ( -6.31223658e-06_wp ) *       va2 * d_tmrt  * pa3 +                    &
-       (  3.02122035e-04_wp ) *             d_tmrt2 * pa3 +                    &
-       ( -4.77403547e-06_wp ) * ta  *       d_tmrt2 * pa3 +                    &
-       (  1.73825715e-06_wp ) *       va  * d_tmrt2 * pa3 +                    &
-       ( -4.09087898e-07_wp ) *             d_tmrt3 * pa3
-
-    part_pa46 = (  6.14155345e-01_wp ) *              pa4 +                    &
-       ( -6.16755931e-02_wp ) * ta  *                 pa4 +                    &
-       (  1.33374846e-03_wp ) * ta2 *                 pa4 +                    &
-       (  3.55375387e-03_wp ) *       va  *           pa4 +                    &
-       ( -5.13027851e-04_wp ) * ta  * va  *           pa4 +                    &
-       (  1.02449757e-04_wp ) *       va2 *           pa4 +                    &
-       ( -1.48526421e-03_wp ) *             d_tmrt  * pa4 +                    &
-       ( -4.11469183e-05_wp ) * ta  *       d_tmrt  * pa4 +                    &
-       ( -6.80434415e-06_wp ) *       va  * d_tmrt  * pa4 +                    &
-       ( -9.77675906e-06_wp ) *             d_tmrt2 * pa4 +                    &
-       (  8.82773108e-02_wp ) *                       pa5 +                    &
-       ( -3.01859306e-03_wp ) * ta  *                 pa5 +                    &
-       (  1.04452989e-03_wp ) *       va  *           pa5 +                    &
-       (  2.47090539e-04_wp ) *             d_tmrt  * pa5 +                    &
-       (  1.48348065e-03_wp ) *                       pa6
-!
-!-- Calculate 6th order polynomial as approximation 
-    utci_ij = ta + part_ta + part_va + part_d_tmrt + part_pa + part_pa2 +      &
-        part_pa3 + part_pa46
+    part_va = ( -2.25836520e+00_wp ) *       va  +                                                 &
+              (  8.80326035e-02_wp ) * ta  * va  +                                                 &
+              (  2.16844454e-03_wp ) * ta2 * va  +                                                 &
+              ( -1.53347087e-05_wp ) * ta3 * va  +                                                 &
+              ( -5.72983704e-07_wp ) * ta4 * va  +                                                 &
+              ( -2.55090145e-09_wp ) * ta5 * va  +                                                 &
+              ( -7.51269505e-01_wp ) *       va2 +                                                 &
+              ( -4.08350271e-03_wp ) * ta  * va2 +                                                 &
+              ( -5.21670675e-05_wp ) * ta2 * va2 +                                                 &
+              (  1.94544667e-06_wp ) * ta3 * va2 +                                                 &
+              (  1.14099531e-08_wp ) * ta4 * va2 +                                                 &
+              (  1.58137256e-01_wp ) *       va3 +                                                 &
+              ( -6.57263143e-05_wp ) * ta  * va3 +                                                 &
+              (  2.22697524e-07_wp ) * ta2 * va3 +                                                 &
+              ( -4.16117031e-08_wp ) * ta3 * va3 +                                                 &
+              ( -1.27762753e-02_wp ) *       va4 +                                                 &
+              (  9.66891875e-06_wp ) * ta  * va4 +                                                 &
+              (  2.52785852e-09_wp ) * ta2 * va4 +                                                 &
+              (  4.56306672e-04_wp ) *       va5 +                                                 &
+              ( -1.74202546e-07_wp ) * ta  * va5 +                                                 &
+              ( -5.91491269e-06_wp ) * va6
+
+    part_d_tmrt = (  3.98374029e-01_wp ) *             d_tmrt  +                                   &
+                  (  1.83945314e-04_wp ) * ta  *       d_tmrt  +                                   &
+                  ( -1.73754510e-04_wp ) * ta2 *       d_tmrt  +                                   &
+                  ( -7.60781159e-07_wp ) * ta3 *       d_tmrt  +                                   &
+                  (  3.77830287e-08_wp ) * ta4 *       d_tmrt  +                                   &
+                  (  5.43079673e-10_wp ) * ta5 *       d_tmrt  +                                   &
+                  ( -2.00518269e-02_wp ) *       va  * d_tmrt  +                                   &
+                  (  8.92859837e-04_wp ) * ta  * va  * d_tmrt  +                                   &
+                  (  3.45433048e-06_wp ) * ta2 * va  * d_tmrt  +                                   &
+                  ( -3.77925774e-07_wp ) * ta3 * va  * d_tmrt  +                                   &
+                  ( -1.69699377e-09_wp ) * ta4 * va  * d_tmrt  +                                   &
+                  (  1.69992415e-04_wp ) *       va2 * d_tmrt  +                                   &
+                  ( -4.99204314e-05_wp ) * ta  * va2 * d_tmrt  +                                   &
+                  (  2.47417178e-07_wp ) * ta2 * va2 * d_tmrt  +                                   &
+                  (  1.07596466e-08_wp ) * ta3 * va2 * d_tmrt  +                                   &
+                  (  8.49242932e-05_wp ) *       va3 * d_tmrt  +                                   &
+                  (  1.35191328e-06_wp ) * ta  * va3 * d_tmrt  +                                   &
+                  ( -6.21531254e-09_wp ) * ta2 * va3 * d_tmrt  +                                   &
+                  ( -4.99410301e-06_wp ) * va4 *       d_tmrt  +                                   &
+                  ( -1.89489258e-08_wp ) * ta  * va4 * d_tmrt  +                                   &
+                  (  8.15300114e-08_wp ) *       va5 * d_tmrt  +                                   &
+                  (  7.55043090e-04_wp ) *             d_tmrt2 +                                   &
+                  ( -5.65095215e-05_wp ) * ta  *       d_tmrt2 +                                   &
+                  ( -4.52166564e-07_wp ) * ta2 *       d_tmrt2 +                                   &
+                  (  2.46688878e-08_wp ) * ta3 *       d_tmrt2 +                                   &
+                  (  2.42674348e-10_wp ) * ta4 *       d_tmrt2 +                                   &
+                  (  1.54547250e-04_wp ) *       va  * d_tmrt2 +                                   &
+                  (  5.24110970e-06_wp ) * ta  * va  * d_tmrt2 +                                   &
+                  ( -8.75874982e-08_wp ) * ta2 * va  * d_tmrt2 +                                   &
+                  ( -1.50743064e-09_wp ) * ta3 * va  * d_tmrt2 +                                   &
+                  ( -1.56236307e-05_wp ) *       va2 * d_tmrt2 +                                   &
+                  ( -1.33895614e-07_wp ) * ta  * va2 * d_tmrt2 +                                   &
+                  (  2.49709824e-09_wp ) * ta2 * va2 * d_tmrt2 +                                   &
+                  (  6.51711721e-07_wp ) *       va3 * d_tmrt2 +                                   &
+                  (  1.94960053e-09_wp ) * ta  * va3 * d_tmrt2 +                                   &
+                  ( -1.00361113e-08_wp ) *       va4 * d_tmrt2 +                                   &
+                  ( -1.21206673e-05_wp ) *             d_tmrt3 +                                   &
+                  ( -2.18203660e-07_wp ) * ta  *       d_tmrt3 +                                   &
+                  (  7.51269482e-09_wp ) * ta2 *       d_tmrt3 +                                   &
+                  (  9.79063848e-11_wp ) * ta3 *       d_tmrt3 +                                   &
+                  (  1.25006734e-06_wp ) *       va  * d_tmrt3 +                                   &
+                  ( -1.81584736e-09_wp ) * ta  * va  * d_tmrt3 +                                   &
+                  ( -3.52197671e-10_wp ) * ta2 * va  * d_tmrt3 +                                   &
+                  ( -3.36514630e-08_wp ) *       va2 * d_tmrt3 +                                   &
+                  (  1.35908359e-10_wp ) * ta  * va2 * d_tmrt3 +                                   &
+                  (  4.17032620e-10_wp ) *       va3 * d_tmrt3 +                                   &
+                  ( -1.30369025e-09_wp ) *             d_tmrt4 +                                   &
+                  (  4.13908461e-10_wp ) * ta  *       d_tmrt4 +                                   &
+                  (  9.22652254e-12_wp ) * ta2 *       d_tmrt4 +                                   &
+                  ( -5.08220384e-09_wp ) *       va  * d_tmrt4 +                                   &
+                  ( -2.24730961e-11_wp ) * ta  * va  * d_tmrt4 +                                   &
+                  (  1.17139133e-10_wp ) *       va2 * d_tmrt4 +                                   &
+                  (  6.62154879e-10_wp ) *             d_tmrt5 +                                   &
+                  (  4.03863260e-13_wp ) * ta  *       d_tmrt5 +                                   &
+                  (  1.95087203e-12_wp ) *       va  * d_tmrt5 +                                   &
+                  ( -4.73602469e-12_wp ) *             d_tmrt6
+
+    part_pa = (  5.12733497e+00_wp ) *                       pa +                                  &
+              ( -3.12788561e-01_wp ) * ta  *                 pa +                                  &
+              ( -1.96701861e-02_wp ) * ta2 *                 pa +                                  &
+              (  9.99690870e-04_wp ) * ta3 *                 pa +                                  &
+              (  9.51738512e-06_wp ) * ta4 *                 pa +                                  &
+              ( -4.66426341e-07_wp ) * ta5 *                 pa +                                  &
+              (  5.48050612e-01_wp ) *       va  *           pa +                                  &
+              ( -3.30552823e-03_wp ) * ta  * va  *           pa +                                  &
+              ( -1.64119440e-03_wp ) * ta2 * va  *           pa +                                  &
+              ( -5.16670694e-06_wp ) * ta3 * va  *           pa +                                  &
+              (  9.52692432e-07_wp ) * ta4 * va  *           pa +                                  &
+              ( -4.29223622e-02_wp ) *       va2 *           pa +                                  &
+              (  5.00845667e-03_wp ) * ta  * va2 *           pa +                                  &
+              (  1.00601257e-06_wp ) * ta2 * va2 *           pa +                                  &
+              ( -1.81748644e-06_wp ) * ta3 * va2 *           pa +                                  &
+              ( -1.25813502e-03_wp ) *       va3 *           pa +                                  &
+              ( -1.79330391e-04_wp ) * ta  * va3 *           pa +                                  &
+              (  2.34994441e-06_wp ) * ta2 * va3 *           pa +                                  &
+              (  1.29735808e-04_wp ) *       va4 *           pa +                                  &
+              (  1.29064870e-06_wp ) * ta  * va4 *           pa +                                  &
+              ( -2.28558686e-06_wp ) *       va5 *           pa +                                  &
+              ( -3.69476348e-02_wp ) *             d_tmrt  * pa +                                  &
+              (  1.62325322e-03_wp ) * ta  *       d_tmrt  * pa +                                  &
+              ( -3.14279680e-05_wp ) * ta2 *       d_tmrt  * pa +                                  &
+              (  2.59835559e-06_wp ) * ta3 *       d_tmrt  * pa +                                  &
+              ( -4.77136523e-08_wp ) * ta4 *       d_tmrt  * pa +                                  &
+              (  8.64203390e-03_wp ) *       va  * d_tmrt  * pa +                                  &
+              ( -6.87405181e-04_wp ) * ta  * va  * d_tmrt  * pa +                                  &
+              ( -9.13863872e-06_wp ) * ta2 * va  * d_tmrt  * pa +                                  &
+              (  5.15916806e-07_wp ) * ta3 * va  * d_tmrt  * pa +                                  &
+              ( -3.59217476e-05_wp ) *       va2 * d_tmrt  * pa +                                  &
+              (  3.28696511e-05_wp ) * ta  * va2 * d_tmrt  * pa +                                  &
+              ( -7.10542454e-07_wp ) * ta2 * va2 * d_tmrt  * pa +                                  &
+              ( -1.24382300e-05_wp ) *       va3 * d_tmrt  * pa +                                  &
+              ( -7.38584400e-09_wp ) * ta  * va3 * d_tmrt  * pa +                                  &
+              (  2.20609296e-07_wp ) *       va4 * d_tmrt  * pa +                                  &
+              ( -7.32469180e-04_wp ) *             d_tmrt2 * pa +                                  &
+              ( -1.87381964e-05_wp ) * ta  *       d_tmrt2 * pa +                                  &
+              (  4.80925239e-06_wp ) * ta2 *       d_tmrt2 * pa +                                  &
+              ( -8.75492040e-08_wp ) * ta3 *       d_tmrt2 * pa +                                  &
+              (  2.77862930e-05_wp ) *       va  * d_tmrt2 * pa +                                  &
+              ( -5.06004592e-06_wp ) * ta  * va  * d_tmrt2 * pa +                                  &
+              (  1.14325367e-07_wp ) * ta2 * va  * d_tmrt2 * pa +                                  &
+              (  2.53016723e-06_wp ) *       va2 * d_tmrt2 * pa +                                  &
+              ( -1.72857035e-08_wp ) * ta  * va2 * d_tmrt2 * pa +                                  &
+              ( -3.95079398e-08_wp ) *       va3 * d_tmrt2 * pa +                                  &
+              ( -3.59413173e-07_wp ) *             d_tmrt3 * pa +                                  &
+              (  7.04388046e-07_wp ) * ta  *       d_tmrt3 * pa +                                  &
+              ( -1.89309167e-08_wp ) * ta2 *       d_tmrt3 * pa +                                  &
+              ( -4.79768731e-07_wp ) *       va  * d_tmrt3 * pa +                                  &
+              (  7.96079978e-09_wp ) * ta  * va  * d_tmrt3 * pa +                                  &
+              (  1.62897058e-09_wp ) *       va2 * d_tmrt3 * pa +                                  &
+              (  3.94367674e-08_wp ) *             d_tmrt4 * pa +                                  &
+              ( -1.18566247e-09_wp ) * ta *        d_tmrt4 * pa +                                  &
+              (  3.34678041e-10_wp ) *       va  * d_tmrt4 * pa +                                  &
+              ( -1.15606447e-10_wp ) *             d_tmrt5 * pa
+
+    part_pa2 = ( -2.80626406e+00_wp ) *                       pa2 +                                &
+               (  5.48712484e-01_wp ) * ta  *                 pa2 +                                &
+               ( -3.99428410e-03_wp ) * ta2 *                 pa2 +                                &
+               ( -9.54009191e-04_wp ) * ta3 *                 pa2 +                                &
+               (  1.93090978e-05_wp ) * ta4 *                 pa2 +                                &
+               ( -3.08806365e-01_wp ) *       va *            pa2 +                                &
+               (  1.16952364e-02_wp ) * ta  * va *            pa2 +                                &
+               (  4.95271903e-04_wp ) * ta2 * va *            pa2 +                                &
+               ( -1.90710882e-05_wp ) * ta3 * va *            pa2 +                                &
+               (  2.10787756e-03_wp ) *       va2 *           pa2 +                                &
+               ( -6.98445738e-04_wp ) * ta  * va2 *           pa2 +                                &
+               (  2.30109073e-05_wp ) * ta2 * va2 *           pa2 +                                &
+               (  4.17856590e-04_wp ) *       va3 *           pa2 +                                &
+               ( -1.27043871e-05_wp ) * ta  * va3 *           pa2 +                                &
+               ( -3.04620472e-06_wp ) *       va4 *           pa2 +                                &
+               (  5.14507424e-02_wp ) *             d_tmrt  * pa2 +                                &
+               ( -4.32510997e-03_wp ) * ta  *       d_tmrt  * pa2 +                                &
+               (  8.99281156e-05_wp ) * ta2 *       d_tmrt  * pa2 +                                &
+               ( -7.14663943e-07_wp ) * ta3 *       d_tmrt  * pa2 +                                &
+               ( -2.66016305e-04_wp ) *       va  * d_tmrt  * pa2 +                                &
+               (  2.63789586e-04_wp ) * ta  * va  * d_tmrt  * pa2 +                                &
+               ( -7.01199003e-06_wp ) * ta2 * va  * d_tmrt  * pa2 +                                &
+               ( -1.06823306e-04_wp ) *       va2 * d_tmrt  * pa2 +                                &
+               (  3.61341136e-06_wp ) * ta  * va2 * d_tmrt  * pa2 +                                &
+               (  2.29748967e-07_wp ) *       va3 * d_tmrt  * pa2 +                                &
+               (  3.04788893e-04_wp ) *             d_tmrt2 * pa2 +                                &
+               ( -6.42070836e-05_wp ) * ta  *       d_tmrt2 * pa2 +                                &
+               (  1.16257971e-06_wp ) * ta2 *       d_tmrt2 * pa2 +                                &
+               (  7.68023384e-06_wp ) *       va  * d_tmrt2 * pa2 +                                &
+               ( -5.47446896e-07_wp ) * ta  * va  * d_tmrt2 * pa2 +                                &
+               ( -3.59937910e-08_wp ) *       va2 * d_tmrt2 * pa2 +                                &
+               ( -4.36497725e-06_wp ) *             d_tmrt3 * pa2 +                                &
+               (  1.68737969e-07_wp ) * ta  *       d_tmrt3 * pa2 +                                &
+               (  2.67489271e-08_wp ) *       va  * d_tmrt3 * pa2 +                                &
+               (  3.23926897e-09_wp ) *             d_tmrt4 * pa2
+
+    part_pa3 = ( -3.53874123e-02_wp ) *                       pa3 +                                &
+               ( -2.21201190e-01_wp ) * ta  *                 pa3 +                                &
+               (  1.55126038e-02_wp ) * ta2 *                 pa3 +                                &
+               ( -2.63917279e-04_wp ) * ta3 *                 pa3 +                                &
+               (  4.53433455e-02_wp ) *       va  *           pa3 +                                &
+               ( -4.32943862e-03_wp ) * ta  * va  *           pa3 +                                &
+               (  1.45389826e-04_wp ) * ta2 * va  *           pa3 +                                &
+               (  2.17508610e-04_wp ) *       va2 *           pa3 +                                &
+               ( -6.66724702e-05_wp ) * ta  * va2 *           pa3 +                                &
+               (  3.33217140e-05_wp ) *       va3 *           pa3 +                                &
+               ( -2.26921615e-03_wp ) *             d_tmrt  * pa3 +                                &
+               (  3.80261982e-04_wp ) * ta  *       d_tmrt  * pa3 +                                &
+               ( -5.45314314e-09_wp ) * ta2 *       d_tmrt  * pa3 +                                &
+               ( -7.96355448e-04_wp ) *       va  * d_tmrt  * pa3 +                                &
+               (  2.53458034e-05_wp ) * ta  * va  * d_tmrt  * pa3 +                                &
+               ( -6.31223658e-06_wp ) *       va2 * d_tmrt  * pa3 +                                &
+               (  3.02122035e-04_wp ) *             d_tmrt2 * pa3 +                                &
+               ( -4.77403547e-06_wp ) * ta  *       d_tmrt2 * pa3 +                                &
+               (  1.73825715e-06_wp ) *       va  * d_tmrt2 * pa3 +                                &
+               ( -4.09087898e-07_wp ) *             d_tmrt3 * pa3
+
+    part_pa46 = (  6.14155345e-01_wp ) *                       pa4 +                               &
+                ( -6.16755931e-02_wp ) * ta  *                 pa4 +                               &
+                (  1.33374846e-03_wp ) * ta2 *                 pa4 +                               &
+                (  3.55375387e-03_wp ) *       va  *           pa4 +                               &
+                ( -5.13027851e-04_wp ) * ta  * va  *           pa4 +                               &
+                (  1.02449757e-04_wp ) *       va2 *           pa4 +                               &
+                ( -1.48526421e-03_wp ) *             d_tmrt  * pa4 +                               &
+                ( -4.11469183e-05_wp ) * ta  *       d_tmrt  * pa4 +                               &
+                ( -6.80434415e-06_wp ) *       va  * d_tmrt  * pa4 +                               &
+                ( -9.77675906e-06_wp ) *             d_tmrt2 * pa4 +                               &
+                (  8.82773108e-02_wp ) *                       pa5 +                               &
+                ( -3.01859306e-03_wp ) * ta  *                 pa5 +                               &
+                (  1.04452989e-03_wp ) *       va  *           pa5 +                               &
+                (  2.47090539e-04_wp ) *             d_tmrt  * pa5 +                               &
+                (  1.48348065e-03_wp ) *                       pa6
+!
+!-- Calculate 6th order polynomial as approximation
+    utci_ij = ta + part_ta + part_va + part_d_tmrt + part_pa + part_pa2 + part_pa3 + part_pa46
 !
 !-- Consider offset in result
@@ -2285 +2248 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> calculate_perct_static: Estimation of perceived temperature (PT, degree_C)
+!> Calculate_perct_static: Estimation of perceived temperature (PT, degree_C)
 !> Value of perct is the Perceived Temperature, degree centigrade
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE calculate_perct_static( ta, vp, ws, tmrt, pair, clo, perct_ij )
 
@@ -2296 +2259 @@
 !
 !-- Type of input of the argument list
+    REAL(wp), INTENT ( IN )  :: pair !< Local barometric air pressure (hPa)
     REAL(wp), INTENT ( IN )  :: ta   !< Local air temperature (degC)
+    REAL(wp), INTENT ( IN )  :: tmrt !< Local mean radiant temperature (degC)
     REAL(wp), INTENT ( IN )  :: vp   !< Local vapour pressure (hPa)
-    REAL(wp), INTENT ( IN )  :: tmrt !< Local mean radiant temperature (degC)
     REAL(wp), INTENT ( IN )  :: ws   !< Local wind velocitry (m/s)
-    REAL(wp), INTENT ( IN )  :: pair !< Local barometric air pressure (hPa)
 !
 !-- Type of output of the argument list
+    REAL(wp), INTENT ( OUT ) :: clo       !< Clothing index (dimensionless)
     REAL(wp), INTENT ( OUT ) :: perct_ij  !< Perceived temperature (degC)
-    REAL(wp), INTENT ( OUT ) :: clo       !< Clothing index (dimensionless)
 !
 !-- Parameters for standard "Klima-Michel"
-    REAL(wp), PARAMETER :: eta = 0._wp  !< Mechanical work efficiency for walking on flat ground
-                                        !< (compare to Fanger (1972) pp 24f)
-    REAL(wp), PARAMETER :: actlev = 134.6862_wp  !< Workload by activity per standardized surface (A_Du)
+    REAL(wp), PARAMETER :: actlev = 134.6862_wp  !< Workload by activity per standardized surface 
+                                                 !< (A_Du)
+    REAL(wp), PARAMETER :: eta = 0.0_wp          !< Mechanical work efficiency for walking on flat
+                                                 !< ground (compare to Fanger (1972) pp 24f)
 !
 !-- Type of program variables
-    REAL(wp), PARAMETER :: eps = 0.0005  !< Accuracy in clothing insulation (clo) for evaluation the root of Fanger's PMV (pmva=0)
-    REAL(wp) ::  sclo           !< summer clothing insulation
-    REAL(wp) ::  wclo           !< winter clothing insulation
-    REAL(wp) ::  d_pmv          !< PMV deviation (dimensionless --> PMV)
-    REAL(wp) ::  svp_ta         !< saturation vapor pressure    (hPa)
-    REAL(wp) ::  sult_lim       !< threshold for sultrieness    (hPa)
-    REAL(wp) ::  dgtcm          !< Mean deviation dependent on perct
-    REAL(wp) ::  dgtcstd        !< Mean deviation plus its standard deviation
-    REAL(wp) ::  clon           !< clo for neutral conditions   (clo)
-    REAL(wp) ::  ireq_minimal   !< Minimal required clothing insulation (clo)
-    REAL(wp) ::  pmv_w          !< Fangers predicted mean vote for winter clothing
-    REAL(wp) ::  pmv_s          !< Fangers predicted mean vote for summer clothing
-    REAL(wp) ::  pmva           !< adjusted predicted mean vote
-    REAL(wp) ::  ptc            !< perceived temp. for cold conditions (degree_C)
-    REAL(wp) ::  d_std          !< factor to threshold for sultriness
-    REAL(wp) ::  pmvs           !< pred. mean vote considering sultrieness
-
     INTEGER(iwp) :: ncount      !< running index
     INTEGER(iwp) :: nerr_cold   !< error number (cold conditions)
@@ -2334 +2281 @@
 
     LOGICAL :: sultrieness
+
+    REAL(wp), PARAMETER :: eps = 0.0005  !< Accuracy in clothing insulation (clo) for evaluation the
+                                         !< root of Fanger's PMV (pmva=0)
+
+    REAL(wp) ::  clon           !< clo for neutral conditions   (clo)
+    REAL(wp) ::  d_pmv          !< PMV deviation (dimensionless --> PMV)
+    REAL(wp) ::  dgtcm          !< Mean deviation dependent on perct
+    REAL(wp) ::  dgtcstd        !< Mean deviation plus its standard deviation
+    REAL(wp) ::  d_std          !< factor to threshold for sultriness
+    REAL(wp) ::  ireq_minimal   !< Minimal required clothing insulation (clo)
+    REAL(wp) ::  pmv_s          !< Fangers predicted mean vote for summer clothing
+    REAL(wp) ::  pmv_w          !< Fangers predicted mean vote for winter clothing
+    REAL(wp) ::  pmva           !< adjusted predicted mean vote
+    REAL(wp) ::  pmvs           !< pred. mean vote considering sultrieness
+    REAL(wp) ::  ptc            !< perceived temp. for cold conditions (degree_C)
+    REAL(wp) ::  sclo           !< summer clothing insulation
+    REAL(wp) ::  svp_ta         !< saturation vapor pressure    (hPa)
+    REAL(wp) ::  sult_lim       !< threshold for sultrieness    (hPa)
+    REAL(wp) ::  wclo           !< winter clothing insulation
+
 !
 !-- Initialise
@@ -2343 +2310 @@
 !
 !-- Tresholds: clothing insulation (account for model inaccuracies)
-!
-!-- summer clothing
+!-- Summer clothing
     sclo     = 0.44453_wp
 !
-!-- winter clothing
+!-- Winter clothing
     wclo     = 1.76267_wp
 !
-!-- decision: firstly calculate for winter or summer clothing
-    IF ( ta <= 10._wp )  THEN
+!-- Eecision: first calculate for winter or summer clothing
+    IF ( ta <= 10.0_wp )  THEN
 !
 !--    First guess: winter clothing insulation: cold stress
@@ -2358 +2324 @@
        pmv_w = pmva
 
-       IF ( pmva > 0._wp )  THEN
+       IF ( pmva > 0.0_wp )  THEN
 !
 !--       Case summer clothing insulation: heat load ?
@@ -2364 +2330 @@
           CALL fanger ( ta, tmrt, vp, ws, pair, clo, actlev, eta, pmva )
           pmv_s = pmva
-          IF ( pmva <= 0._wp )  THEN
-!
-!--          Case: comfort achievable by varying clothing insulation 
-!--          Between winter and summer set values
-             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta, sclo,      &
-                pmv_s, wclo, pmv_w, eps, pmva, ncount, clo )
+          IF ( pmva <= 0.0_wp )  THEN
+!
+!--          Case: comfort achievable by varying clothing insulation between winter and summer set
+!--                values
+             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta, sclo, pmv_s, wclo, pmv_w, eps, &
+                               pmva, ncount, clo )
              IF ( ncount < 0_iwp )  THEN
                 nerr = -1_iwp
@@ -2376 +2342 @@
           ELSE IF ( pmva > 0.06_wp )  THEN
              clo = 0.5_wp
-             CALL fanger ( ta, tmrt, vp, ws, pair, clo, actlev, eta,           &
-                           pmva )
+             CALL fanger ( ta, tmrt, vp, ws, pair, clo, actlev, eta,  pmva )
           ENDIF
-       ELSE IF ( pmva < -0.11_wp )  THEN
+       ELSE IF ( pmva < - 0.11_wp )  THEN
           clo = 1.75_wp
           CALL fanger ( ta, tmrt, vp, ws, pair, clo, actlev, eta, pmva )
@@ -2390 +2355 @@
        pmv_s = pmva
 
-       IF ( pmva < 0._wp )  THEN
+       IF ( pmva < 0.0_wp )  THEN
 !
 !--       Case winter clothing insulation: cold stress ?
@@ -2397 +2362 @@
           pmv_w = pmva
 
-          IF ( pmva >= 0._wp )  THEN
-!
-!--          Case: comfort achievable by varying clothing insulation 
-!--          between winter and summer set values
-             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta, sclo,      &
-                               pmv_s, wclo, pmv_w, eps, pmva, ncount, clo )
+          IF ( pmva >= 0.0_wp )  THEN
+!
+!--          Case: comfort achievable by varying clothing insulation between winter and summer set
+!--                values
+             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta, sclo, pmv_s, wclo, pmv_w, eps, &
+                               pmva, ncount, clo )
              IF ( ncount < 0_iwp )  THEN
                 nerr = -1_iwp
                 RETURN
              ENDIF
-          ELSE IF ( pmva < -0.11_wp )  THEN
+          ELSE IF ( pmva < - 0.11_wp )  THEN
              clo = 1.75_wp
-             CALL fanger ( ta, tmrt, vp, ws, pair, clo, actlev, eta,           &
-                           pmva )
+             CALL fanger ( ta, tmrt, vp, ws, pair, clo, actlev, eta, pmva )
           ENDIF
        ELSE IF ( pmva > 0.06_wp )  THEN
@@ -2423 +2387 @@
     CALL perct_regression( pmva, clo, perct_ij )
     ptc = perct_ij
-    IF ( clo >= 1.75_wp  .AND.  pmva <= -0.11_wp )  THEN
+    IF ( clo >= 1.75_wp  .AND.  pmva <= - 0.11_wp )  THEN
 !
 !--    Adjust for cold conditions according to Gagge 1986
@@ -2429 +2393 @@
        IF ( nerr_cold > 0_iwp )  nerr = -5_iwp
        pmvs = pmva - d_pmv
-       IF ( pmvs > -0.11_wp )  THEN
-          d_pmv  = 0._wp
-          pmvs   = -0.11_wp
+       IF ( pmvs > - 0.11_wp )  THEN
+          d_pmv  = 0.0_wp
+          pmvs   = - 0.11_wp
        ENDIF
        CALL perct_regression( pmvs, clo, perct_ij )
@@ -2439 +2403 @@
     IF ( clo > 0.5_wp  .AND.  perct_ij <= 8.73_wp )  THEN
 !
-!--    Required clothing insulation (ireq) is exclusively defined for 
-!--    perceived temperatures (perct) less 10 (C) for a 
-!--    reference wind of 0.2 m/s according to 8.73 (C) for 0.1 m/s
+!--    Required clothing insulation (ireq) is exclusively defined for perceived temperatures (perct)
+!--    less 10 (C) for a reference wind of 0.2 m/s according to 8.73 (C) for 0.1 m/s.
        clon = ireq_neutral ( perct_ij, ireq_minimal, nerr )
        clo = clon
@@ -2447 +2410 @@
     CALL calc_sultr( ptc, dgtcm, dgtcstd, sult_lim )
     sultrieness    = .FALSE.
-    d_std = -99._wp
+    d_std = -99.0_wp
     IF ( pmva > 0.06_wp  .AND.  clo <= 0.5_wp )  THEN
 !
@@ -2455 +2418 @@
        pmvs   = pmva + d_pmv
        CALL perct_regression( pmvs, clo, perct_ij )
-       IF ( sult_lim < 99._wp )  THEN
+       IF ( sult_lim < 99.0_wp )  THEN
           IF ( (perct_ij - ptc) > sult_lim )  sultrieness = .TRUE.
 !
@@ -2467 +2430 @@
  END SUBROUTINE calculate_perct_static
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> The SUBROUTINE calculates the (saturation) water vapour pressure 
-!> (hPa = hecto Pascal) for a given temperature ta (degC).
-!> 'ta' can be the air temperature or the dew point temperature. The first will
-!> result in the current vapor pressure (hPa), the latter will calulate the
-!> saturation vapor pressure (hPa).
-!------------------------------------------------------------------------------!
+!> The SUBROUTINE calculates the (saturation) water vapour pressure (hPa = hecto Pascal) for a given
+!> temperature ta (degC).
+!>'ta' can be the air temperature or the dew point temperature. The first will result in the current
+!> vapor pressure (hPa), the latter will calulate the saturation vapor pressure (hPa).
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE saturation_vapor_pressure( ta, svp_ta )
 
@@ -2487 +2449 @@
 
 
-    IF ( ta < 0._wp )  THEN
+    IF ( ta < 0.0_wp )  THEN
 !
 !--    ta  < 0 (degC): water vapour pressure over ice
@@ -2504 +2466 @@
  END SUBROUTINE saturation_vapor_pressure
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Find the clothing insulation value clo_res (clo) to make Fanger's Predicted
-!> Mean Vote (PMV) equal comfort (pmva=0) for actual meteorological conditions 
-!> (ta,tmrt, vp, ws, pair) and values of individual's activity level
-!------------------------------------------------------------------------------!
- SUBROUTINE iso_ridder( ta, tmrt, vp, ws, pair, actlev, eta, sclo,             &
-                       pmv_s, wclo, pmv_w, eps, pmva, nerr,               &
-                       clo_res )
+!> Find the clothing insulation value clo_res (clo) to make Fanger's Predicted Mean Vote (PMV) equal
+!> comfort (pmva=0) for actual meteorological conditions (ta,tmrt, vp, ws, pair) and values of
+!> individual's activity level.
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE iso_ridder( ta, tmrt, vp, ws, pair, actlev, eta, sclo, pmv_s, wclo, pmv_w, eps, pmva,  &
+                        nerr, clo_res )
 
     IMPLICIT NONE
 !
 !-- Input variables of argument list:
+    REAL(wp), INTENT ( IN )  :: actlev   !< Individuals activity level per unit surface area (W/m2)
+    REAL(wp), INTENT ( IN )  :: eps      !< (0.05) accuracy in clothing insulation (clo) for evaluation the root of Fanger's PMV (pmva=0)
+    REAL(wp), INTENT ( IN )  :: eta      !< Individuals work efficiency (dimensionless)
+    REAL(wp), INTENT ( IN )  :: pair     !< Barometric air pressure (hPa)
+    REAL(wp), INTENT ( IN )  :: pmv_s    !< Fanger's PMV corresponding to sclo
+    REAL(wp), INTENT ( IN )  :: pmv_w    !< Fanger's PMV corresponding to wclo
+    REAL(wp), INTENT ( IN )  :: sclo     !< Lower threshold of bracketing clothing insulation (clo)
     REAL(wp), INTENT ( IN )  :: ta       !< Ambient temperature (degC)
     REAL(wp), INTENT ( IN )  :: tmrt     !< Mean radiant temperature (degC)
     REAL(wp), INTENT ( IN )  :: vp       !< Water vapour pressure (hPa)
+    REAL(wp), INTENT ( IN )  :: wclo     !< Upper threshold of bracketing clothing insulation (clo)
     REAL(wp), INTENT ( IN )  :: ws       !< Wind speed (m/s) 1 m above ground
-    REAL(wp), INTENT ( IN )  :: pair     !< Barometric air pressure (hPa)
-    REAL(wp), INTENT ( IN )  :: actlev   !< Individuals activity level per unit surface area (W/m2)
-    REAL(wp), INTENT ( IN )  :: eta      !< Individuals work efficiency (dimensionless)
-    REAL(wp), INTENT ( IN )  :: sclo     !< Lower threshold of bracketing clothing insulation (clo) 
-    REAL(wp), INTENT ( IN )  :: wclo     !< Upper threshold of bracketing clothing insulation (clo)
-    REAL(wp), INTENT ( IN )  :: eps      !< (0.05) accuracy in clothing insulation (clo) for 
-!                                          evaluation the root of Fanger's PMV (pmva=0)
-    REAL(wp), INTENT ( IN )  :: pmv_w    !< Fanger's PMV corresponding to wclo
-    REAL(wp), INTENT ( IN )  :: pmv_s    !< Fanger's PMV corresponding to sclo
 !
 !-- Output variables of argument list:
-    REAL(wp), INTENT ( OUT ) :: pmva     !< 0 (set to zero, because clo is evaluated for comfort)
-    REAL(wp), INTENT ( OUT ) :: clo_res  !< Resulting clothing insulation value (clo)
     INTEGER(iwp), INTENT ( OUT ) :: nerr !< Error status / quality flag
                                          !< nerr >= 0, o.k., and nerr is the number of iterations for convergence
                                          !< nerr = -1: error = malfunction of Ridder's convergence method
-                                         !< nerr = -2: error = maximum iterations (max_iteration) exceeded 
+                                         !< nerr = -2: error = maximum iterations (max_iteration) exceeded
                                          !< nerr = -3: error = root not bracketed between sclo and wclo
+
+    REAL(wp), INTENT ( OUT ) :: clo_res  !< Resulting clothing insulation value (clo)
+    REAL(wp), INTENT ( OUT ) :: pmva     !< 0 (set to zero, because clo is evaluated for comfort)
 !
 !-- Type of program variables
     INTEGER(iwp), PARAMETER  ::  max_iteration = 15_iwp       !< max number of iterations
+    INTEGER(iwp) ::  j       !< running index
+
     REAL(wp),     PARAMETER  ::  guess_0       = -1.11e30_wp  !< initial guess
-    REAL(wp) ::  x_ridder    !< current guess for clothing insulation   (clo)
+
     REAL(wp) ::  clo_lower   !< lower limit of clothing insulation      (clo)
     REAL(wp) ::  clo_upper   !< upper limit of clothing insulation      (clo)
+    REAL(wp) ::  sroot       !< sqrt of PMV-guess
+    REAL(wp) ::  x_average   !< average of x_lower and x_upper          (clo)
     REAL(wp) ::  x_lower     !< lower guess for clothing insulation     (clo)
+    REAL(wp) ::  x_new       !< preliminary result for clothing insulation (clo)
+    REAL(wp) ::  x_ridder    !< current guess for clothing insulation   (clo)
     REAL(wp) ::  x_upper     !< upper guess for clothing insulation     (clo)
-    REAL(wp) ::  x_average   !< average of x_lower and x_upper          (clo)
-    REAL(wp) ::  x_new       !< preliminary result for clothing insulation (clo)
+    REAL(wp) ::  y_average   !< average of y_lower and y_upper
+    REAL(wp) ::  y_new       !< preliminary result for pred. mean vote
     REAL(wp) ::  y_lower     !< predicted mean vote for summer clothing
     REAL(wp) ::  y_upper     !< predicted mean vote for winter clothing
-    REAL(wp) ::  y_average   !< average of y_lower and y_upper
-    REAL(wp) ::  y_new       !< preliminary result for pred. mean vote
-    REAL(wp) ::  sroot       !< sqrt of PMV-guess
-    INTEGER(iwp) ::  j       !< running index
 !
 !-- Initialise
@@ -2563 +2526 @@
 !-- Set pmva = 0 (comfort): Root of PMV depending on clothing insulation
     x_ridder    = bio_fill_value
-    pmva        = 0._wp
+    pmva        = 0.0_wp
     clo_lower   = sclo
     y_lower     = pmv_s
     clo_upper   = wclo
     y_upper     = pmv_w
-    IF ( ( y_lower > 0._wp  .AND.  y_upper < 0._wp )  .OR.                     &
-         ( y_lower < 0._wp  .AND.  y_upper > 0._wp ) )  THEN
+    IF ( ( y_lower > 0.0_wp .AND. y_upper < 0.0_wp )  .OR.                                         &
+         ( y_lower < 0.0_wp .AND. y_upper > 0.0_wp ) )  THEN
        x_lower  = clo_lower
        x_upper  = clo_upper
@@ -2576 +2539 @@
        DO  j = 1_iwp, max_iteration
           x_average = 0.5_wp * ( x_lower + x_upper )
-          CALL fanger ( ta, tmrt, vp, ws, pair, x_average, actlev, eta,        &
-                        y_average )
+          CALL fanger ( ta, tmrt, vp, ws, pair, x_average, actlev, eta, y_average )
           sroot = SQRT( y_average**2 - y_lower * y_upper )
           IF ( ABS( sroot ) < 0.00001_wp )  THEN
@@ -2584 +2546 @@
              RETURN
           ENDIF
-          x_new = x_average + ( x_average - x_lower ) *                        &
-                      ( SIGN ( 1._wp, y_lower - y_upper ) * y_average / sroot )
+          x_new = x_average + ( x_average - x_lower ) *                                            &
+                  ( SIGN ( 1.0_wp, y_lower - y_upper ) * y_average / sroot )
           IF ( ABS( x_new - x_ridder ) <= eps )  THEN
              clo_res = x_ridder
@@ -2592 +2554 @@
           ENDIF
           x_ridder = x_new
-          CALL fanger ( ta, tmrt, vp, ws, pair, x_ridder, actlev, eta,         &
-                        y_new )
+          CALL fanger ( ta, tmrt, vp, ws, pair, x_ridder, actlev, eta, y_new )
           IF ( ABS( y_new ) < 0.00001_wp )  THEN
              clo_res = x_ridder
@@ -2612 +2573 @@
           ELSE
 !
-!--          Never get here in x_ridder: singularity in y
+!--          Never get here in x_ridder: SINgularity in y
              nerr    = -1_iwp
              clo_res = x_ridder
@@ -2642 +2603 @@
  END SUBROUTINE iso_ridder
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Regression relations between perceived temperature (perct) and (adjusted) 
-!> PMV. The regression presumes the Klima-Michel settings for reference 
-!> individual and reference environment.
-!------------------------------------------------------------------------------!
+!> Regression relations between perceived temperature (perct) and (adjusted) PMV. The regression
+!> presumes the Klima-Michel settings for reference individual and reference environment.
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE perct_regression( pmv, clo, perct_ij )
 
     IMPLICIT NONE
 
+    REAL(wp), INTENT ( IN ) ::  clo   !< clothing insulation index (clo)
     REAL(wp), INTENT ( IN ) ::  pmv   !< Fangers predicted mean vote (dimensionless)
-    REAL(wp), INTENT ( IN ) ::  clo   !< clothing insulation index (clo)
 
     REAL(wp), INTENT ( OUT ) ::  perct_ij   !< perct (degC) corresponding to given PMV / clo
 
-    IF ( pmv <= -0.11_wp )  THEN
+    IF ( pmv <= - 0.11_wp )  THEN
        perct_ij = 5.805_wp + 12.6784_wp * pmv
     ELSE
@@ -2670 +2630 @@
  END SUBROUTINE perct_regression
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> FANGER.F90
 !>
-!> SI-VERSION: ACTLEV W m-2, DAMPFDRUCK hPa
-!> Berechnet das aktuelle Predicted Mean Vote nach Fanger
-!>
+!> SI-VERSION: ACTLEV W m-2, VAPOUR PRESSURE hPa
+!> Calculates the current Predicted Mean Vote according to Fanger.
 !> The case of free convection (ws < 0.1 m/s) is dealt with ws = 0.1 m/s
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE fanger( ta, tmrt, pa, in_ws, pair, in_clo, actlev, eta, pmva )
 
@@ -2685 +2644 @@
 !
 !-- Input variables of argument list:
+    REAL(wp), INTENT ( IN ) ::  actlev   !< Individuals activity level per unit surface area (W/m2)
+    REAL(wp), INTENT ( IN ) ::  eta      !< Individuals mechanical work efficiency (dimensionless)
+    REAL(wp), INTENT ( IN ) ::  in_clo   !< Clothing insulation (clo)
+    REAL(wp), INTENT ( IN ) ::  in_ws    !< Wind speed (m/s) 1 m above ground
+    REAL(wp), INTENT ( IN ) ::  pa       !< Water vapour pressure (hPa)
+    REAL(wp), INTENT ( IN ) ::  pair     !< Barometric pressure (hPa) at site
     REAL(wp), INTENT ( IN ) ::  ta       !< Ambient air temperature (degC)
     REAL(wp), INTENT ( IN ) ::  tmrt     !< Mean radiant temperature (degC)
-    REAL(wp), INTENT ( IN ) ::  pa       !< Water vapour pressure (hPa)
-    REAL(wp), INTENT ( IN ) ::  pair     !< Barometric pressure (hPa) at site
-    REAL(wp), INTENT ( IN ) ::  in_ws    !< Wind speed (m/s) 1 m above ground
-    REAL(wp), INTENT ( IN ) ::  in_clo   !< Clothing insulation (clo)
-    REAL(wp), INTENT ( IN ) ::  actlev   !< Individuals activity level per unit surface area (W/m2)
-    REAL(wp), INTENT ( IN ) ::  eta      !< Individuals mechanical work efficiency (dimensionless)
+
 !
 !-- Output variables of argument list:
-    REAL(wp), INTENT ( OUT ) ::  pmva    !< Actual Predicted Mean Vote (PMV, 
-                                         !< dimensionless) according to Fanger corresponding to meteorological 
+    REAL(wp), INTENT ( OUT ) ::  pmva    !< Actual Predicted Mean Vote (PMV,
+                                         !< dimensionless) according to Fanger corresponding to meteorological
                                          !< (ta,tmrt,pa,ws,pair) and individual variables (clo, actlev, eta)
 !
 !-- Internal variables
-    REAL(wp) ::  f_cl         !< Increase in surface due to clothing    (factor)
-    REAL(wp) ::  heat_convection  !< energy loss by autocnvection       (W)
+    INTEGER(iwp) :: i         !< running index
+
     REAL(wp) ::  activity     !< persons activity  (must stay == actlev, W)
-    REAL(wp) ::  t_skin_aver  !< average skin temperature               (degree_C)
     REAL(wp) ::  bc           !< preliminary result storage
     REAL(wp) ::  cc           !< preliminary result storage
+    REAL(wp) ::  clo          !< clothing insulation index              (clo)
     REAL(wp) ::  dc           !< preliminary result storage
     REAL(wp) ::  ec           !< preliminary result storage
+    REAL(wp) ::  f_cl         !< Increase in surface due to clothing    (factor)
     REAL(wp) ::  gc           !< preliminary result storage
+    REAL(wp) ::  heat_convection  !< energy loss by autocnvection       (W)
+    REAL(wp) ::  hr           !< radiational heat resistence
     REAL(wp) ::  t_clothing   !< clothing temperature                   (degree_C)
-    REAL(wp) ::  hr           !< radiational heat resistence
-    REAL(wp) ::  clo          !< clothing insulation index              (clo)
+    REAL(wp) ::  t_skin_aver  !< average skin temperature               (degree_C)
     REAL(wp) ::  ws           !< wind speed                             (m/s)
-    REAL(wp) ::  z1           !< Empiric factor for the adaption of the heat 
+    REAL(wp) ::  z1           !< Empiric factor for the adaption of the heat
                               !< ballance equation to the psycho-physical scale (Equ. 40 in FANGER)
     REAL(wp) ::  z2           !< Water vapour diffution through the skin
@@ -2720 +2682 @@
     REAL(wp) ::  z5           !< Loss of radiational heat
     REAL(wp) ::  z6           !< Heat loss through forced convection
-    INTEGER(iwp) :: i         !< running index
+
 !
 !-- Clo must be > 0. to avoid div. by 0!
     clo = in_clo
-    IF ( clo <= 0._wp )  clo = .001_wp
-!
-!-- f_cl = Increase in surface due to clothing
-    f_cl = 1._wp + .15_wp * clo
+    IF ( clo <= 0.0_wp )  clo = .001_wp
+!
+!-- f_cl = increase in surface due to clothing
+    f_cl = 1.0_wp + 0.15_wp * clo
 !
 !-- Case of free convection (ws < 0.1 m/s ) not considered
     ws = in_ws
-    IF ( ws < .1_wp )  THEN
-       ws = .1_wp
+    IF ( ws < 0.1_wp )  THEN
+       ws = 0.1_wp
     ENDIF
 !
@@ -2738 +2700 @@
     heat_convection = 12.1_wp * SQRT( ws * pair / 1013.25_wp )
 !
-!-- Activity = inner heat produktion per standardized surface
-    activity = actlev * ( 1._wp - eta )
-!
-!-- T_skin_aver = average skin temperature
-    t_skin_aver = 35.7_wp - .0275_wp * activity
+!-- Activity = inner heat production per standardized surface
+    activity = actlev * ( 1.0_wp - eta )
+!
+!-- t_skin_aver = average skin temperature
+    t_skin_aver = 35.7_wp - 0.0275_wp * activity
 !
 !-- Calculation of constants for evaluation below
-    bc = .155_wp * clo * 3.96_wp * 10._wp**( -8 ) * f_cl
+    bc = 0.155_wp * clo * 3.96_wp * 10.0_wp**( -8 ) * f_cl
     cc = f_cl * heat_convection
-    ec = .155_wp * clo
-    dc = ( 1._wp + ec * cc ) / bc
+    ec = 0.155_wp * clo
+    dc = ( 1.0_wp + ec * cc ) / bc
     gc = ( t_skin_aver + bc * ( tmrt + degc_to_k )**4 + ec * cc * ta ) / bc
 !
-!-- Calculation of clothing surface temperature (t_clothing) based on
-!-- Newton-approximation with air temperature as initial guess
+!-- Calculation of clothing surface temperature (t_clothing) based on Newton-approximation with air
+!-- temperature as initial guess.
     t_clothing = ta
     DO  i = 1, 3
-       t_clothing = t_clothing - ( ( t_clothing + degc_to_k )**4 + t_clothing  &
-          * dc - gc ) / ( 4._wp * ( t_clothing + degc_to_k )**3 + dc )
+       t_clothing = t_clothing - ( ( t_clothing + degc_to_k )**4 + t_clothing * dc - gc ) /        &
+                    ( 4.0_wp * ( t_clothing + degc_to_k )**3 + dc )
     ENDDO
 !
-!-- Empiric factor for the adaption of the heat ballance equation
-!-- to the psycho-physical scale (Equ. 40 in FANGER)
-    z1 = ( .303_wp * EXP( -.036_wp * actlev ) + .0275_wp )
+!-- Empiric factor for the adaption of the heat ballance equation to the psycho-physical scale (Equ.
+!-- 40 in FANGER)
+    z1 = ( 0.303_wp * EXP( - 0.036_wp * actlev ) + 0.0275_wp )
 !
 !-- Water vapour diffution through the skin
-    z2 = .31_wp * ( 57.3_wp - .07_wp * activity-pa )
+    z2 = 0.31_wp * ( 57.3_wp - 0.07_wp * activity-pa )
 !
 !-- Sweat evaporation from the skin surface
-    z3 = .42_wp * ( activity - 58._wp )
+    z3 = 0.42_wp * ( activity - 58.0_wp )
 !
 !-- Loss of latent heat through respiration
-    z4 = .0017_wp * actlev * ( 58.7_wp - pa ) + .0014_wp * actlev *            &
-      ( 34._wp - ta )
+    z4 = 0.0017_wp * actlev * ( 58.7_wp - pa ) + 0.0014_wp * actlev *                              &
+         ( 34.0_wp - ta )
 !
 !-- Loss of radiational heat
-    z5 = 3.96e-8_wp * f_cl * ( ( t_clothing + degc_to_k )**4 - ( tmrt +        &
-       degc_to_k )**4 )
-    IF ( ABS( t_clothing - tmrt ) > 0._wp )  THEN
+    z5 = 3.96e-8_wp * f_cl * ( ( t_clothing + degc_to_k )**4 - ( tmrt + degc_to_k )**4 )
+    IF ( ABS( t_clothing - tmrt ) > 0.0_wp )  THEN
        hr = z5 / f_cl / ( t_clothing - tmrt )
     ELSE
-       hr = 0._wp
+       hr = 0.0_wp
     ENDIF
 !
@@ -2790 +2751 @@
  END SUBROUTINE fanger
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> For pmva > 0 and clo =0.5 the increment (deltapmv) is calculated
-!> that converts pmva into Gagge's et al. (1986) PMV*.
-!------------------------------------------------------------------------------!
+!> For pmva > 0 and clo =0.5 the increment (deltapmv) is calculated that converts pmva into Gagge's
+!> et al. (1986) PMV*.
+!--------------------------------------------------------------------------------------------------!
  REAL(wp) FUNCTION deltapmv( pmva, ta, vp, svp_ta, tmrt, ws, nerr )
 
@@ -2803 +2764 @@
 !-- Input variables of argument list:
     REAL(wp),     INTENT ( IN )  :: pmva     !< Actual Predicted Mean Vote (PMV) according to Fanger
+    REAL(wp),     INTENT ( IN )  :: svp_ta   !< Saturation water vapour pressure (hPa) at ta
     REAL(wp),     INTENT ( IN )  :: ta       !< Ambient temperature (degC) at screen level
+    REAL(wp),     INTENT ( IN )  :: tmrt     !< Mean radiant temperature (degC) at screen level
     REAL(wp),     INTENT ( IN )  :: vp       !< Water vapour pressure (hPa) at screen level
-    REAL(wp),     INTENT ( IN )  :: svp_ta   !< Saturation water vapour pressure (hPa) at ta
-    REAL(wp),     INTENT ( IN )  :: tmrt     !< Mean radiant temperature (degC) at screen level
     REAL(wp),     INTENT ( IN )  :: ws       !< Wind speed (m/s) 1 m above ground
 
@@ -2819 +2780 @@
 !
 !-- Internal variables:
-    REAL(wp) ::  pmv          !< temp storage og predicted mean vote
-    REAL(wp) ::  pa_p50       !< ratio actual water vapour pressure to that of relative humidity of 50 %
-    REAL(wp) ::  pa           !< vapor pressure (hPa) with hard bounds
+    INTEGER(iwp) :: nreg      !<
+
     REAL(wp) ::  apa          !< natural logarithm of pa (with hard lower border)
     REAL(wp) ::  dapa         !< difference of apa and pa_p50
-    REAL(wp) ::  sqvel        !< square root of local wind velocity
+    REAL(wp) ::  dpmv_1       !<
+    REAL(wp) ::  dpmv_2       !<
     REAL(wp) ::  dtmrt        !< difference mean radiation to air temperature
+    REAL(wp) ::  pa           !< vapor pressure (hPa) with hard bounds
+    REAL(wp) ::  pa_p50       !< ratio actual water vapour pressure to that of relative humidity of 
+                              !< 50 %
+    REAL(wp) ::  pmv          !< temp storage og predicted mean vote
+    REAL(wp) ::  pmvs         !<
     REAL(wp) ::  p10          !< lower bound for pa
     REAL(wp) ::  p95          !< upper bound for pa
-    REAL(wp) ::  weight       !< 
-    REAL(wp) ::  weight2      !< 
-    REAL(wp) ::  dpmv_1       !< 
-    REAL(wp) ::  dpmv_2       !< 
-    REAL(wp) ::  pmvs         !< 
-    INTEGER(iwp) :: nreg      !< 
+    REAL(wp) ::  sqvel        !< square root of local wind velocity
+    REAL(wp) ::  weight       !<
+    REAL(wp) ::  weight2      !<
 
 !
 !-- Regression coefficients:
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bpmv = (/                          &
-     -0.0556602_wp, -0.1528680_wp, -0.2336104_wp, -0.2789387_wp,               &
-     -0.3551048_wp, -0.4304076_wp, -0.4884961_wp, -0.4897495_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bpa_p50 = (/                       &
-     -0.1607154_wp, -0.4177296_wp, -0.4120541_wp, -0.0886564_wp,               &
-      0.4285938_wp,  0.6281256_wp,  0.5067361_wp,  0.3965169_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bpa = (/                           &
-      0.0580284_wp,  0.0836264_wp,  0.1009919_wp,  0.1020777_wp,               &
-      0.0898681_wp,  0.0839116_wp,  0.0853258_wp,  0.0866589_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bapa = (/                          &
-     -1.7838788_wp, -2.9306231_wp, -1.6350334_wp,   0.6211547_wp,              &
-      3.3918083_wp,  5.5521025_wp,  8.4897418_wp,  16.6265851_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bdapa = (/                         &
-      1.6752720_wp,  2.7379504_wp,  1.2940526_wp,  -1.0985759_wp,              &
-     -3.9054732_wp, -6.0403012_wp, -8.9437119_wp, -17.0671201_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bsqvel = (/                        &
-     -0.0315598_wp, -0.0286272_wp, -0.0009228_wp,  0.0483344_wp,               &
-      0.0992366_wp,  0.1491379_wp,  0.1951452_wp,  0.2133949_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bta = (/                           &
-      0.0953986_wp,  0.1524760_wp,  0.0564241_wp, -0.0893253_wp,               &
-     -0.2398868_wp, -0.3515237_wp, -0.5095144_wp, -0.9469258_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  bdtmrt = (/                        &
-     -0.0004672_wp, -0.0000514_wp, -0.0018037_wp, -0.0049440_wp,               &
-     -0.0069036_wp, -0.0075844_wp, -0.0079602_wp, -0.0089439_wp /)
-
-    REAL(wp), DIMENSION(0:7), PARAMETER ::  aconst = (/                        &
-      1.8686215_wp,  3.4260713_wp,   2.0116185_wp,  -0.7777552_wp,             &
-     -4.6715853_wp, -7.7314281_wp, -11.7602578_wp, -23.5934198_wp /)
+    REAL(wp), DIMENSION(0:7), PARAMETER ::  bpmv = (/                                              &
+     - 0.0556602_wp, - 0.1528680_wp, - 0.2336104_wp, - 0.2789387_wp,                               &
+     - 0.3551048_wp, - 0.4304076_wp, - 0.4884961_wp, - 0.4897495_wp /)
+
+    REAL(wp), DIMENSION(0:7), PARAMETER ::  bpa_p50 = (/                                           &
+     - 0.1607154_wp, - 0.4177296_wp, - 0.4120541_wp, - 0.0886564_wp,                               &
+       0.4285938_wp,   0.6281256_wp,   0.5067361_wp,   0.3965169_wp /)
+
+    REAL(wp), DIMENSION(0:7), PARAMETER ::  bpa = (/                                               &
+       0.0580284_wp,   0.0836264_wp,   0.1009919_wp,   0.1020777_wp,                               &
+       0.0898681_wp,   0.0839116_wp,   0.0853258_wp,   0.0866589_wp /)
+
+    REAL(wp), DIMENSION(0:7), PARAMETER ::  bapa = (/                                              &
+     - 1.7838788_wp, - 2.9306231_wp, - 1.6350334_wp,    0.6211547_wp,                              &
+       3.3918083_wp,   5.5521025_wp,   8.4897418_wp,   16.6265851_wp /)
+
+    REAL(wp), DIMENSION(0:7), PARAMETER ::  bdapa = (/                                             &
+       1.6752720_wp,   2.7379504_wp,   1.2940526_wp, -  1.0985759_wp,                              &
+     - 3.9054732_wp, - 6.0403012_wp, - 8.9437119_wp, - 17.0671201_wp /)
+
+    REAL(wp), DIMENSION(0:7), PARAMETER ::  bsqvel = (/                                            &
+     - 0.0315598_wp, - 0.0286272_wp, - 0.0009228_wp,   0.0483344_wp,                               &
+       0.0992366_wp,   0.1491379_wp,   0.1951452_wp,   0.2133949_wp /)
+
+    REAL(wp), DIMENSION(0:7), PARAMETER ::  bta = (/                                               &
+       0.0953986_wp,   0.1524760_wp,   0.0564241_wp, - 0.0893253_wp,                               &
+     - 0.2398868_wp, - 0.3515237_wp, - 0.5095144_wp, - 0.9469258_wp /)
+
+    REAL(wp), DIMENSION(0:7), PARAMETER ::  bdtmrt = (/                                            &
+     - 0.0004672_wp, - 0.0000514_wp, - 0.0018037_wp, - 0.0049440_wp,                               &
+     - 0.0069036_wp, - 0.0075844_wp, - 0.0079602_wp, - 0.0089439_wp /)
+
+    REAL(wp), DIMENSION(0:7), PARAMETER ::  aconst = (/                                            &
+       1.8686215_wp,   3.4260713_wp,    2.0116185_wp, -  0.7777552_wp,                             &
+     - 4.6715853_wp, - 7.7314281_wp, - 11.7602578_wp, - 23.5934198_wp /)
 
 
@@ -2885 +2848 @@
     pmv  = pmva
 !
-!-- Water vapour pressure of air 
+!-- Water vapour pressure of air
     p10  = 0.05_wp * svp_ta
     p95  = 1.00_wp * svp_ta
@@ -2902 +2865 @@
        ENDIF
     ENDIF
-    IF ( pa > 0._wp )  THEN
+    IF ( pa > 0.0_wp )  THEN
 !
 !--    Natural logarithm of pa
        apa = LOG( pa )
     ELSE
-       apa = -5._wp
+       apa = -5.0_wp
     ENDIF
 !
 !-- Ratio actual water vapour pressure to that of a r.H. of 50 %
     pa_p50   = 0.5_wp * svp_ta
-    IF ( pa_p50 > 0._wp  .AND.  pa > 0._wp )  THEN
+    IF ( pa_p50 > 0.0_wp  .AND.  pa > 0.0_wp )  THEN
        dapa   = apa - LOG( pa_p50 )
        pa_p50 = pa / pa_p50
     ELSE
-       dapa   = -5._wp
-       pa_p50 = 0._wp
+       dapa   = -5.0_wp
+       pa_p50 = 0.0_wp
     ENDIF
 !
 !-- Square root of wind velocity
-    IF ( ws >= 0._wp )  THEN
+    IF ( ws >= 0.0_wp )  THEN
        sqvel = SQRT( ws )
     ELSE
-       sqvel = 0._wp
+       sqvel = 0.0_wp
     ENDIF
 !
@@ -2934 +2897 @@
     IF ( nreg < 0_iwp )  THEN
 !
-!--    value of the FUNCTION in the case pmv <= -1
-       deltapmv = 0._wp
+!--    Value of the FUNCTION in the case pmv <= -1
+       deltapmv = 0.0_wp
        RETURN
     ENDIF
-    weight = MOD ( pmv, 1._wp )
-    IF ( weight < 0._wp )  weight = 0._wp
+    weight = MOD ( pmv, 1.0_wp )
+    IF ( weight < 0.0_wp )  weight = 0.0_wp
     IF ( nreg > 5_iwp )  THEN
        nreg  = 5_iwp
-       weight   = pmv - 5._wp
-       weight2  = pmv - 6._wp
+       weight   = pmv - 5.0_wp
+       weight2  = pmv - 6.0_wp
        IF ( weight2 > 0_iwp )  THEN
           weight = ( weight - weight2 ) / weight
@@ -2950 +2913 @@
 !
 !-- Regression valid for 0. <= pmv <= 6., bounds are checked above
-    dpmv_1 =                                                                   &
-       + bpa(nreg) * pa                                                        &
-       + bpmv(nreg) * pmv                                                      &
-       + bapa(nreg) * apa                                                      &
-       + bta(nreg) * ta                                                        &
-       + bdtmrt(nreg) * dtmrt                                                  &
-       + bdapa(nreg) * dapa                                                    &
-       + bsqvel(nreg) * sqvel                                                  &
-       + bpa_p50(nreg) * pa_p50                                                &
-       + aconst(nreg)
-
-!    dpmv_2 = 0._wp
+    dpmv_1 =                                                                                       &
+             + bpa(nreg)     * pa                                                                  &
+             + bpmv(nreg)    * pmv                                                                 &
+             + bapa(nreg)    * apa                                                                 &
+             + bta(nreg)     * ta                                                                  &
+             + bdtmrt(nreg)  * dtmrt                                                               &
+             + bdapa(nreg)   * dapa                                                                &
+             + bsqvel(nreg)  * sqvel                                                               &
+             + bpa_p50(nreg) * pa_p50                                                              &
+             + aconst(nreg)
+
+!    dpmv_2 = 0.0_wp
 !    IF ( nreg < 6_iwp )  THEN  !< nreg is always <= 5, see above
-    dpmv_2 =                                                                   &
-       + bpa(nreg+1_iwp)     * pa                                              &
-       + bpmv(nreg+1_iwp)    * pmv                                             &
-       + bapa(nreg+1_iwp)    * apa                                             &
-       + bta(nreg+1_iwp)     * ta                                              &
-       + bdtmrt(nreg+1_iwp)  * dtmrt                                           &
-       + bdapa(nreg+1_iwp)   * dapa                                            &
-       + bsqvel(nreg+1_iwp)  * sqvel                                           &
-       + bpa_p50(nreg+1_iwp) * pa_p50                                          &
-       + aconst(nreg+1_iwp)
+    dpmv_2 =                                                                                       &
+             + bpa(nreg+1_iwp)     * pa                                                            &
+             + bpmv(nreg+1_iwp)    * pmv                                                           &
+             + bapa(nreg+1_iwp)    * apa                                                           &
+             + bta(nreg+1_iwp)     * ta                                                            &
+             + bdtmrt(nreg+1_iwp)  * dtmrt                                                         &
+             + bdapa(nreg+1_iwp)   * dapa                                                          &
+             + bsqvel(nreg+1_iwp)  * sqvel                                                         &
+             + bpa_p50(nreg+1_iwp) * pa_p50                                                        &
+             + aconst(nreg+1_iwp)
 !    ENDIF
 !
 !-- Calculate pmv modification
-    deltapmv = ( 1._wp - weight ) * dpmv_1 + weight * dpmv_2
+    deltapmv = ( 1.0_wp - weight ) * dpmv_1 + weight * dpmv_2
     pmvs = pmva + deltapmv
-    IF ( ( pmvs ) < 0._wp )  THEN
+    IF ( ( pmvs ) < 0.0_wp )  THEN
 !
 !--    Prevent negative pmv* due to problems with clothing insulation
@@ -2989 +2952 @@
 !
 !--       Set pmvs to "0" for compliance with summer clothing insulation
-          deltapmv = -1._wp * pmva
+          deltapmv = -1.0_wp * pmva
        ENDIF
     ENDIF
@@ -2995 +2958 @@
  END FUNCTION deltapmv
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> The subroutine "calc_sultr" returns a threshold value to perceived 
-!> temperature allowing to decide whether the actual perceived temperature 
-!> is linked to perecption of sultriness. The threshold values depends 
-!> on the Fanger's classical PMV, expressed here as perceived temperature 
-!> perct. 
-!------------------------------------------------------------------------------!
+!> The subroutine "calc_sultr" returns a threshold value to perceived temperature allowing to decide
+!> whether the actual perceived temperature is linked to perecption of sultriness. The threshold
+!> values depends on the Fanger's classical PMV, expressed here as perceived temperature perct.
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE calc_sultr( perct_ij, dperctm, dperctstd, sultr_res )
 
@@ -3009 +2970 @@
 !
 !-- Input of the argument list:
-    REAL(wp), INTENT ( IN )  ::  perct_ij      !< Classical perceived temperature: Base is Fanger's PMV
+    REAL(wp), INTENT ( IN )  ::  perct_ij   !< Classical perceived temperature: Base is Fanger's PMV
 !
 !-- Additional output variables of argument list:
-    REAL(wp), INTENT ( OUT ) ::  dperctm    !< Mean deviation perct (classical gt) to gt* (rational gt 
-                                            !< calculated based on Gagge's rational PMV*)
-    REAL(wp), INTENT ( OUT ) ::  dperctstd  !< dperctm plus its standard deviation times a factor 
+    REAL(wp), INTENT ( OUT ) ::  dperctm    !< Mean deviation perct (classical gt) to gt* (rational 
+                                            !< gt calculated based on Gagge's rational PMV*)
+    REAL(wp), INTENT ( OUT ) ::  dperctstd  !< dperctm plus its standard deviation times a factor
                                             !< determining the significance to perceive sultriness
     REAL(wp), INTENT ( OUT ) ::  sultr_res
 !
 !-- Types of coefficients mean deviation: third order polynomial
-    REAL(wp), PARAMETER ::  dperctka =  7.5776086_wp
-    REAL(wp), PARAMETER ::  dperctkb = -0.740603_wp
-    REAL(wp), PARAMETER ::  dperctkc =  0.0213324_wp
-    REAL(wp), PARAMETER ::  dperctkd = -0.00027797237_wp
+    REAL(wp), PARAMETER ::  dperctka =   7.5776086_wp
+    REAL(wp), PARAMETER ::  dperctkb = - 0.740603_wp
+    REAL(wp), PARAMETER ::  dperctkc =   0.0213324_wp
+    REAL(wp), PARAMETER ::  dperctkd = - 0.00027797237_wp
 !
 !-- Types of coefficients mean deviation plus standard deviation
 !-- regression coefficients: third order polynomial
-    REAL(wp), PARAMETER ::  dperctsa =  0.0268918_wp
-    REAL(wp), PARAMETER ::  dperctsb =  0.0465957_wp
-    REAL(wp), PARAMETER ::  dperctsc = -0.00054709752_wp
-    REAL(wp), PARAMETER ::  dperctsd =  0.0000063714823_wp
-!
-!-- Factor to mean standard deviation defining SIGNificance for 
+    REAL(wp), PARAMETER ::  dperctsa =   0.0268918_wp
+    REAL(wp), PARAMETER ::  dperctsb =   0.0465957_wp
+    REAL(wp), PARAMETER ::  dperctsc = - 0.00054709752_wp
+    REAL(wp), PARAMETER ::  dperctsd =   0.0000063714823_wp
+!
+!-- Factor to mean standard deviation defining SIGNificance for
 !-- sultriness
-    REAL(wp), PARAMETER :: faktor = 1._wp
+    REAL(wp), PARAMETER :: faktor = 1.0_wp
 !
 !-- Initialise
-    sultr_res = 99._wp
-    dperctm   = 0._wp
-    dperctstd = 999999._wp
-
-    IF ( perct_ij < 16.826_wp  .OR.  perct_ij > 56._wp )  THEN
+    sultr_res = 99.0_wp
+    dperctm   = 0.0_wp
+    dperctstd = 999999.0_wp
+
+    IF ( perct_ij < 16.826_wp  .OR.  perct_ij > 56.0_wp )  THEN
 !
 !--    Unallowed value of classical perct!
@@ -3047 +3008 @@
 !
 !-- Mean deviation dependent on perct
-    dperctm = dperctka + dperctkb * perct_ij + dperctkc * perct_ij**2._wp +    &
-       dperctkd * perct_ij**3._wp
+    dperctm = dperctka + dperctkb * perct_ij + dperctkc * perct_ij**2.0_wp + dperctkd *            &
+              perct_ij**3.0_wp
 !
 !-- Mean deviation plus its standard deviation
-    dperctstd = dperctsa + dperctsb * perct_ij + dperctsc * perct_ij**2._wp +  &
-       dperctsd * perct_ij**3._wp
+    dperctstd = dperctsa + dperctsb * perct_ij + dperctsc * perct_ij**2.0_wp + dperctsd *          &
+                perct_ij**3.0_wp
 !
 !-- Value of the FUNCTION
     sultr_res = dperctm + faktor * dperctstd
-    IF ( ABS( sultr_res ) > 99._wp )  sultr_res = +99._wp
+    IF ( ABS( sultr_res ) > 99.0_wp )  sultr_res = +99.0_wp
 
  END SUBROUTINE calc_sultr
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Multiple linear regression to calculate an increment delta_cold, 
-!> to adjust Fanger's classical PMV (pmva) by Gagge's 2 node model, 
-!> applying Fanger's convective heat transfer coefficient, hcf.
-!> Wind velocitiy of the reference environment is 0.10 m/s 
-!------------------------------------------------------------------------------!
+!> Multiple linear regression to calculate an increment delta_cold, to adjust Fanger's classical PMV
+!> (pmva) by Gagge's 2 node model, applying Fanger's convective heat transfer coefficient, hcf.
+!> Wind velocitiy of the reference environment is 0.10 m/s
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE dpmv_cold( pmva, ta, ws, tmrt, nerr, dpmv_cold_res )
 
@@ -3075 +3035 @@
     REAL(wp), INTENT ( IN ) ::  pmva   !< Fanger's classical predicted mean vote
     REAL(wp), INTENT ( IN ) ::  ta     !< Air temperature 2 m above ground (degC)
+    REAL(wp), INTENT ( IN ) ::  tmrt   !< Mean radiant temperature (degC)
     REAL(wp), INTENT ( IN ) ::  ws     !< Relative wind velocity 1 m above ground (m/s)
-    REAL(wp), INTENT ( IN ) ::  tmrt   !< Mean radiant temperature (degC)
 !
 !-- Type of output argument
-    INTEGER(iwp), INTENT ( OUT ) ::  nerr !< Error indicator: 0 = o.k., +1 = denominator for intersection = 0
-    REAL(wp),     INTENT ( OUT ) ::  dpmv_cold_res    !< Increment to adjust pmva according to the results of Gagge's 
-                                                      !< 2 node model depending on the input
+    INTEGER(iwp), INTENT ( OUT ) ::  nerr !< Error indicator: 0 = o.k., +1 = denominator for 
+                                          !< intersection = 0
+
+    REAL(wp),     INTENT ( OUT ) ::  dpmv_cold_res    !< Increment to adjust pmva according to the 
+                                                      !< results of Gagge's 2 node model depending on the input
 !
 !-- Type of program variables
+    INTEGER(iwp) ::  i          !< running index
+    INTEGER(iwp) ::  i_bin      !< result row number
+
     REAL(wp) ::  delta_cold(3)
+    REAL(wp) ::  dtmrt          !< delta mean radiant temperature
     REAL(wp) ::  pmv_cross(2)
     REAL(wp) ::  reg_a(3)
     REAL(wp) ::  r_denominator  !< the regression equations denominator
-    REAL(wp) ::  dtmrt          !< delta mean radiant temperature
     REAL(wp) ::  sqrt_ws        !< sqare root of wind speed
-    INTEGER(iwp) ::  i          !< running index
-    INTEGER(iwp) ::  i_bin      !< result row number
 
 !    REAL(wp) ::  coeff(3,5)  !< unsafe! array is (re-)writable!
@@ -3104 +3067 @@
 !-- Coefficient of the 3 regression lines:
 !      1:const      2:*pmva    3:*ta          4:*sqrt_ws     5:*dtmrt
-    REAL(wp), DIMENSION(1:3,1:5), PARAMETER ::  coeff = RESHAPE( (/            &
-        0.161_wp,   0.130_wp, -1.125E-03_wp,  1.106E-03_wp, -4.570E-04_wp,     &
-        0.795_wp,   0.713_wp, -8.880E-03_wp, -1.803E-03_wp, -2.816E-03_wp,     &
-        0.05761_wp, 0.458_wp, -1.829E-02_wp, -5.577E-03_wp, -1.970E-03_wp      &
-       /), SHAPE(coeff), order=(/ 2, 1 /) )
+    REAL(wp), DIMENSION(1:3,1:5), PARAMETER ::  coeff = RESHAPE( (/                                &
+        0.161_wp,   0.130_wp, -1.125E-03_wp,  1.106E-03_wp, -4.570E-04_wp,                         &
+        0.795_wp,   0.713_wp, -8.880E-03_wp, -1.803E-03_wp, -2.816E-03_wp,                         &
+        0.05761_wp, 0.458_wp, -1.829E-02_wp, -5.577E-03_wp, -1.970E-03_wp                          &
+       /), SHAPE( coeff ), order=(/ 2, 1 /)                    )
 !
 !-- Initialise
     nerr           = 0_iwp
-    dpmv_cold_res  = 0._wp
+    dpmv_cold_res  = 0.0_wp
     dtmrt          = tmrt - ta
     sqrt_ws        = ws
@@ -3121 +3084 @@
     ENDIF
 
-    delta_cold = 0._wp
+    delta_cold = 0.0_wp
     pmv_cross = pmva
 
@@ -3127 +3090 @@
 !-- Determine regression constant for given meteorological conditions
     DO  i = 1, 3
-       reg_a(i) = coeff(i,1) + coeff(i,3) * ta + coeff(i,4) *                  &
-                  sqrt_ws + coeff(i,5)*dtmrt 
+       reg_a(i) = coeff(i,1) + coeff(i,3) * ta + coeff(i,4) * sqrt_ws + coeff(i,5)*dtmrt
        delta_cold(i) = reg_a(i) + coeff(i,2) * pmva
     ENDDO
@@ -3152 +3114 @@
     ENDDO
 !
-!-- Adjust to operative temperature scaled according 
-!-- to classical PMV (Fanger)
+!-- Adjust to operative temperature scaled according to classical PMV (Fanger)
     dpmv_cold_res = delta_cold(i_bin) - dpmv_cold_adj(pmva)
 
  END SUBROUTINE dpmv_cold
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Calculates the summand dpmv_cold_adj adjusting to the operative temperature 
-!> scaled according to classical PMV (Fanger) for cold conditions.
-!> Valid for reference environment: v (1m) = 0.10 m/s, dTMRT = 0 K, r.h. = 50 %
-!------------------------------------------------------------------------------!
+!> Calculates the summand dpmv_cold_adj adjusting to the operative temperature scaled according to
+!> classical PMV (Fanger) for cold conditions. Valid for reference environment: v (1m) = 0.10 m/s,
+!> dTMRT = 0 K, r.h. = 50 %
+!--------------------------------------------------------------------------------------------------!
  REAL(wp) FUNCTION dpmv_cold_adj( pmva )
 
     IMPLICIT NONE
 
-    REAL(wp), INTENT ( IN ) ::  pmva        !< (adjusted) Predicted Mean Vote
-
-    REAL(wp)      ::  pmv     !< pmv-part of the regression
     INTEGER(iwp)  ::  i       !< running index
     INTEGER(iwp)  ::  thr     !< thermal range
+
+    REAL(wp), INTENT ( IN ) ::  pmva        !< (adjusted) Predicted Mean Vote
+
+    REAL(wp)  ::  pmv     !< pmv-part of the regression
+
 !
 !-- Provide regression coefficients for three thermal ranges:
-!--    slightly cold  cold           very cold
-    REAL(wp), DIMENSION(1:3,0:3), PARAMETER ::  coef = RESHAPE( (/             &
-       0.0941540_wp, -0.1506620_wp, -0.0871439_wp,                             &
-       0.0783162_wp, -1.0612651_wp,  0.1695040_wp,                             &
-       0.1350144_wp, -1.0049144_wp, -0.0167627_wp,                             &
-       0.1104037_wp, -0.2005277_wp, -0.0003230_wp                              &
-       /), SHAPE(coef), order=(/ 1, 2 /) )
+!--                                                    slightly cold  cold           very cold
+    REAL(wp), DIMENSION(1:3,0:3), PARAMETER ::  coef = RESHAPE( (/                                 &
+                                                       0.0941540_wp, -0.1506620_wp, -0.0871439_wp, &
+                                                       0.0783162_wp, -1.0612651_wp,  0.1695040_wp, &
+                                                       0.1350144_wp, -1.0049144_wp, -0.0167627_wp, &
+                                                       0.1104037_wp, -0.2005277_wp, -0.0003230_wp  &
+                                                                 /), SHAPE(coef), order=(/ 1, 2 /) )
 !
 !-- Select thermal range
@@ -3195 +3158 @@
 !-- Initialize
     dpmv_cold_adj = coef(thr,0)
-    pmv           = 1._wp
+    pmv           = 1.0_wp
 !
 !-- Calculate pmv adjustment (dpmv_cold_adj)
@@ -3206 +3169 @@
  END FUNCTION dpmv_cold_adj
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Based on perceived temperature (perct) as input, ireq_neutral determines 
-!> the required clothing insulation (clo) for thermally neutral conditions 
-!> (neither body cooling nor body heating). It is related to the Klima- 
-!> Michel activity level (134.682 W/m2). IREQ_neutral is only defined 
-!> for perct < 10 (degC)
-!------------------------------------------------------------------------------!
+!> Based on perceived temperature (perct) as input, ireq_neutral determines the required clothing
+!> insulation (clo) for thermally neutral conditions (neither body cooling nor body heating). It is
+!> related to the Klima-Michel activity level (134.682 W/m2). IREQ_neutral is only defined for perct
+!> < 10 (degC)
+!--------------------------------------------------------------------------------------------------!
  REAL(wp) FUNCTION ireq_neutral( perct_ij, ireq_minimal, nerr )
 
@@ -3220 +3182 @@
 !
 !-- Type declaration of arguments
+    INTEGER(iwp), INTENT ( OUT ) ::  nerr
+
     REAL(wp),     INTENT ( IN )  ::  perct_ij
     REAL(wp),     INTENT ( OUT ) ::  ireq_minimal
-    INTEGER(iwp), INTENT ( OUT ) ::  nerr
 !
 !-- Type declaration for internal varables
@@ -3254 +3217 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> The SUBROUTINE surface area calculates the surface area of the individual
-!> according to its height (m), weight (kg), and age (y)
-!------------------------------------------------------------------------------!
+!> The SUBROUTINE surface area calculates the surface area of the individual according to its height
+!> (m), weight (kg), and age (y)
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE surface_area( height_cm, weight, age, surf )
 
     IMPLICIT NONE
 
+    INTEGER(iwp), INTENT(in)  ::  age
+
+    REAL(wp)    , INTENT(in)  ::  height_cm
     REAL(wp)    , INTENT(in)  ::  weight
-    REAL(wp)    , INTENT(in)  ::  height_cm
-    INTEGER(iwp), INTENT(in)  ::  age
+
     REAL(wp)    , INTENT(out) ::  surf
+
     REAL(wp)                  ::  height
 
-    height = height_cm * 100._wp
+    height = height_cm * 100.0_wp
 !
 !-- According to Gehan-George, for children
@@ -3282 +3248 @@
     ENDIF
 !
-!-- DuBois D, DuBois EF: A formula to estimate the approximate surface area if 
-!-- height and weight be known. In: Arch. Int. Med.. 17, 1916, pp. 863:871.
+!-- DuBois D, DuBois EF: A formula to estimate the approximate surface area if height and weight be
+!>  known. In: Arch. Int. Med.. 17, 1916, pp. 863:871.
     surf = 0.007184_wp * height**0.725_wp * weight**0.425_wp
     RETURN
@@ -3289 +3255 @@
  END SUBROUTINE surface_area
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
@@ -3303 +3269 @@
 !>  - work load (W)
 !> for a sample human.
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE persdat( age, weight, height, sex, work, a_surf, actlev )
 
     IMPLICIT NONE
 
+    INTEGER(iwp), INTENT(in) ::  sex
+
+
     REAL(wp), INTENT(in) ::  age
+    REAL(wp), INTENT(in) ::  height
     REAL(wp), INTENT(in) ::  weight
-    REAL(wp), INTENT(in) ::  height
     REAL(wp), INTENT(in) ::  work
-    INTEGER(iwp), INTENT(in) ::  sex
+
     REAL(wp), INTENT(out) ::  actlev
+
     REAL(wp) ::  a_surf
+    REAL(wp) ::  basic_heat_prod
     REAL(wp) ::  energy_prod
+    REAL(wp) ::  factor
     REAL(wp) ::  s
-    REAL(wp) ::  factor
-    REAL(wp) ::  basic_heat_prod
+
 
     CALL surface_area( height, weight, INT( age ), a_surf )
-    s = height * 100._wp / ( weight**( 1._wp / 3._wp ) )
-    factor = 1._wp + .004_wp  * ( 30._wp - age )
-    basic_heat_prod = 0.
+    s = height * 100.0_wp / ( weight**( 1.0_wp / 3.0_wp ) )
+    factor = 1.0_wp + .004_wp  * ( 30.0_wp - age )
+    basic_heat_prod = 0.0_wp
     IF ( sex == 1_iwp )  THEN
-       basic_heat_prod = 3.45_wp * weight**( 3._wp / 4._wp ) * ( factor +      &
-                     .01_wp  * ( s - 43.4_wp ) )
+       basic_heat_prod = 3.45_wp * weight**( 3.0_wp / 4.0_wp ) * ( factor + 0.01_wp                &
+                         * ( s - 43.4_wp ) )
     ELSE IF ( sex == 2_iwp )  THEN
-       basic_heat_prod = 3.19_wp * weight**( 3._wp / 4._wp ) * ( factor +      &
-                    .018_wp * ( s - 42.1_wp ) )
+       basic_heat_prod = 3.19_wp * weight**( 3.0_wp / 4.0_wp ) * ( factor + 0.018_wp               &
+                         * ( s - 42.1_wp ) )
     ENDIF
 
@@ -3338 +3309 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> SUBROUTINE ipt_init
 !> initializes the instationary perceived temperature
-!------------------------------------------------------------------------------!
-
- SUBROUTINE ipt_init( age, weight, height, sex, work, actlev, clo,             &
-     ta, vp, ws, tmrt, pair, dt, storage, t_clothing,                          &
-     ipt )
+!--------------------------------------------------------------------------------------------------!
+
+ SUBROUTINE ipt_init( age, weight, height, sex, work, actlev, clo, ta, vp, ws, tmrt, pair, dt,     &
+                      storage, t_clothing, ipt )
 
     IMPLICIT NONE
 !
 !-- Input parameters
+
+    INTEGER(iwp), INTENT(in)  :: sex    !< Persons sex (1 = male, 2 = female)
+
     REAL(wp), INTENT(in) ::  age        !< Persons age          (years)
+    REAL(wp), INTENT(in) ::  dt         !< Timestep             (s)
+    REAL(wp), INTENT(in) ::  height     !< Persons height       (m)7
+    REAL(wp), INTENT(in) ::  pair       !< Air pressure         (hPa)
+    REAL(wp), INTENT(in) ::  ta         !< Air Temperature      (degree_C)
+    REAL(wp), INTENT(in) ::  tmrt       !< Mean radiant temperature   (degree_C)
+    REAL(wp), INTENT(in) ::  vp         !< Vapor pressure       (hPa)
     REAL(wp), INTENT(in) ::  weight     !< Persons weight       (kg)
-    REAL(wp), INTENT(in) ::  height     !< Persons height       (m)
     REAL(wp), INTENT(in) ::  work       !< Current workload     (W)
-    REAL(wp), INTENT(in) ::  ta         !< Air Temperature      (degree_C)
-    REAL(wp), INTENT(in) ::  vp         !< Vapor pressure       (hPa)
     REAL(wp), INTENT(in) ::  ws         !< Wind speed in approx. 1.1m (m/s)
-    REAL(wp), INTENT(in) ::  tmrt       !< Mean radiant temperature   (degree_C)
-    REAL(wp), INTENT(in) ::  pair       !< Air pressure         (hPa)
-    REAL(wp), INTENT(in) ::  dt         !< Timestep             (s)
-    INTEGER(iwp), INTENT(in)  :: sex    !< Persons sex (1 = male, 2 = female)
 !
 !-- Output parameters
     REAL(wp), INTENT(out) ::  actlev
     REAL(wp), INTENT(out) ::  clo
+    REAL(wp), INTENT(out) ::  ipt
     REAL(wp), INTENT(out) ::  storage
     REAL(wp), INTENT(out) ::  t_clothing
-    REAL(wp), INTENT(out) ::  ipt
 !
 !-- Internal variables
-    REAL(wp), PARAMETER :: eps = 0.0005_wp
-    REAL(wp), PARAMETER :: eta = 0._wp
-    REAL(wp) ::  sclo
-    REAL(wp) ::  wclo
-    REAL(wp) ::  d_pmv
-    REAL(wp) ::  svp_ta
-    REAL(wp) ::  sult_lim
-    REAL(wp) ::  dgtcm
-    REAL(wp) ::  dgtcstd
-    REAL(wp) ::  clon
-    REAL(wp) ::  ireq_minimal
-!     REAL(wp) ::  clo_fanger
-    REAL(wp) ::  pmv_w
-    REAL(wp) ::  pmv_s
-    REAL(wp) ::  pmva
-    REAL(wp) ::  ptc
-    REAL(wp) ::  d_std
-    REAL(wp) ::  pmvs
-    REAL(wp) ::  a_surf
-!     REAL(wp) ::  acti
     INTEGER(iwp) ::  ncount
     INTEGER(iwp) ::  nerr_cold
@@ -3398 +3350 @@
     LOGICAL ::  sultrieness
 
-    storage = 0._wp
+    REAL(wp), PARAMETER :: eps = 0.0005_wp
+    REAL(wp), PARAMETER :: eta = 0.0_wp
+
+!    REAL(wp) ::  acti
+    REAL(wp) ::  a_surf
+!    REAL(wp) ::  clo_fanger
+    REAL(wp) ::  clon
+    REAL(wp) ::  d_pmv
+    REAL(wp) ::  d_std
+    REAL(wp) ::  dgtcm
+    REAL(wp) ::  dgtcstd
+    REAL(wp) ::  ireq_minimal
+    REAL(wp) ::  pmv_s
+    REAL(wp) ::  pmv_w
+    REAL(wp) ::  pmva
+    REAL(wp) ::  pmvs
+    REAL(wp) ::  ptc
+    REAL(wp) ::  sclo
+    REAL(wp) ::  sult_lim
+    REAL(wp) ::  svp_ta
+    REAL(wp) ::  wclo
+
+
+    storage = 0.0_wp
     CALL persdat( age, weight, height, sex, work, a_surf, actlev )
 !
@@ -3415 +3390 @@
 !
 !-- Decision: firstly calculate for winter or summer clothing
-    IF ( ta <= 10._wp )  THEN
+    IF ( ta <= 10.0_wp )  THEN
 !
 !--    First guess: winter clothing insulation: cold stress
        clo = wclo
        t_clothing = bio_fill_value  ! force initial run
-       CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work,         &
-          t_clothing, storage, dt, pmva )
+       CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage, dt,    &
+                            pmva )
        pmv_w = pmva
 
-       IF ( pmva > 0._wp )  THEN
-!
-!--       Case summer clothing insulation: heat load ?            
+       IF ( pmva > 0.0_wp )  THEN
+!
+!--       Case summer clothing insulation: heat load ?
           clo = sclo
           t_clothing = bio_fill_value  ! force initial run
-          CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work,      &
-             t_clothing, storage, dt, pmva )
+          CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage, dt, &
+                               pmva )
           pmv_s = pmva
-          IF ( pmva <= 0._wp )  THEN
-!
-!--          Case: comfort achievable by varying clothing insulation 
-!--          between winter and summer set values
-             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta , sclo,     &
-                            pmv_s, wclo, pmv_w, eps, pmva, ncount, clo )
+          IF ( pmva <= 0.0_wp )  THEN
+!
+!--          Case: comfort achievable by varying clothing insulation between winter and summer set
+!--                values
+             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta , sclo, pmv_s, wclo, pmv_w, eps,&
+                               pmva, ncount, clo )
              IF ( ncount < 0_iwp )  THEN
                 nerr = -1_iwp
@@ -3445 +3420 @@
              clo = 0.5_wp
              t_clothing = bio_fill_value
-             CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work,   &
-                t_clothing, storage, dt, pmva )
+             CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage,  &
+                                  dt, pmva )
           ENDIF
-       ELSE IF ( pmva < -0.11_wp )  THEN
+       ELSE IF ( pmva < - 0.11_wp )  THEN
           clo = 1.75_wp
           t_clothing = bio_fill_value
-          CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work,      &
-             t_clothing, storage, dt, pmva )
+          CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage, dt, &
+                               pmva )
        ENDIF
 
@@ -3460 +3435 @@
        clo = sclo
        t_clothing = bio_fill_value
-       CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work,         &
-          t_clothing, storage, dt, pmva )
+       CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage, dt,    &
+                            pmva )
        pmv_s = pmva
 
-       IF ( pmva < 0._wp )  THEN
+       IF ( pmva < 0.0_wp )  THEN
 !
 !--       Case winter clothing insulation: cold stress ?
           clo = wclo
           t_clothing = bio_fill_value
-          CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work,      &
-             t_clothing, storage, dt, pmva )
+          CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage, dt, &
+                               pmva )
           pmv_w = pmva
 
-          IF ( pmva >= 0._wp )  THEN
-!
-!--          Case: comfort achievable by varying clothing insulation 
-!--          between winter and summer set values
-             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta, sclo,      &
-                               pmv_s, wclo, pmv_w, eps, pmva, ncount, clo )
+          IF ( pmva >= 0.0_wp )  THEN
+!
+!--          Case: comfort achievable by varying clothing insulation between winter and summer set
+!--                values
+             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta, sclo, pmv_s, wclo, pmv_w, eps, &
+                               pmva, ncount, clo )
              IF ( ncount < 0_wp )  THEN
                 nerr = -1_iwp
                 RETURN
              ENDIF
-          ELSE IF ( pmva < -0.11_wp )  THEN
+          ELSE IF ( pmva < - 0.11_wp )  THEN
              clo = 1.75_wp
              t_clothing = bio_fill_value
-             CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work,   &
-                t_clothing, storage, dt, pmva )
+             CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage,  &
+                                  dt, pmva )
           ENDIF
        ELSE IF ( pmva > 0.06_wp )  THEN
           clo = 0.5_wp
           t_clothing = bio_fill_value
-          CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work,      &
-             t_clothing, storage, dt, pmva )
+          CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage, dt, &
+                               pmva )
        ENDIF
 
@@ -3502 +3477 @@
     CALL perct_regression( pmva, clo, ipt )
     ptc = ipt
-    IF ( clo >= 1.75_wp  .AND.  pmva <= -0.11_wp )  THEN
+    IF ( clo >= 1.75_wp  .AND.  pmva <= - 0.11_wp )  THEN
 !
 !--    Adjust for cold conditions according to Gagge 1986
@@ -3508 +3483 @@
        IF ( nerr_cold > 0_iwp )  nerr = -5_iwp
        pmvs = pmva - d_pmv
-       IF ( pmvs > -0.11_wp )  THEN
-          d_pmv  = 0._wp
-          pmvs   = -0.11_wp
+       IF ( pmvs > - 0.11_wp )  THEN
+          d_pmv  = 0.0_wp
+          pmvs   = - 0.11_wp
        ENDIF
        CALL perct_regression( pmvs, clo, ipt )
@@ -3518 +3493 @@
     IF ( clo > 0.5_wp  .AND.  ipt <= 8.73_wp )  THEN
 !
-!--    Required clothing insulation (ireq) is exclusively defined for 
-!--    perceived temperatures (ipt) less 10 (C) for a 
-!--    reference wind of 0.2 m/s according to 8.73 (C) for 0.1 m/s
+!--    Required clothing insulation (ireq) is exclusively defined for perceived temperatures (ipt)
+!--    less 10 (C) for a reference wind of 0.2 m/s according to 8.73 (C) for 0.1 m/s
        clon = ireq_neutral ( ipt, ireq_minimal, nerr )
        clo = clon
@@ -3526 +3500 @@
     CALL calc_sultr( ptc, dgtcm, dgtcstd, sult_lim )
     sultrieness    = .FALSE.
-    d_std      = -99._wp
+    d_std      = - 99.0_wp
     IF ( pmva > 0.06_wp  .AND.  clo <= 0.5_wp )  THEN
 !
@@ -3534 +3508 @@
        pmvs   = pmva + d_pmv
        CALL perct_regression( pmvs, clo, ipt )
-       IF ( sult_lim < 99._wp )  THEN
+       IF ( sult_lim < 99.0_wp )  THEN
           IF ( (ipt - ptc) > sult_lim )  sultrieness = .TRUE.
        ENDIF
     ENDIF
 
- 
+
  END SUBROUTINE ipt_init
- 
-!------------------------------------------------------------------------------!
+
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> SUBROUTINE ipt_cycle
-!> Calculates one timestep for the instationary version of perceived
-!> temperature (iPT, degree_C) for
-!>  - standard measured/predicted meteorological values and TMRT 
-!>    as input;
+!> Calculates one timestep for the instationary version of perceived temperature (iPT, degree_C) for
+!>  - standard measured/predicted meteorological values and TMRT as input;
 !>  - regressions for determination of PT;
-!>  - adjustment to Gagge's PMV* (2-node-model, 1986) as base of PT 
-!>    under warm/humid conditions (Icl= 0.50 clo) and under cold 
-!>    conditions (Icl= 1.75 clo)
-!>
-!------------------------------------------------------------------------------!
- SUBROUTINE ipt_cycle( ta, vp, ws, tmrt, pair, dt, storage, t_clothing, clo,   &
-     actlev, work, ipt )
+!>  - adjustment to Gagge's PMV* (2-node-model, 1986) as base of PT under warm/humid conditions
+!>    (Icl= 0.50 clo) and under cold conditions (Icl= 1.75 clo)
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE ipt_cycle( ta, vp, ws, tmrt, pair, dt, storage, t_clothing, clo, actlev, work, ipt )
 
     IMPLICIT NONE
 !
 !-- Type of input of the argument list
+    REAL(wp), INTENT ( IN )  ::  actlev  !< Internal heat production    (W)
+    REAL(wp), INTENT ( IN )  ::  clo     !< Clothing index              (no dim)
+    REAL(wp), INTENT ( IN )  ::  dt      !< Timestep                    (s)
+    REAL(wp), INTENT ( IN )  ::  pair    !< Air pressure                (hPa)
     REAL(wp), INTENT ( IN )  ::  ta      !< Air temperature             (degree_C)
+    REAL(wp), INTENT ( IN )  ::  tmrt    !< Mean radiant temperature    (degree_C)
     REAL(wp), INTENT ( IN )  ::  vp      !< Vapor pressure              (hPa)
-    REAL(wp), INTENT ( IN )  ::  tmrt    !< Mean radiant temperature    (degree_C)
+    REAL(wp), INTENT ( IN )  ::  work    !< Mechanical work load        (W)
     REAL(wp), INTENT ( IN )  ::  ws      !< Wind speed                  (m/s)
-    REAL(wp), INTENT ( IN )  ::  pair    !< Air pressure                (hPa)
-    REAL(wp), INTENT ( IN )  ::  dt      !< Timestep                    (s)
-    REAL(wp), INTENT ( IN )  ::  clo     !< Clothing index              (no dim)
-    REAL(wp), INTENT ( IN )  ::  actlev  !< Internal heat production    (W)
-    REAL(wp), INTENT ( IN )  ::  work    !< Mechanical work load        (W)
 !
 !-- In and output parameters
@@ -3580 +3549 @@
 !
 !-- Type of internal variables
+    INTEGER(iwp) ::  nerr
+    INTEGER(iwp) ::  nerr_cold
+
+    LOGICAL ::  sultrieness
+
     REAL(wp) ::  d_pmv
-    REAL(wp) ::  svp_ta
-    REAL(wp) ::  sult_lim
+    REAL(wp) ::  d_std
     REAL(wp) ::  dgtcm
     REAL(wp) ::  dgtcstd
     REAL(wp) ::  pmva
+    REAL(wp) ::  pmvs
     REAL(wp) ::  ptc
-    REAL(wp) ::  d_std
-    REAL(wp) ::  pmvs
-    INTEGER(iwp) ::  nerr_cold
-    INTEGER(iwp) ::  nerr
-
-    LOGICAL ::  sultrieness
+    REAL(wp) ::  sult_lim
+    REAL(wp) ::  svp_ta
 !
 !-- Initialise
@@ -3601 +3571 @@
 !
 !-- Determine pmv_adjusted for current conditions
-    CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work,            &
-       t_clothing, storage, dt, pmva )
+    CALL fanger_s_acti ( ta, tmrt, vp, ws, pair, clo, actlev, work, t_clothing, storage, dt, pmva )
 !
 !-- Determine perceived temperature by regression equation + adjustments
@@ -3614 +3583 @@
        IF ( nerr_cold > 0_iwp )  nerr = -5_iwp
        pmvs = pmva - d_pmv
-       IF ( pmvs > -0.11_wp )  THEN
-          d_pmv  = 0._wp
-          pmvs   = -0.11_wp
+       IF ( pmvs > - 0.11_wp )  THEN
+          d_pmv  = 0.0_wp
+          pmvs   = - 0.11_wp
        ENDIF
        CALL perct_regression( pmvs, clo, ipt )
@@ -3625 +3594 @@
     CALL calc_sultr( ptc, dgtcm, dgtcstd, sult_lim )
     sultrieness = .FALSE.
-    d_std       = -99._wp
+    d_std       = - 99.0_wp
     IF ( pmva > 0.06_wp  .AND.  clo <= 0.5_wp )  THEN
 !
@@ -3633 +3602 @@
        pmvs  = pmva + d_pmv
        CALL perct_regression( pmvs, clo, ipt )
-       IF ( sult_lim < 99._wp )  THEN
+       IF ( sult_lim < 99.0_wp )  THEN
           IF ( (ipt - ptc) > sult_lim )  sultrieness = .TRUE.
        ENDIF
@@ -3640 +3609 @@
  END SUBROUTINE ipt_cycle
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> SUBROUTINE fanger_s calculates the 
-!> actual Predicted Mean Vote (dimensionless) according 
-!> to Fanger corresponding to meteorological (ta,tmrt,pa,ws,pair) 
-!> and individual variables (clo, actlev, eta) considering a storage
-!> and clothing temperature for a given timestep.
-!------------------------------------------------------------------------------!
- SUBROUTINE fanger_s_acti( ta, tmrt, pa, in_ws, pair, in_clo, actlev,          &
-    activity, t_cloth, s, dt, pmva )
+!> SUBROUTINE fanger_s calculates the actual Predicted Mean Vote (dimensionless) according to Fanger
+!> corresponding to meteorological (ta,tmrt,pa,ws,pair) and individual variables (clo, actlev, eta)
+!> considering a storage and clothing temperature for a given timestep.
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE fanger_s_acti( ta, tmrt, pa, in_ws, pair, in_clo, actlev, activity, t_cloth, s, dt,    &
+                           pmva )
 
     IMPLICIT NONE
 !
 !--  Input argument types
+    REAL(wp), INTENT ( IN )  ::  activity !< Work load                (W/m²)
+    REAL(wp), INTENT ( IN )  ::  actlev   !< Metabolic + work energy  (W/m²)
+    REAL(wp), INTENT ( IN )  ::  dt       !< Timestep                 (s)
+    REAL(wp), INTENT ( IN )  ::  in_clo   !< Clothing index (clo)     (no dim)
+    REAL(wp), INTENT ( IN )  ::  in_ws    !< Wind speed               (m/s)
+    REAL(wp), INTENT ( IN )  ::  pa       !< Vapour pressure          (hPa)
+    REAL(wp), INTENT ( IN )  ::  pair     !< Air pressure             (hPa)
     REAL(wp), INTENT ( IN )  ::  ta       !< Air temperature          (degree_C)
     REAL(wp), INTENT ( IN )  ::  tmrt     !< Mean radiant temperature (degree_C)
-    REAL(wp), INTENT ( IN )  ::  pa       !< Vapour pressure          (hPa)
-    REAL(wp), INTENT ( IN )  ::  pair     !< Air pressure             (hPa)
-    REAL(wp), INTENT ( IN )  ::  in_ws    !< Wind speed               (m/s)
-    REAL(wp), INTENT ( IN )  ::  actlev   !< Metabolic + work energy  (W/m²)
-    REAL(wp), INTENT ( IN )  ::  dt       !< Timestep                 (s)
-    REAL(wp), INTENT ( IN )  ::  activity !< Work load                (W/m²)
-    REAL(wp), INTENT ( IN )  ::  in_clo   !< Clothing index (clo)     (no dim)
 !
 !-- Output argument types
@@ -3672 +3639 @@
 !
 !-- Internal variables
-    REAL(wp), PARAMETER  ::  time_equil = 7200._wp
-
-    REAL(wp) ::  f_cl         !< Increase in surface due to clothing    (factor)
-    REAL(wp) ::  heat_convection  !< energy loss by autocnvection       (W)
-    REAL(wp) ::  t_skin_aver  !< average skin temperature               (degree_C)
-    REAL(wp) ::  bc           !< preliminary result storage
-    REAL(wp) ::  cc           !< preliminary result storage
-    REAL(wp) ::  dc           !< preliminary result storage
-    REAL(wp) ::  ec           !< preliminary result storage
-    REAL(wp) ::  gc           !< preliminary result storage
-    REAL(wp) ::  t_clothing   !< clothing temperature                   (degree_C)
-!     REAL(wp) ::  hr           !< radiational heat resistence
-    REAL(wp) ::  clo          !< clothing insulation index              (clo)
-    REAL(wp) ::  ws           !< wind speed                             (m/s)
-    REAL(wp) ::  z1           !< Empiric factor for the adaption of the heat 
-                              !< ballance equation to the psycho-physical scale (Equ. 40 in FANGER)
-    REAL(wp) ::  z2           !< Water vapour diffution through the skin
-    REAL(wp) ::  z3           !< Sweat evaporation from the skin surface
-    REAL(wp) ::  z4           !< Loss of latent heat through respiration
-    REAL(wp) ::  z5           !< Loss of radiational heat
-    REAL(wp) ::  z6           !< Heat loss through forced convection
-    REAL(wp) ::  en           !< Energy ballance                        (W)
-    REAL(wp) ::  d_s          !< Storage delta                          (W)
-    REAL(wp) ::  adjustrate   !< Max storage adjustment rate
-    REAL(wp) ::  adjustrate_cloth  !< max clothing temp. adjustment rate
-
     INTEGER(iwp) :: i         !< running index
     INTEGER(iwp) ::  niter    !< Running index
 
+    REAL(wp), PARAMETER  ::  time_equil = 7200.0_wp
+
+    REAL(wp) ::  adjustrate        !< Max storage adjustment rate
+    REAL(wp) ::  adjustrate_cloth  !< max clothing temp. adjustment rate
+    REAL(wp) ::  bc                !< preliminary result storage
+    REAL(wp) ::  cc                !< preliminary result storage
+    REAL(wp) ::  clo               !< clothing insulation index              (clo)
+    REAL(wp) ::  d_s               !< Storage delta                          (W)
+    REAL(wp) ::  dc                !< preliminary result storage
+    REAL(wp) ::  en                !< Energy ballance                        (W)
+    REAL(wp) ::  ec                !< preliminary result storage
+    REAL(wp) ::  f_cl              !< Increase in surface due to clothing    (factor)
+    REAL(wp) ::  gc                !< preliminary result storage
+    REAL(wp) ::  heat_convection   !< energy loss by autocnvection       (W)
+!    REAL(wp) ::  hr                !< radiational heat resistence
+    REAL(wp) ::  t_clothing        !< clothing temperature                   (degree_C)
+    REAL(wp) ::  t_skin_aver       !< average skin temperature               (degree_C)
+    REAL(wp) ::  ws                !< wind speed                             (m/s)
+    REAL(wp) ::  z1                !< Empiric factor for the adaption of the heat
+                                   !< ballance equation to the psycho-physical scale 
+                                   !< (Equ. 40 in FANGER)
+    REAL(wp) ::  z2                !< Water vapour diffution through the skin
+    REAL(wp) ::  z3                !< Sweat evaporation from the skin surface
+    REAL(wp) ::  z4                !< Loss of latent heat through respiration
+    REAL(wp) ::  z5                !< Loss of radiational heat
+    REAL(wp) ::  z6                !< Heat loss through forced convection
+
+
+
+
 !
 !-- Clo must be > 0. to avoid div. by 0!
     clo = in_clo
-    IF ( clo < 001._wp )  clo = .001_wp
+    IF ( clo < 001.0_wp )  clo = 0.001_wp
 !
 !-- Increase in surface due to clothing
-    f_cl = 1._wp + .15_wp * clo
+    f_cl = 1.0_wp + 0.15_wp * clo
 !
 !-- Case of free convection (ws < 0.1 m/s ) not considered
     ws = in_ws
-    IF ( ws < .1_wp )  THEN
-       ws = .1_wp
+    IF ( ws < 0.1_wp )  THEN
+       ws = 0.1_wp
     ENDIF
 !
@@ -3719 +3690 @@
 !
 !-- Average skin temperature
-    t_skin_aver = 35.7_wp - .0275_wp * activity
+    t_skin_aver = 35.7_wp - 0.0275_wp * activity
 !
 !-- Calculation of constants for evaluation below
-    bc = .155_wp * clo * 3.96_wp * 10._wp**( -8._wp ) * f_cl
+    bc = 0.155_wp * clo * 3.96_wp * 10.0_wp**( -8.0_wp ) * f_cl
     cc = f_cl * heat_convection
-    ec = .155_wp * clo
-    dc = ( 1._wp + ec * cc ) / bc
-    gc = ( t_skin_aver + bc * ( tmrt + 273.2_wp )**4._wp + ec * cc * ta ) / bc
-!
-!-- Calculation of clothing surface temperature (t_clothing) based on
-!-- newton-approximation with air temperature as initial guess
-    niter = INT( dt * 10._wp, KIND=iwp )
+    ec = 0.155_wp * clo
+    dc = ( 1.0_wp + ec * cc ) / bc
+    gc = ( t_skin_aver + bc * ( tmrt + 273.2_wp )**4.0_wp + ec * cc * ta ) / bc
+!
+!-- Calculation of clothing surface temperature (t_clothing) based on Newton-approximation with air
+!-- temperature as initial guess
+    niter = INT( dt * 10.0_wp, KIND=iwp )
     IF ( niter < 1 )  niter = 1_iwp
-    adjustrate = 1._wp - EXP( -1._wp * ( 10._wp / time_equil ) * dt )
-    IF ( adjustrate >= 1._wp )  adjustrate = 1._wp
-    adjustrate_cloth = adjustrate * 30._wp
+    adjustrate = 1.0_wp - EXP( -1.0_wp * ( 10.0_wp / time_equil ) * dt )
+    IF ( adjustrate >= 1.0_wp )  adjustrate = 1.0_wp
+    adjustrate_cloth = adjustrate * 30.0_wp
     t_clothing = t_cloth
 !
-!-- Set initial values for niter, adjustrates and t_clothing if this is the
-!-- first call
-    IF ( t_cloth <= -998._wp )  THEN  ! If initial run
+!-- Set initial values for niter, adjustrates and t_clothing if this is the first call
+    IF ( t_cloth <= -998.0_wp )  THEN  ! If initial run
        niter = 3_iwp
-       adjustrate = 1._wp
-       adjustrate_cloth = 1._wp
+       adjustrate = 1.0_wp
+       adjustrate_cloth = 1.0_wp
        t_clothing = ta
     ENDIF
@@ -3748 +3718 @@
 !-- Update clothing temperature
     DO  i = 1, niter
-       t_clothing = t_clothing - adjustrate_cloth * ( ( t_clothing +           &
-          273.2_wp )**4._wp + t_clothing *                                     &
-          dc - gc ) / ( 4._wp * ( t_clothing + 273.2_wp )**3._wp + dc )
+       t_clothing = t_clothing - adjustrate_cloth * ( ( t_clothing + 273.2_wp )**4.0_wp  +         &
+                    t_clothing * dc - gc ) / ( 4.0_wp * ( t_clothing + 273.2_wp )**3.0_wp + dc )
     ENDDO
 !
-!-- Empiric factor for the adaption of the heat ballance equation
-!-- to the psycho-physical scale (Equ. 40 in FANGER)
-    z1 = ( .303_wp * EXP( -.036_wp * actlev ) + .0275_wp )
+!-- Empiric factor for the adaption of the heat ballance equation to the psycho-physical scale
+!-- (Equ. 40 in FANGER)
+    z1 = ( 0.303_wp * EXP( - 0.036_wp * actlev ) + 0.0275_wp )
 !
 !-- Water vapour diffution through the skin
-    z2 = .31_wp * ( 57.3_wp - .07_wp * activity-pa )
+    z2 = 0.31_wp * ( 57.3_wp - 0.07_wp * activity-pa )
 !
 !-- Sweat evaporation from the skin surface
-    z3 = .42_wp * ( activity - 58._wp )
+    z3 = 0.42_wp * ( activity - 58.0_wp )
 !
 !-- Loss of latent heat through respiration
-    z4 = .0017_wp * actlev * ( 58.7_wp - pa ) + .0014_wp * actlev *            &
-      ( 34._wp - ta )
+    z4 = 0.0017_wp * actlev * ( 58.7_wp - pa ) + 0.0014_wp * actlev * ( 34.0_wp - ta )
 !
 !-- Loss of radiational heat
-    z5 = 3.96e-8_wp * f_cl * ( ( t_clothing + 273.2_wp )**4 - ( tmrt +         &
-       273.2_wp )**4 )
+    z5 = 3.96e-8_wp * f_cl * ( ( t_clothing + 273.2_wp )**4 - ( tmrt + 273.2_wp )**4 )
 !
 !-- Heat loss through forced convection
@@ -3778 +3745 @@
 !
 !-- Manage storage
-    d_s = adjustrate * en + ( 1._wp - adjustrate ) * s
+    d_s = adjustrate * en + ( 1.0_wp - adjustrate ) * s
 !
 !-- Predicted Mean Vote
@@ -3791 +3758 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 !
 ! Description:
@@ -3798 +3765 @@
 !> stationary (calculated based on MEMI),
 !> Subroutine based on PETBER vers. 1.5.1996 by P. Hoeppe
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 
  SUBROUTINE calculate_pet_static( ta, vpa, v, tmrt, pair, pet_ij )
@@ -3805 +3772 @@
 !
 !-- Input arguments:
+    REAL(wp), INTENT( IN ) ::  pair  !< Air pressure                (hPa)
     REAL(wp), INTENT( IN ) ::  ta    !< Air temperature             (degree_C)
     REAL(wp), INTENT( IN ) ::  tmrt  !< Mean radiant temperature    (degree_C)
     REAL(wp), INTENT( IN ) ::  v     !< Wind speed                  (m/s)
     REAL(wp), INTENT( IN ) ::  vpa   !< Vapor pressure              (hPa)
-    REAL(wp), INTENT( IN ) ::  pair  !< Air pressure                (hPa)
 !
 !-- Output arguments:
@@ -3827 +3794 @@
     REAL(wp) ::  rtv
     REAL(wp) ::  vpts       !< Sat. vapor pressure over skin        (hPa)
+    REAL(wp) ::  tcl        !< Clothing temperature                 (degree_C)
     REAL(wp) ::  tsk        !< Skin temperature                     (degree_C)
-    REAL(wp) ::  tcl        !< Clothing temperature                 (degree_C)
     REAL(wp) ::  wetsk      !< Fraction of wet skin                 (factor)
 !
@@ -3836 +3803 @@
 !-- MEMI configuration
     REAL(wp) :: age         !< Persons age          (a)
+    REAL(wp) :: clo         !< Clothing insulation index (clo)
+    REAL(wp) :: eta         !< Work efficiency      (dimensionless)
+    REAL(wp) :: fcl         !< Surface area modification by clothing (factor)
+    REAL(wp) :: ht          !< Persons height       (m)
     REAL(wp) :: mbody       !< Persons body mass    (kg)
-    REAL(wp) :: ht          !< Persons height       (m)
     REAL(wp) :: work        !< Work load            (W)
-    REAL(wp) :: eta         !< Work efficiency      (dimensionless)
-    REAL(wp) :: clo         !< Clothing insulation index (clo)
-    REAL(wp) :: fcl         !< Surface area modification by clothing (factor)
-!     INTEGER(iwp) :: pos     !< Posture: 1 = standing, 2 = sitting
-!     INTEGER(iwp) :: sex     !< Sex: 1 = male, 2 = female
+!    INTEGER(iwp) :: pos     !< Posture: 1 = standing, 2 = sitting
+!    INTEGER(iwp) :: sex     !< Sex: 1 = male, 2 = female
 !
 !-- Configuration, keep standard parameters!
-    age   = 35._wp
-    mbody = 75._wp
+    age   = 35.0_wp
+    mbody = 75.0_wp
     ht    =  1.75_wp
-    work  = 80._wp
-    eta   =  0._wp
+    work  = 80.0_wp
+    eta   =  0.0_wp
     clo   =  0.9_wp
     fcl   =  1.15_wp
 !
 !-- Call subfunctions
-    CALL in_body( age, eta, ere, erel, ht, int_heat, mbody, pair, rtv, ta,     &
-            vpa, work )
-
-    CALL heat_exch( acl, adu, aeff, clo, ere, erel, esw, facl, fcl, feff, ht,  &
-            int_heat, mbody, pair, rdcl, rdsk, ta, tcl, tmrt, tsk, v, vpa,     &
-            vpts, wetsk )
-
-    CALL pet_iteration( acl, adu, aeff, esw, facl, feff, int_heat, pair,       &
-            rdcl, rdsk, rtv, ta, tcl, tsk, pet_ij, vpts, wetsk )
+    CALL in_body( age, eta, ere, erel, ht, int_heat, mbody, pair, rtv, ta, vpa, work )
+
+    CALL heat_exch( acl, adu, aeff, clo, ere, erel, esw, facl, fcl, feff, ht, int_heat, mbody,     &
+                    pair, rdcl, rdsk, ta, tcl, tmrt, tsk, v, vpa, vpts, wetsk )
+
+    CALL pet_iteration( acl, adu, aeff, esw, facl, feff, int_heat, pair, rdcl, rdsk, rtv, ta, tcl, &
+                        tsk, pet_ij, vpts, wetsk )
 
 
@@ -3869 +3834 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Calculate internal energy ballance
-!------------------------------------------------------------------------------!
- SUBROUTINE in_body( age, eta, ere, erel, ht, int_heat, mbody, pair, rtv, ta, &
-    vpa, work )
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE in_body( age, eta, ere, erel, ht, int_heat, mbody, pair, rtv, ta, vpa, work )
 !
 !-- Input arguments:
+    REAL(wp), INTENT( IN )  ::  age       !< Persons age              (a)
+    REAL(wp), INTENT( IN )  ::  eta       !< Work efficiency     (dimensionless)
+    REAL(wp), INTENT( IN )  ::  ht        !< Persons height           (m)
+    REAL(wp), INTENT( IN )  ::  mbody     !< Persons body mass        (kg)
     REAL(wp), INTENT( IN )  ::  pair      !< air pressure             (hPa)
     REAL(wp), INTENT( IN )  ::  ta        !< air temperature          (degree_C)
     REAL(wp), INTENT( IN )  ::  vpa       !< vapor pressure           (hPa)
-    REAL(wp), INTENT( IN )  ::  age       !< Persons age              (a)
-    REAL(wp), INTENT( IN )  ::  mbody     !< Persons body mass        (kg)
-    REAL(wp), INTENT( IN )  ::  ht        !< Persons height           (m)
     REAL(wp), INTENT( IN )  ::  work      !< Work load                (W)
-    REAL(wp), INTENT( IN )  ::  eta       !< Work efficiency     (dimensionless)
 !
 !-- Output arguments:
@@ -3901 +3865 @@
 !
 !-- Metabolic heat production
-    met = 3.45_wp * mbody**( 3._wp / 4._wp ) * (1._wp + 0.004_wp *             &
-          ( 30._wp - age) + 0.010_wp * ( ( ht * 100._wp /                      &
-          ( mbody**( 1._wp / 3._wp ) ) ) - 43.4_wp ) )
+    met = 3.45_wp * mbody**( 3.0_wp / 4.0_wp ) * (1.0_wp + 0.004_wp *                              &
+          ( 30.0_wp - age) + 0.010_wp * ( ( ht * 100.0_wp /                                        &
+          ( mbody**( 1.0_wp / 3.0_wp ) ) ) - 43.4_wp ) )
     met = work + met
-    int_heat = met * (1._wp - eta)
+    int_heat = met * (1.0_wp - eta)
 !
 !-- Sensible respiration energy
     tex  = 0.47_wp * ta + 21.0_wp
-    rtv  = 1.44_wp * 10._wp**(-6._wp) * met
+    rtv  = 1.44_wp * 10.0_wp**(-6.0_wp) * met
     eres = c_p * (ta - tex) * rtv
 !
 !-- Latent respiration energy
-    vpex = 6.11_wp * 10._wp**( 7.45_wp * tex / ( 235._wp + tex ) )
+    vpex = 6.11_wp * 10.0_wp**( 7.45_wp * tex / ( 235.0_wp + tex ) )
     erel = 0.623_wp * l_v / pair * ( vpa - vpex ) * rtv
 !
@@ -3922 +3886 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Calculate heat gain or loss
-!------------------------------------------------------------------------------!
- SUBROUTINE heat_exch( acl, adu, aeff, clo, ere, erel, esw, facl, fcl, feff,   &
-        ht, int_heat, mbody, pair, rdcl, rdsk, ta, tcl, tmrt, tsk, v, vpa,     &
-        vpts, wetsk )
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE heat_exch( acl, adu, aeff, clo, ere, erel, esw, facl, fcl, feff, ht, int_heat, mbody,  &
+                       pair, rdcl, rdsk, ta, tcl, tmrt, tsk, v, vpa, vpts, wetsk )
 
 !
 !-- Input arguments:
+    REAL(wp), INTENT( IN )  ::  clo    !< clothing insulation      (clo)
+    REAL(wp), INTENT( IN )  ::  fcl    !< factor for surface area increase by clothing
     REAL(wp), INTENT( IN )  ::  ere    !< Energy ballance          (W)
     REAL(wp), INTENT( IN )  ::  erel   !< Latent energy ballance   (W)
+    REAL(wp), INTENT( IN )  ::  ht     !< height                   (m)
     REAL(wp), INTENT( IN )  ::  int_heat  !< internal heat production (W)
+    REAL(wp), INTENT( IN )  ::  mbody  !< body mass                (kg)
     REAL(wp), INTENT( IN )  ::  pair   !< Air pressure             (hPa)
     REAL(wp), INTENT( IN )  ::  ta     !< Air temperature          (degree_C)
@@ -3941 +3908 @@
     REAL(wp), INTENT( IN )  ::  v      !< Wind speed               (m/s)
     REAL(wp), INTENT( IN )  ::  vpa    !< Vapor pressure           (hPa)
-    REAL(wp), INTENT( IN )  ::  mbody  !< body mass                (kg)
-    REAL(wp), INTENT( IN )  ::  ht     !< height                   (m)
-    REAL(wp), INTENT( IN )  ::  clo    !< clothing insulation      (clo)
-    REAL(wp), INTENT( IN )  ::  fcl    !< factor for surface area increase by clothing
 !
 !-- Output arguments:
@@ -3961 +3924 @@
 !
 !-- Cconstants:
-!     REAL(wp), PARAMETER :: cair = 1010._wp      !< replaced by c_p
-    REAL(wp), PARAMETER :: cb   = 3640._wp        !< 
+!     REAL(wp), PARAMETER :: cair = 1010.0_wp      !< replaced by c_p
+    REAL(wp), PARAMETER :: cb   = 3640.0_wp        !<
     REAL(wp), PARAMETER :: emcl =    0.95_wp      !< Longwave emission coef. of cloth
     REAL(wp), PARAMETER :: emsk =    0.99_wp      !< Longwave emission coef. of skin
-!     REAL(wp), PARAMETER :: evap = 2.42_wp * 10._wp **6._wp  !< replaced by l_v
-    REAL(wp), PARAMETER :: food =    0._wp        !< Heat gain by food        (W)
+!    REAL(wp), PARAMETER :: evap = 2.42_wp * 10.0_wp **6.0_wp  !< replaced by l_v
+    REAL(wp), PARAMETER :: food =    0.0_wp        !< Heat gain by food        (W)
     REAL(wp), PARAMETER :: po   = 1013.25_wp      !< Air pressure at sea level (hPa)
-    REAL(wp), PARAMETER :: rob  =    1.06_wp      !< 
+    REAL(wp), PARAMETER :: rob  =    1.06_wp      !<
 !
 !-- Internal variables
-    REAL(wp) ::  c(0:10)        !< Core temperature array           (degree_C)
+    INTEGER(iwp) ::  count1     !< running index
+    INTEGER(iwp) ::  count3     !< running index
+    INTEGER(iwp) ::  j          !< running index
+    INTEGER(iwp) ::  i          !< running index
+
+    LOGICAL ::  skipincreasecount   !< iteration control flag
+
     REAL(wp) ::  cbare          !< Convection through bare skin
     REAL(wp) ::  cclo           !< Convection through clothing
@@ -3982 +3951 @@
     REAL(wp) ::  eswphy         !< sweat created by physiology
     REAL(wp) ::  eswpot         !< potential sweat evaporation
-    REAL(wp) ::  fec            !< 
-    REAL(wp) ::  hc             !< 
-    REAL(wp) ::  he             !< 
-    REAL(wp) ::  htcl           !< 
-    REAL(wp) ::  r1             !< 
-    REAL(wp) ::  r2             !< 
+    REAL(wp) ::  fec            !<
+    REAL(wp) ::  hc             !<
+    REAL(wp) ::  he             !<
+    REAL(wp) ::  htcl           !<
+    REAL(wp) ::  r1             !<
+    REAL(wp) ::  r2             !<
     REAL(wp) ::  rbare          !< Radiational loss of bare skin    (W/m²)
-    REAL(wp) ::  rcl            !< 
+    REAL(wp) ::  rcl            !<
     REAL(wp) ::  rclo           !< Radiational loss of clothing     (W/m²)
     REAL(wp) ::  rclo2          !< Longwave radiation gain or loss  (W/m²)
     REAL(wp) ::  rsum           !< Radiational loss or gain         (W/m²)
-    REAL(wp) ::  sw             !< 
-!     REAL(wp) ::  swf            !< female factor, currently unused
-    REAL(wp) ::  swm            !< 
-    REAL(wp) ::  tbody          !< 
-    REAL(wp) ::  tcore(1:7)     !< 
-    REAL(wp) ::  vb             !< 
-    REAL(wp) ::  vb1            !< 
-    REAL(wp) ::  vb2            !< 
-    REAL(wp) ::  wd             !< 
-    REAL(wp) ::  wr             !< 
-    REAL(wp) ::  ws             !< 
-    REAL(wp) ::  wsum           !< 
+    REAL(wp) ::  sw             !<
+!    REAL(wp) ::  swf            !< female factor, currently unused
+    REAL(wp) ::  swm            !<
+    REAL(wp) ::  tbody          !<
+    REAL(wp) ::  vb             !<
+    REAL(wp) ::  vb1            !<
+    REAL(wp) ::  vb2            !<
+    REAL(wp) ::  wd             !<
+    REAL(wp) ::  wr             !<
+    REAL(wp) ::  ws             !<
+    REAL(wp) ::  wsum           !<
     REAL(wp) ::  xx             !< modification step                (K)
     REAL(wp) ::  y              !< fraction of bare skin
-    INTEGER(iwp) ::  count1     !< running index
-    INTEGER(iwp) ::  count3     !< running index
-    INTEGER(iwp) ::  j          !< running index
-    INTEGER(iwp) ::  i          !< running index
-    LOGICAL ::  skipIncreaseCount   !< iteration control flag
+
+    REAL(wp) ::  c(0:10)        !< Core temperature array           (degree_C)
+    REAL(wp) ::  tcore(1:7)     !<
 
 !
 !-- Initialize
-    wetsk = 0._wp  !< skin is dry everywhere on init (no non-evaporated sweat)
+    wetsk = 0.0_wp  !< skin is dry everywhere on init (no non-evaporated sweat)
 !
 !-- Set Du Bois Area for the sample person
@@ -4028 +3994 @@
 !
 !-- Set surface modification by clothing
-    facl = ( - 2.36_wp + 173.51_wp * clo - 100.76_wp * clo * clo + 19.28_wp    &
-          * ( clo**3._wp ) ) / 100._wp
-    IF ( facl > 1._wp )  facl = 1._wp
+    facl = ( - 2.36_wp + 173.51_wp * clo - 100.76_wp * clo * clo + 19.28_wp * ( clo**3.0_wp ) )    &
+           / 100.0_wp
+    IF ( facl > 1.0_wp )  facl = 1.0_wp
 !
 !-- Initialize heat resistences
     rcl = ( clo / 6.45_wp ) / facl
-    IF ( clo >= 2._wp )  y  = 1._wp
-    IF ( ( clo > 0.6_wp )   .AND.  ( clo < 2._wp ) )   y = ( ht - 0.2_wp ) / ht
+    IF ( clo >= 2.0_wp )  y  = 1.0_wp
+    IF ( ( clo > 0.6_wp )   .AND.  ( clo < 2.0_wp ) )   y = ( ht - 0.2_wp ) / ht
     IF ( ( clo <= 0.6_wp )  .AND.  ( clo > 0.3_wp ) )  y = 0.5_wp
-    IF ( ( clo <= 0.3_wp )  .AND.  ( clo > 0._wp ) )   y = 0.1_wp
-    r2   = adu * ( fcl - 1._wp + facl ) / ( 2._wp * 3.14_wp * ht * y )
-    r1   = facl * adu / ( 2._wp * 3.14_wp * ht * y )
+    IF ( ( clo <= 0.3_wp )  .AND.  ( clo > 0.0_wp ) )   y = 0.1_wp
+    r2   = adu * ( fcl - 1.0_wp + facl ) / ( 2.0_wp * 3.14_wp * ht * y )
+    r1   = facl * adu / ( 2.0_wp * 3.14_wp * ht * y )
     di   = r2 - r1
 
@@ -4046 +4012 @@
     DO  j = 1, 7
 
-       tsk    = 34._wp
+       tsk    = 34.0_wp
        count1 = 0_iwp
-       tcl    = ( ta + tmrt + tsk ) / 3._wp
+       tcl    = ( ta + tmrt + tsk ) / 3.0_wp
        count3 = 1_iwp
-       enbal2 = 0._wp
+       enbal2 = 0.0_wp
 
        DO  i = 1, 100  ! allow for 100 iterations max
-          acl   = adu * facl + adu * ( fcl - 1._wp )
-          rclo2 = emcl * sigma_sb * ( ( tcl + degc_to_k )**4._wp -             &
-            ( tmrt + degc_to_k )**4._wp ) * feff
+          acl   = adu * facl + adu * ( fcl - 1.0_wp )
+          rclo2 = emcl * sigma_sb * ( ( tcl + degc_to_k )**4.0_wp -                                &
+                  ( tmrt + degc_to_k )**4.0_wp ) * feff
           htcl  = 6.28_wp * ht * y * di / ( rcl * LOG( r2 / r1 ) * acl )
-          tsk   = 1._wp / htcl * ( hc * ( tcl - ta ) + rclo2 ) + tcl
+          tsk   = 1.0_wp / htcl * ( hc * ( tcl - ta ) + rclo2 ) + tcl
 !
 !--       Radiation saldo
           aeff  = adu * feff
-          rbare = aeff * ( 1._wp - facl ) * emsk * sigma_sb *                  &
-            ( ( tmrt + degc_to_k )**4._wp - ( tsk + degc_to_k )**4._wp )
-          rclo  = feff * acl * emcl * sigma_sb *                               &
-            ( ( tmrt + degc_to_k )**4._wp - ( tcl + degc_to_k )**4._wp )
+          rbare = aeff * ( 1.0_wp - facl ) * emsk * sigma_sb *                                     &
+                  ( ( tmrt + degc_to_k )**4.0_wp - ( tsk + degc_to_k )**4.0_wp )
+          rclo  = feff * acl * emcl * sigma_sb *                                                   &
+                  ( ( tmrt + degc_to_k )**4.0_wp - ( tcl + degc_to_k )**4.0_wp )
           rsum  = rbare + rclo
 !
 !--       Convection
-          cbare = hc * ( ta - tsk ) * adu * ( 1._wp - facl )
+          cbare = hc * ( ta - tsk ) * adu * ( 1.0_wp - facl )
           cclo  = hc * ( ta - tcl ) * acl
           csum  = cbare + cclo
@@ -4075 +4041 @@
           c(0)  = int_heat + ere
           c(1)  = adu * rob * cb
-          c(2)  = 18._wp - 0.5_wp * tsk
+          c(2)  = 18.0_wp - 0.5_wp * tsk
           c(3)  = 5.28_wp * adu * c(2)
           c(4)  = 0.0208_wp * c(1)
@@ -4081 +4047 @@
           c(6)  = c(3) - c(5) - tsk * c(4)
           c(7)  = - c(0) * c(2) - tsk * c(3) + tsk * c(5)
-          c(8)  = c(6) * c(6) - 4._wp * c(4) * c(7)
+          c(8)  = c(6) * c(6) - 4.0_wp * c(4) * c(7)
           c(9)  = 5.28_wp * adu - c(5) - c(4) * tsk
-          c(10) = c(9) * c(9) - 4._wp * c(4) *                                 &
-                  ( c(5) * tsk - c(0) - 5.28_wp * adu * tsk )
-
-          IF ( ABS( tsk - 36._wp ) < 0.00001_wp )  tsk = 36.01_wp
-          tcore(7) = c(0) / ( 5.28_wp * adu + c(1) * 6.3_wp / 3600._wp ) + tsk
-          tcore(3) = c(0) / ( 5.28_wp * adu + ( c(1) * 6.3_wp / 3600._wp ) /   &
-            ( 1._wp + 0.5_wp * ( 34._wp - tsk ) ) ) + tsk
-          IF ( c(10) >= 0._wp )  THEN
-             tcore(6) = ( - c(9) - c(10)**0.5_wp ) / ( 2._wp * c(4) )
-             tcore(1) = ( - c(9) + c(10)**0.5_wp ) / ( 2._wp * c(4) )
+          c(10) = c(9) * c(9) - 4.0_wp * c(4) * ( c(5) * tsk - c(0) - 5.28_wp * adu * tsk )
+
+          IF ( ABS( tsk - 36.0_wp ) < 0.00001_wp )  tsk = 36.01_wp
+          tcore(7) = c(0) / ( 5.28_wp * adu + c(1) * 6.3_wp / 3600.0_wp ) + tsk
+          tcore(3) = c(0) / ( 5.28_wp * adu + ( c(1) * 6.3_wp / 3600.0_wp ) /   &
+                     ( 1.0_wp + 0.5_wp * ( 34.0_wp - tsk ) ) ) + tsk
+          IF ( c(10) >= 0.0_wp )  THEN
+             tcore(6) = ( - c(9) - c(10)**0.5_wp ) / ( 2.0_wp * c(4) )
+             tcore(1) = ( - c(9) + c(10)**0.5_wp ) / ( 2.0_wp * c(4) )
           ENDIF
 
-          IF ( c(8) >= 0._wp )  THEN
-             tcore(2) = ( - c(6) + ABS( c(8) )**0.5_wp ) / ( 2._wp * c(4) )
-             tcore(5) = ( - c(6) - ABS( c(8) )**0.5_wp ) / ( 2._wp * c(4) )
-             tcore(4) = c(0) / ( 5.28_wp * adu + c(1) * 1._wp / 40._wp ) + tsk
+          IF ( c(8) >= 0.0_wp )  THEN
+             tcore(2) = ( - c(6) + ABS( c(8) )**0.5_wp ) / ( 2.0_wp * c(4) )
+             tcore(5) = ( - c(6) - ABS( c(8) )**0.5_wp ) / ( 2.0_wp * c(4) )
+             tcore(4) = c(0) / ( 5.28_wp * adu + c(1) * 1.0_wp / 40.0_wp ) + tsk
           ENDIF
 !
 !--       Transpiration
           tbody = 0.1_wp * tsk + 0.9_wp * tcore(j)
-          swm   = 304.94_wp * ( tbody - 36.6_wp ) * adu / 3600000._wp
-          vpts  = 6.11_wp * 10._wp**( 7.45_wp * tsk / ( 235._wp + tsk ) )
-
-          IF ( tbody <= 36.6_wp )  swm = 0._wp  !< no need for sweating
+          swm   = 304.94_wp * ( tbody - 36.6_wp ) * adu / 3600000.0_wp
+          vpts  = 6.11_wp * 10.0_wp**( 7.45_wp * tsk / ( 235.0_wp + tsk ) )
+
+          IF ( tbody <= 36.6_wp )  swm = 0.0_wp  !< no need for sweating
 
           sw = swm
           eswphy = - sw * l_v
           he     = 0.633_wp * hc / ( pair * c_p )
-          fec    = 1._wp / ( 1._wp + 0.92_wp * hc * rcl )
+          fec    = 1.0_wp / ( 1.0_wp + 0.92_wp * hc * rcl )
           eswpot = he * ( vpa - vpts ) * adu * l_v * fec
           wetsk  = eswphy / eswpot
 
-          IF ( wetsk > 1._wp )  wetsk = 1._wp
+          IF ( wetsk > 1.0_wp )  wetsk = 1.0_wp
 !
 !--       Sweat production > evaporation?
           eswdif = eswphy - eswpot
 
-          IF ( eswdif <= 0._wp )  esw = eswpot  !< Limit is evaporation
-          IF ( eswdif > 0._wp )   esw = eswphy  !< Limit is sweat production
-          IF ( esw  > 0._wp )     esw = 0._wp   !< Sweat can't be evaporated, no more cooling effect
+          IF ( eswdif <= 0.0_wp )  esw = eswpot     !< Limit is evaporation
+          IF ( eswdif > 0.0_wp )   esw = eswphy     !< Limit is sweat production
+          IF ( esw  > 0.0_wp )     esw = 0.0_wp     !< Sweat can't be evaporated, no more cooling 
+                                                    !< effect
 !
 !--       Diffusion
-          rdsk = 0.79_wp * 10._wp**7._wp
-          rdcl = 0._wp
-          ed   = l_v / ( rdsk + rdcl ) * adu * ( 1._wp - wetsk ) * ( vpa -     &
-             vpts )
+          rdsk = 0.79_wp * 10.0_wp**7.0_wp
+          rdcl = 0.0_wp
+          ed   = l_v / ( rdsk + rdcl ) * adu * ( 1.0_wp - wetsk ) * ( vpa - vpts )
 !
 !--       Max vb
-          vb1 = 34._wp - tsk
+          vb1 = 34.0_wp - tsk
           vb2 = tcore(j) - 36.6_wp
 
-          IF ( vb2 < 0._wp )  vb2 = 0._wp
-          IF ( vb1 < 0._wp )  vb1 = 0._wp
-          vb = ( 6.3_wp + 75._wp * vb2 ) / ( 1._wp + 0.5_wp * vb1 )
+          IF ( vb2 < 0.0_wp )  vb2 = 0.0_wp
+          IF ( vb1 < 0.0_wp )  vb1 = 0.0_wp
+          vb = ( 6.3_wp + 75.0_wp * vb2 ) / ( 1.0_wp + 0.5_wp * vb1 )
 !
 !--       Energy ballence
@@ -4143 +4108 @@
 !--       Clothing temperature
           xx = 0.001_wp
-          IF ( count1 == 0_iwp )  xx = 1._wp
+          IF ( count1 == 0_iwp )  xx = 1.0_wp
           IF ( count1 == 1_iwp )  xx = 0.1_wp
           IF ( count1 == 2_iwp )  xx = 0.01_wp
           IF ( count1 == 3_iwp )  xx = 0.001_wp
 
-          IF ( enbal > 0._wp )  tcl = tcl + xx
-          IF ( enbal < 0._wp )  tcl = tcl - xx
-
-          skipIncreaseCount = .FALSE.
-          IF ( ( (enbal <= 0._wp )  .AND.  (enbal2 > 0._wp ) )  .OR.           &
-             ( ( enbal >= 0._wp )  .AND.  ( enbal2 < 0._wp ) ) )  THEN
-             skipIncreaseCount = .TRUE.
+          IF ( enbal > 0.0_wp )  tcl = tcl + xx
+          IF ( enbal < 0.0_wp )  tcl = tcl - xx
+
+          skipincreasecount = .FALSE.
+          IF ( ( (enbal <= 0.0_wp )  .AND.  (enbal2 > 0.0_wp ) )  .OR.                             &
+             ( ( enbal >= 0.0_wp )   .AND.  ( enbal2 < 0.0_wp ) ) )  THEN
+             skipincreasecount = .TRUE.
           ELSE
              enbal2 = enbal
@@ -4160 +4125 @@
           ENDIF
 
-          IF ( ( count3 > 200_iwp )  .OR.  skipIncreaseCount )  THEN
+          IF ( ( count3 > 200_iwp )  .OR.  skipincreasecount )  THEN
              IF ( count1 < 3_iwp )  THEN
                 count1 = count1 + 1_iwp
-                enbal2 = 0._wp
+                enbal2 = 0.0_wp
              ELSE
                 EXIT
@@ -4172 +4137 @@
        IF ( count1 == 3_iwp )  THEN
           SELECT CASE ( j )
-             CASE ( 2, 5) 
-                IF ( .NOT. ( ( tcore(j) >= 36.6_wp )  .AND.                    &
-                   ( tsk <= 34.050_wp ) ) )  CYCLE
+             CASE ( 2, 5)
+                IF ( .NOT. ( ( tcore(j) >= 36.6_wp )  .AND.  ( tsk <= 34.050_wp ) ) )  CYCLE
              CASE ( 6, 1 )
-                IF ( c(10) < 0._wp ) CYCLE
-                IF ( .NOT. ( ( tcore(j) >= 36.6_wp )  .AND.                    &
-                   ( tsk > 33.850_wp ) ) )  CYCLE
+                IF ( c(10) < 0.0_wp ) CYCLE
+                IF ( .NOT. ( ( tcore(j) >= 36.6_wp )  .AND.  ( tsk > 33.850_wp ) ) )  CYCLE
              CASE ( 3 )
-                IF ( .NOT. ( ( tcore(j) < 36.6_wp )  .AND.                     &
-                   ( tsk <= 34.000_wp ) ) )  CYCLE
+                IF ( .NOT. ( ( tcore(j) < 36.6_wp )  .AND.  ( tsk <= 34.000_wp ) ) )  CYCLE
              CASE ( 7 )
-                IF ( .NOT. ( ( tcore(j) < 36.6_wp )  .AND.                     &
-                   ( tsk > 34.000_wp ) ) )  CYCLE
+                IF ( .NOT. ( ( tcore(j) < 36.6_wp )  .AND.  ( tsk > 34.000_wp ) ) )  CYCLE
              CASE default
           END SELECT
        ENDIF
 
-       IF ( ( j /= 4_iwp )  .AND.  ( vb >= 91._wp ) )  CYCLE
-       IF ( ( j == 4_iwp )  .AND.  ( vb < 89._wp ) )  CYCLE
-       IF ( vb > 90._wp ) vb = 90._wp
+       IF ( ( j /= 4_iwp )  .AND.  ( vb >= 91.0_wp ) )  CYCLE
+       IF ( ( j == 4_iwp )  .AND.  ( vb < 89.0_wp ) )  CYCLE
+       IF ( vb > 90.0_wp ) vb = 90.0_wp
 !
 !--    Loses by water
-       ws = sw * 3600._wp * 1000._wp
-       IF ( ws > 2000._wp )  ws = 2000._wp
-       wd = ed / l_v * 3600._wp * ( -1000._wp )
-       wr = erel / l_v * 3600._wp * ( -1000._wp )
+       ws = sw * 3600.0_wp * 1000.0_wp
+       IF ( ws > 2000.0_wp )  ws = 2000.0_wp
+       wd = ed / l_v * 3600.0_wp * ( -1000.0_wp )
+       wr = erel / l_v * 3600.0_wp * ( -1000.0_wp )
 
        wsum = ws + wr + wd
@@ -4205 +4166 @@
  END SUBROUTINE heat_exch
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Calculate PET
-!------------------------------------------------------------------------------!
- SUBROUTINE pet_iteration( acl, adu, aeff, esw, facl, feff, int_heat, pair,    &
-        rdcl, rdsk, rtv, ta, tcl, tsk, pet_ij, vpts, wetsk )
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE pet_iteration( acl, adu, aeff, esw, facl, feff, int_heat, pair, rdcl, rdsk, rtv, ta,   &
+                           tcl, tsk, pet_ij, vpts, wetsk )
 !
 !-- Input arguments:
-    REAL(wp), INTENT( IN ) ::  acl   !< clothing surface area        (m²)
-    REAL(wp), INTENT( IN ) ::  adu   !< Du-Bois area                 (m²)
-    REAL(wp), INTENT( IN ) ::  esw   !< energy-loss through sweat evap. (W)
-    REAL(wp), INTENT( IN ) ::  facl  !< surface area extension through clothing (factor)
-    REAL(wp), INTENT( IN ) ::  feff  !< surface modification by posture (factor)
+    REAL(wp), INTENT( IN ) ::  acl       !< clothing surface area        (m²)
+    REAL(wp), INTENT( IN ) ::  adu       !< Du-Bois area                 (m²)
+    REAL(wp), INTENT( IN ) ::  esw       !< energy-loss through sweat evap. (W)
+    REAL(wp), INTENT( IN ) ::  facl      !< surface area extension through clothing (factor)
+    REAL(wp), INTENT( IN ) ::  feff      !< surface modification by posture (factor)
     REAL(wp), INTENT( IN ) ::  int_heat  !< internal heat production (W)
-    REAL(wp), INTENT( IN ) ::  pair  !< air pressure                 (hPa)
-    REAL(wp), INTENT( IN ) ::  rdcl  !< diffusion resistence of clothing (factor)
-    REAL(wp), INTENT( IN ) ::  rdsk  !< diffusion resistence of skin (factor)
-    REAL(wp), INTENT( IN ) ::  rtv   !< respiratory volume
-    REAL(wp), INTENT( IN ) ::  ta    !< air temperature              (degree_C)
-    REAL(wp), INTENT( IN ) ::  tcl   !< clothing temperature         (degree_C)
-    REAL(wp), INTENT( IN ) ::  tsk   !< skin temperature             (degree_C)
-    REAL(wp), INTENT( IN ) ::  vpts  !< sat. vapor pressure over skin (hPa)
-    REAL(wp), INTENT( IN ) ::  wetsk !< fraction of wet skin (dimensionless)
+    REAL(wp), INTENT( IN ) ::  pair      !< air pressure                 (hPa)
+    REAL(wp), INTENT( IN ) ::  rdcl      !< diffusion resistence of clothing (factor)
+    REAL(wp), INTENT( IN ) ::  rdsk      !< diffusion resistence of skin (factor)
+    REAL(wp), INTENT( IN ) ::  rtv       !< respiratory volume
+    REAL(wp), INTENT( IN ) ::  ta        !< air temperature              (degree_C)
+    REAL(wp), INTENT( IN ) ::  tcl       !< clothing temperature         (degree_C)
+    REAL(wp), INTENT( IN ) ::  tsk       !< skin temperature             (degree_C)
+    REAL(wp), INTENT( IN ) ::  vpts      !< sat. vapor pressure over skin (hPa)
+    REAL(wp), INTENT( IN ) ::  wetsk     !< fraction of wet skin (dimensionless)
 !
 !-- Output arguments:
@@ -4240 +4201 @@
 !
 !-- Internal variables
+    INTEGER ( iwp ) ::  count1        !< running index
+    INTEGER ( iwp ) ::  i             !< running index
+
     REAL ( wp ) ::  cbare             !< Convection through bare skin
     REAL ( wp ) ::  cclo              !< Convection through clothing
@@ -4257 +4221 @@
     REAL ( wp ) ::  xx                !< Delta PET per iteration        (K)
 
-    INTEGER ( iwp ) ::  count1        !< running index
-    INTEGER ( iwp ) ::  i             !< running index
 
     pet_ij = ta
-    enbal2 = 0._wp
+    enbal2 = 0.0_wp
 
     DO  count1 = 0, 3
@@ -4270 +4232 @@
 !--       Radiation
           aeff  = adu * feff
-          rbare = aeff * ( 1._wp - facl ) * emsk * sigma_sb *                  &
-              ( ( pet_ij + degc_to_k )**4._wp - ( tsk + degc_to_k )**4._wp )
+          rbare = aeff * ( 1.0_wp - facl ) * emsk * sigma_sb *                  &
+                  ( ( pet_ij + degc_to_k )**4.0_wp - ( tsk + degc_to_k )**4.0_wp )
           rclo  = feff * acl * emcl * sigma_sb *                               &
-              ( ( pet_ij + degc_to_k )**4._wp - ( tcl + degc_to_k )**4._wp )
+                  ( ( pet_ij + degc_to_k )**4.0_wp - ( tcl + degc_to_k )**4.0_wp )
           rsum  = rbare + rclo
 !
 !--       Covection
-          cbare = hc * ( pet_ij - tsk ) * adu * ( 1._wp - facl )
+          cbare = hc * ( pet_ij - tsk ) * adu * ( 1.0_wp - facl )
           cclo  = hc * ( pet_ij - tcl ) * acl
           csum  = cbare + cclo
 !
 !--       Diffusion
-          ed = l_v / ( rdsk + rdcl ) * adu * ( 1._wp - wetsk ) * ( 12._wp -    &
-             vpts )
+          ed = l_v / ( rdsk + rdcl ) * adu * ( 1.0_wp - wetsk ) * ( 12.0_wp - vpts )
 !
 !--       Respiration
-          tex  = 0.47_wp * pet_ij + 21._wp
+          tex  = 0.47_wp * pet_ij + 21.0_wp
           eres = c_p * ( pet_ij - tex ) * rtv
-          vpex = 6.11_wp * 10._wp**( 7.45_wp * tex / ( 235._wp + tex ) )
-          erel = 0.623_wp * l_v / pair * ( 12._wp - vpex ) * rtv
+          vpex = 6.11_wp * 10.0_wp**( 7.45_wp * tex / ( 235.0_wp + tex ) )
+          erel = 0.623_wp * l_v / pair * ( 12.0_wp - vpex ) * rtv
           ere  = eres + erel
 !
@@ -4297 +4258 @@
 !--       Iteration concerning ta
           xx = 0.001_wp
-          IF ( count1 == 0_iwp )  xx = 1._wp
+          IF ( count1 == 0_iwp )  xx = 1.0_wp
           IF ( count1 == 1_iwp )  xx = 0.1_wp
           IF ( count1 == 2_iwp )  xx = 0.01_wp
 !           IF ( count1 == 3_iwp )  xx = 0.001_wp
-          IF ( enbal > 0._wp )  pet_ij = pet_ij - xx
-          IF ( enbal < 0._wp )  pet_ij = pet_ij + xx
-          IF ( ( enbal <= 0._wp )  .AND.  ( enbal2 > 0._wp ) )  EXIT
-          IF ( ( enbal >= 0._wp )  .AND.  ( enbal2 < 0._wp ) )  EXIT
+          IF ( enbal > 0.0_wp )  pet_ij = pet_ij - xx
+          IF ( enbal < 0.0_wp )  pet_ij = pet_ij + xx
+          IF ( ( enbal <= 0.0_wp )  .AND.  ( enbal2 > 0.0_wp ) )  EXIT
+          IF ( ( enbal >= 0.0_wp )  .AND.  ( enbal2 < 0.0_wp ) )  EXIT
 
           enbal2 = enbal
@@ -4322 +4283 @@
 
     USE control_parameters,                                                                        &
-       ONLY:  latitude, longitude, time_since_reference_point
+       ONLY:  latitude, longitude, time_SINce_reference_point
 
     IMPLICIT NONE
@@ -4328 +4289 @@
     INTEGER(iwp) ::  day_of_year = 0       !< day of year
 
-    REAL(wp) ::  alpha         = 0.0_wp    !< solar azimuth angle in radiant    
+    REAL(wp) ::  alpha         = 0.0_wp    !< solar azimuth angle in radiant
     REAL(wp) ::  declination   = 0.0_wp    !< declination
     REAL(wp) ::  dtor          = 0.0_wp    !< factor to convert degree to radiant
@@ -4336 +4297 @@
     REAL(wp) ::  second_of_day = 0.0_wp    !< current second of the day
     REAL(wp) ::  thetar        = 0.0_wp    !< angle for solar zenith angle calculation
-    REAL(wp) ::  thetasr       = 0.0_wp    !< angle for solar azimuth angle calculation    
-    REAL(wp) ::  zgl           = 0.0_wp    !< calculated exposure by direct beam   
+    REAL(wp) ::  thetasr       = 0.0_wp    !< angle for solar azimuth angle calculation
+    REAL(wp) ::  zgl           = 0.0_wp    !< calculated exposure by direct beam
     REAL(wp) ::  woz           = 0.0_wp    !< calculated exposure by diffuse radiation
-    REAL(wp) ::  wsp           = 0.0_wp    !< calculated exposure by direct beam   
-
-
-    CALL get_date_time( time_since_reference_point, &
-                        day_of_year = day_of_year, second_of_day = second_of_day )
+    REAL(wp) ::  wsp           = 0.0_wp    !< calculated exposure by direct beam
+
+
+    CALL get_date_time( time_SINce_reference_point, day_of_year = day_of_year,                     &
+                        second_of_day = second_of_day )
     dtor = pi / 180.0_wp
     lat = latitude
     lon = longitude
 !
-!-- calculation of js, necessary for calculation of equation of time (zgl) :
-    js=  72.0_wp * ( REAL( day_of_year, KIND=wp ) + ( second_of_day / 86400.0_wp ) ) / 73.0_wp 
-!
-!-- calculation of equation of time (zgl):
-    zgl = 0.0066_wp + 7.3525_wp * cos( ( js + 85.9_wp ) * dtor ) + 9.9359_wp *                                        &
-    cos( ( 2.0_wp * js + 108.9_wp ) * dtor ) + 0.3387_wp * cos( ( 3 * js + 105.2_wp ) * dtor )
-!
-!-- calculation of apparent solar time woz:
-    woz = ( ( second_of_day / 3600.0_wp ) - ( 4.0_wp * ( 15.0_wp - lon ) ) / 60.0_wp ) + ( zgl / 60.0_wp )
-!
-!-- calculation of hour angle (wsp):
+!-- Calculation of js, necessary for calculation of equation of time (zgl) :
+    js=  72.0_wp * ( REAL( day_of_year, KIND = wp ) + ( second_of_day / 86400.0_wp ) ) / 73.0_wp
+!
+!-- Calculation of equation of time (zgl):
+    zgl = 0.0066_wp + 7.3525_wp * COS( ( js + 85.9_wp ) * dtor ) + 9.9359_wp *                     &
+    COS( ( 2.0_wp * js + 108.9_wp ) * dtor ) + 0.3387_wp * COS( ( 3 * js + 105.2_wp ) * dtor )
+!
+!-- Calculation of apparent solar time woz:
+    woz = ( ( second_of_day / 3600.0_wp ) - ( 4.0_wp * ( 15.0_wp - lon ) ) / 60.0_wp ) +           &
+          ( zgl / 60.0_wp )
+!
+!-- Calculation of hour angle (wsp):
     wsp = ( woz - 12.0_wp ) * 15.0_wp
 !
-!-- calculation of declination:
-    declination = 0.3948_wp - 23.2559_wp * cos( ( js + 9.1_wp ) * dtor ) -                                            &
-    0.3915_wp * cos( ( 2.0_wp * js + 5.4_wp ) * dtor ) - 0.1764_wp * cos( ( 3.0_wp * js + 26.0_wp ) * dtor )
-!
-!-- calculation of solar zenith angle
-    thetar  = acos( sin( lat * dtor) * sin( declination * dtor ) + cos( wsp * dtor ) *                                &
-    cos( lat * dtor ) * cos( declination * dtor ) )
-    thetasr = asin( sin( lat * dtor) * sin( declination * dtor ) + cos( wsp * dtor ) *                                & 
-    cos( lat * dtor ) * cos( declination * dtor ) )
+!-- Calculation of declination:
+    declination = 0.3948_wp - 23.2559_wp * COS( ( js + 9.1_wp ) * dtor ) -                         &
+                  0.3915_wp * COS( ( 2.0_wp * js + 5.4_wp ) * dtor ) - 0.1764_wp *                 &
+                  COS( ( 3.0_wp * js + 26.0_wp ) * dtor )
+!
+!-- Calculation of solar zenith angle
+    thetar  = ACOS( SIN( lat * dtor) * SIN( declination * dtor ) + COS( wsp * dtor ) *             &
+              COS( lat * dtor ) * COS( declination * dtor ) )
+    thetasr = ASIN( SIN( lat * dtor) * SIN( declination * dtor ) + COS( wsp * dtor ) *             &
+              COS( lat * dtor ) * COS( declination * dtor ) )
     sza = thetar / dtor
 !
 !-- calculation of solar azimuth angle
-    IF (woz <= 12.0_wp) alpha = pi - acos( ( sin(thetasr) * sin( lat * dtor ) -                                     &
-    sin( declination * dtor ) ) / ( cos(thetasr) * cos( lat * dtor ) ) )    
-    IF (woz > 12.0_wp)  alpha = pi + acos( ( sin(thetasr) * sin( lat * dtor ) -                                     &
-    sin( declination * dtor ) ) / ( cos(thetasr) * cos( lat * dtor ) ) )    
+    IF (woz <= 12.0_wp) alpha = pi - ACOS( ( SIN(thetasr) * SIN( lat * dtor ) -                    &
+                                SIN( declination * dtor ) ) / ( COS(thetasr) * COS( lat * dtor ) ) )
+    IF (woz > 12.0_wp)  alpha = pi + ACOS( ( SIN(thetasr) * SIN( lat * dtor ) -                    &
+                                SIN( declination * dtor ) ) / ( COS(thetasr) * COS( lat * dtor ) ) )
     saa = alpha / dtor
 
@@ -4382 +4345 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
 !> Module-specific routine for new module
-!---------------------------------------------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE bio_calculate_uv_exposure
 
-    USE indices,                                                                                                      &
-        ONLY:  nys, nyn, nxl, nxr
-    
-    
-    IMPLICIT NONE   
-    
+    USE indices,                                                                                   &
+        ONLY:  nxl, nxr, nyn, nys
+
+
+    IMPLICIT NONE
+
     INTEGER(iwp) ::  i     !< loop index in x direction
     INTEGER(iwp) ::  j     !< loop index in y direction
@@ -4400 +4363 @@
 
     CALL uvem_solar_position
-     
+
     IF (sza  >=  90)  THEN
        vitd3_exposure(:,:) = 0.0_wp
     ELSE
-       
+
        DO  ai = 0, 35
           DO  zi = 0, 9
-                projection_area_lookup_table(ai,zi) = uvem_projarea_f%var(clothing,zi,ai)
+             projection_area_lookup_table(ai,zi) = uvem_projarea_f%var(clothing,zi,ai)
           ENDDO
        ENDDO
        DO  ai = 0, 35
           DO  zi = 0, 9
-                integration_array(ai,zi) = uvem_integration_f%var(zi,ai)
+             integration_array(ai,zi) = uvem_integration_f%var(zi,ai)
           ENDDO
        ENDDO
        DO  ai = 0, 2
           DO  zi = 0, 90
-                irradiance_lookup_table(ai,zi) = uvem_irradiance_f%var(zi,ai)
+             irradiance_lookup_table(ai,zi) = uvem_irradiance_f%var(zi,ai)
           ENDDO
        ENDDO
@@ -4427 +4390 @@
           ENDDO
        ENDDO
-        
-        
-        
-!--    rotate 3D-Model human to desired direction  ----------------------------- 
+
+
+!--    Rotate 3D-Model human to desired direction
        projection_area_temp( 0:35,:) = projection_area_lookup_table
-       projection_area_temp(36:71,:) = projection_area_lookup_table               
+       projection_area_temp(36:71,:) = projection_area_lookup_table
        IF (  .NOT.  turn_to_sun ) startpos_human = orientation_angle / 10.0_wp
-       IF (       turn_to_sun ) startpos_human = saa / 10.0_wp        
+       IF (       turn_to_sun ) startpos_human = saa / 10.0_wp
        DO  ai = 0, 35
           xfactor = ( startpos_human ) - INT( startpos_human )
           DO  zi = 0, 9
-             projection_area(ai,zi) = ( projection_area_temp( 36 - INT( startpos_human ) - 1 + ai , zi) *             &
-                                      ( xfactor ) )                                                                   &
-                                      +( projection_area_temp( 36 - INT( startpos_human ) + ai , zi) *                &
-                                      ( 1.0_wp - xfactor ) )
+             projection_area(ai,zi) = ( projection_area_temp( 36 -                                 &
+                                                               INT( startpos_human ) - 1 + ai , zi)&
+                                        * ( xfactor ) )                                            &
+                                      + ( projection_area_temp( 36 -                               &
+                                                                INT( startpos_human ) + ai , zi)   &
+                                        * ( 1.0_wp - xfactor ) )
           ENDDO
-       ENDDO           
-!             
-!           
-!--    interpolate to accurate Solar Zenith Angle  ------------------          
+       ENDDO
+!
+!
+!--    Interpolate to accurate Solar Zenith Angle
        DO  ai = 0, 35
-          xfactor = (sza)-INT(sza)
+          xfactor = ( sza )-INT( sza )
           DO  zi = 0, 9
-             radiance_array(ai,zi) = ( radiance_lookup_table(ai, zi, INT(sza) ) * ( 1.0_wp - xfactor) ) +             &
-             ( radiance_lookup_table(ai,zi,INT(sza) + 1) * xfactor )
+             radiance_array(ai,zi) = ( radiance_lookup_table(ai, zi, INT( sza ) ) *                &
+                                     ( 1.0_wp - xfactor) ) +                                       &
+                                     ( radiance_lookup_table(ai,zi,INT( sza ) + 1) * xfactor )
           ENDDO
        ENDDO
        DO  iq = 0, 2
-          irradiance(iq) = ( irradiance_lookup_table(iq, INT(sza) ) * ( 1.0_wp - xfactor)) +                          &
-          (irradiance_lookup_table(iq, INT(sza) + 1) * xfactor )
-       ENDDO   
-!         
-!--    interpolate to accurate Solar Azimuth Angle ------------------
+          irradiance(iq) = ( irradiance_lookup_table(iq, INT( sza ) ) * ( 1.0_wp - xfactor)) +     &
+                           ( irradiance_lookup_table(iq, INT( sza ) + 1) * xfactor )
+       ENDDO
+!
+!--    Interpolate to accurate Solar Azimuth Angle
        IF ( sun_in_south )  THEN
           startpos_saa_float = 180.0_wp / 10.0_wp
-       ELSE 
+       ELSE
           startpos_saa_float = saa / 10.0_wp
        ENDIF
        radiance_array_temp( 0:35,:) = radiance_array
        radiance_array_temp(36:71,:) = radiance_array
-       xfactor = (startpos_saa_float) - INT(startpos_saa_float)
+       xfactor = (startpos_saa_float) - INT( startpos_saa_float )
        DO  ai = 0, 35
           DO  zi = 0, 9
-             radiance_array(ai,zi) = ( radiance_array_temp( 36 - INT( startpos_saa_float ) - 1 + ai , zi ) *          &
-                                     ( xfactor ) )                                                                    &
-                                     + ( radiance_array_temp( 36 - INT( startpos_saa_float ) + ai , zi )              &
-                                     * ( 1.0_wp - xfactor ) )
+             radiance_array(ai,zi) = ( radiance_array_temp(36 -                                    &
+                                                           INT( startpos_saa_float ) - 1 + ai, zi) &
+                                       * ( xfactor ) )                                             &
+                                     + ( radiance_array_temp(36 -                                  &
+                                                             INT( startpos_saa_float ) + ai, zi)   &
+                                       * ( 1.0_wp - xfactor ) )
           ENDDO
-       ENDDO 
-!        
-!      
-!--    calculate Projectionarea for direct beam -----------------------------'
+       ENDDO
+
+!
+!--    Calculate Projectionarea for direct beam
        projection_area_direct_temp( 0:35,:) = projection_area
        projection_area_direct_temp(36:71,:) = projection_area
@@ -4491 +4458 @@
                                      ( projection_area_direct_temp( INT(startpos_saa_float) + 1,INT(sza/10.0_wp)+1) * &
                                      (          xfactor ) * (          yfactor ) )
-!                                                
-!                                                
-!                                                
+
+
        DO  i = nxl, nxr
           DO  j = nys, nyn
-!                   
-! !--        extract obstruction from IBSET-Integer_Array ------------------'
+!
+!--          Extract obstruction from IBSET-Integer_Array
              IF (consider_obstructions )  THEN
                 obstruction_temp1 = building_obstruction_f%var_3d(:,j,i)
                 IF ( obstruction_temp1(0)  /=  9 )  THEN
-                   DO  pobi = 0, 44 
-                      DO  bi = 0, 7 
-                         IF ( btest( obstruction_temp1(pobi), bi )  .EQV.  .TRUE.)  THEN
+                   DO  pobi = 0, 44
+                      DO  bi = 0, 7
+                         IF ( BTEST( obstruction_temp1(pobi), bi )  .EQV.  .TRUE.)  THEN
                             obstruction_temp2( ( pobi * 8 ) + bi ) = 1
                          ELSE
@@ -4509 +4475 @@
                          ENDIF
                       ENDDO
-                   ENDDO        
-                   DO  zi = 0, 9                                          
+                   ENDDO
+                   DO  zi = 0, 9
                       obstruction(:,zi) = obstruction_temp2( zi * 36 :( zi * 36) + 35 )
                    ENDDO
-                ELSE 
+                ELSE
                    obstruction(:,:) = 0
                 ENDIF
              ENDIF
-!              
-! !--        calculated human exposure ------------------'  
-             diffuse_exposure = SUM( radiance_array * projection_area * integration_array * obstruction )      
-         
-             obstruction_direct_beam = obstruction( nint(startpos_saa_float), nint( sza / 10.0_wp ) ) 
+!
+!--          Calculated human exposure
+             diffuse_exposure = SUM( radiance_array * projection_area * integration_array *        &
+                                     obstruction )
+
+             obstruction_direct_beam = obstruction( NINT( startpos_saa_float),                     &
+                                                    NINT( sza / 10.0_wp ) )
              IF (sza  >=  89.99_wp)  THEN
                 sza = 89.99999_wp
              ENDIF
-!             
-!--          calculate direct normal irradiance (direct beam) ------------------'
-             direct_exposure = ( irradiance(1) / cos( pi * sza / 180.0_wp ) ) * &
-             projection_area_direct_beam * obstruction_direct_beam  
-               
-             vitd3_exposure(j,i) = ( diffuse_exposure + direct_exposure ) / 1000.0_wp * 70.97_wp 
-             ! unit = international units vitamin D per second              
+!
+!--          Calculate direct normal irradiance (direct beam)
+             direct_exposure = ( irradiance(1) / COS( pi * sza / 180.0_wp ) ) *                    &
+                               projection_area_direct_beam * obstruction_direct_beam
+
+             vitd3_exposure(j,i) = ( diffuse_exposure + direct_exposure ) / 1000.0_wp * 70.97_wp
+!            unit = international units vitamin D per second
           ENDDO
        ENDDO

palm/trunk/SOURCE/time_integration_spinup.f90

@@ -1 +1 @@
 !> @file time_integration_spinup.f90
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! This file is part of the PALM model system.
 !
-! PALM is free software: you can redistribute it and/or modify it under the
-! terms of the GNU General Public License as published by the Free Software
-! Foundation, either version 3 of the License, or (at your option) any later
-! version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
+! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
+! Public License as published by the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
+! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
+! Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with PALM. If not, see
+! <http://www.gnu.org/licenses/>.
 !
 ! Copyright 1997-2020 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
+!
 !
 ! Current revisions:
-! ------------------
+! -----------------
 ! 
 ! 
@@ -25 +25 @@
 ! -----------------
 ! $Id$
-! use statement for exchange horiz added
-! 
+! File re-formatted to follow the PALM coding standard
+!
+! 4457 2020-03-11 14:20:43Z raasch
+! Use statement for exchange horiz added
+!
 ! 4444 2020-03-05 15:59:50Z raasch
-! bugfix: cpp-directives for serial mode added
-! 
+! Bugfix: cpp-directives for serial mode added
+!
 ! 4360 2020-01-07 11:25:50Z suehring
 ! Enable output of diagnostic quantities, e.g. 2-m temperature
-! 
+!
 ! 4227 2019-09-10 18:04:34Z gronemeier
-! implement new palm_date_time_mod
-! 
+! Implement new palm_date_time_mod
+!
 ! 4223 2019-09-10 09:20:47Z gronemeier
 ! Corrected "Former revisions" section
-! 
+!
 ! 4064 2019-07-01 05:33:33Z gronemeier
 ! Moved call to radiation module out of intermediate time loop
-! 
+!
 ! 4023 2019-06-12 13:20:01Z maronga
 ! Time stamps are now negative in run control output
-! 
+!
 ! 3885 2019-04-11 11:29:34Z kanani
-! Changes related to global restructuring of location messages and introduction 
-! of additional debug messages
-! 
+! Changes related to global restructuring of location messages and introduction of additional debug
+! messages
+!
 ! 3766 2019-02-26 16:23:41Z raasch
-! unused variable removed
-! 
+! Unused variable removed
+!
 ! 3719 2019-02-06 13:10:18Z kanani
-! Removed log_point(19,54,74,50,75), since they count together with same log
-! points in time_integration, impossible to separate the contributions.
-! Instead, the entire spinup gets an individual log_point in palm.f90
-! 
+! Removed log_point(19,54,74,50,75), since they count together with same log points in
+! time_integration, impossible to separate the contributions. Instead, the entire spinup gets an
+! individual log_point in palm.f90
+!
 ! 3655 2019-01-07 16:51:22Z knoop
-! Removed call to calculation of near air (10 cm) potential temperature (now in
-! surface layer fluxes)
-! 
+! Removed call to calculation of near air (10 cm) potential temperature (now in surface layer fluxes)
+!
 ! 2296 2017-06-28 07:53:56Z maronga
 ! Initial revision
@@ -67 +69 @@
 ! Description:
 ! ------------
-!> Integration in time of the non-atmospheric model components such as land
-!> surface model and urban surface model
-!------------------------------------------------------------------------------!
+!> Integration in time of the non-atmospheric model components such as land surface model and urban
+!> surface model
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE time_integration_spinup
- 
-    USE arrays_3d,                                                             &
-        ONLY:  pt, pt_p, u, u_init, v, v_init
-
-    USE control_parameters,                                                    &
-        ONLY:  averaging_interval_pr, calc_soil_moisture_during_spinup,        &
-               constant_diffusion, constant_flux_layer, coupling_start_time,   &
-               data_output_during_spinup, dopr_n, do_sum,                      &
-               dt_averaging_input_pr, dt_dopr, dt_dots, dt_do2d_xy, dt_do3d,   &
-               dt_spinup, dt_3d, humidity, intermediate_timestep_count,        &
-               intermediate_timestep_count_max, land_surface,                  &
-               simulated_time, simulated_time_chr, skip_time_dopr,             &
-               skip_time_do2d_xy, skip_time_do3d, spinup_pt_amplitude,         &
-               spinup_pt_mean, spinup_time, timestep_count, time_dopr,         &
-               time_dopr_av, time_dots, time_do2d_xy, time_do3d,               &
-               time_run_control, time_since_reference_point, urban_surface
-
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, log_point_s
-
-    USE diagnostic_output_quantities_mod,                                      &
+
+    USE arrays_3d,                                                                                 &
+        ONLY:  pt,                                                                                 &
+               pt_p,                                                                               &
+               u,                                                                                  &
+               u_init,                                                                             &
+               v,                                                                                  &
+               v_init
+
+    USE control_parameters,                                                                        &
+        ONLY:  averaging_interval_pr,                                                              &
+               calc_soil_moisture_during_spinup,                                                   &
+               constant_diffusion,                                                                 &
+               constant_flux_layer,                                                                &
+               coupling_start_time,                                                                &
+               data_output_during_spinup,                                                          &
+               dopr_n,                                                                             &
+               do_sum,                                                                             &
+               dt_averaging_input_pr,                                                              &
+               dt_dopr,                                                                            &
+               dt_dots,                                                                            &
+               dt_do2d_xy,                                                                         &
+               dt_do3d,                                                                            &
+               dt_spinup,                                                                          &
+               dt_3d,                                                                              &
+               humidity,                                                                           &
+               intermediate_timestep_count,                                                        &
+               intermediate_timestep_count_max,                                                    &
+               land_surface,                                                                       &
+               simulated_time,                                                                     &
+               simulated_time_chr,                                                                 &
+               skip_time_dopr,                                                                     &
+               skip_time_do2d_xy,                                                                  &
+               skip_time_do3d,                                                                     &
+               spinup_pt_amplitude,                                                                &
+               spinup_pt_mean,                                                                     &
+               spinup_time,                                                                        &
+               timestep_count,                                                                     &
+               time_dopr,                                                                          &
+               time_dopr_av,                                                                       &
+               time_dots,                                                                          &
+               time_do2d_xy,                                                                       &
+               time_do3d,                                                                          &
+               time_run_control,                                                                   &
+               time_since_reference_point,                                                         &
+               urban_surface
+
+    USE cpulog,                                                                                    &
+        ONLY:  cpu_log,                                                                            &
+               log_point_s
+
+    USE diagnostic_output_quantities_mod,                                                          &
         ONLY:  doq_calculate
 
-    USE exchange_horiz_mod,                                                    &
+    USE exchange_horiz_mod,                                                                        &
         ONLY:  exchange_horiz
 
-    USE indices,                                                               &
-        ONLY:  nbgp, nzb, nzt, nysg, nyng, nxlg, nxrg
-
-    USE land_surface_model_mod,                                                &
-        ONLY:  lsm_energy_balance, lsm_soil_model, lsm_swap_timelevel
+    USE indices,                                                                                   &
+        ONLY:  nbgp,                                                                               &
+               nzb,                                                                                &
+               nzt,                                                                                &
+               nysg,                                                                               &
+               nyng,                                                                               &
+               nxlg,                                                                               &
+               nxrg
+
+    USE land_surface_model_mod,                                                                    &
+        ONLY:  lsm_energy_balance,                                                                 &
+               lsm_soil_model,                                                                     &
+               lsm_swap_timelevel
 
     USE pegrid
 
 #if defined( __parallel )
-    USE pmc_interface,                                                         &
+    USE pmc_interface,                                                                             &
         ONLY:  nested_run
 #endif
@@ -112 +153 @@
     USE kinds
 
-    USE palm_date_time_mod,                                                    &
-        ONLY:  get_date_time, seconds_per_hour
-
-    USE radiation_model_mod,                                                   &
-        ONLY:  force_radiation_call, radiation, radiation_control,             &
-               radiation_interaction, radiation_interactions, time_radiation
-
-    USE statistics,                                                            &
+    USE palm_date_time_mod,                                                                        &
+        ONLY:  get_date_time,                                                                      &
+               seconds_per_hour
+
+    USE radiation_model_mod,                                                                       &
+        ONLY:  force_radiation_call,                                                               &
+               radiation,                                                                          &
+               radiation_control,                                                                  &
+               radiation_interaction,                                                              &
+               radiation_interactions,                                                             &
+               time_radiation
+
+    USE statistics,                                                                                &
         ONLY:  flow_statistics_called
 
-    USE surface_layer_fluxes_mod,                                              &
+    USE surface_layer_fluxes_mod,                                                                  &
         ONLY:  surface_layer_fluxes
 
-    USE surface_mod,                                                           &
-        ONLY :  surf_lsm_h, surf_lsm_v, surf_usm_h,    &
+    USE surface_mod,                                                                               &
+        ONLY :  surf_lsm_h,                                                                        &
+                surf_lsm_v, surf_usm_h,                                                            &
                 surf_usm_v
 
-    USE urban_surface_mod,                                                     &
-        ONLY:  usm_material_heat_model, usm_material_model,                    &
-               usm_surface_energy_balance, usm_swap_timelevel,                 &
+    USE urban_surface_mod,                                                                         &
+        ONLY:  usm_material_heat_model,                                                            &
+               usm_material_model,                                                                 &
+               usm_surface_energy_balance,                                                         &
+               usm_swap_timelevel,                                                                 &
                usm_green_heat_model
 
@@ -139 +188 @@
     IMPLICIT NONE
 
-    CHARACTER (LEN=9) ::  time_to_string                  !< 
-  
-  
-    CHARACTER (LEN=1) ::  sign_chr                        !< String containing '-' or ' ' 
-    CHARACTER (LEN=9) ::  time_since_reference_point_chr  !< time since reference point, i.e., negative during spinup
-  
-    INTEGER(iwp) ::  i !< running index
-    INTEGER(iwp) ::  j !< running index
-    INTEGER(iwp) ::  k !< running index
-    INTEGER(iwp) ::  l !< running index
-    INTEGER(iwp) ::  m !< running index
-
-    INTEGER(iwp) :: current_timestep_number_spinup = 0  !< number if timestep during spinup
-    INTEGER(iwp) :: day_of_year                         !< day of the year
-  
-    LOGICAL :: run_control_header_spinup = .FALSE.  !< flag parameter for steering whether the header information must be output
-
+    CHARACTER(LEN=1) ::  sign_chr                        !< String containing '-' or ' '
+    CHARACTER(LEN=9) ::  time_since_reference_point_chr  !< time since reference point, i.e., negative during spinup
+    CHARACTER(LEN=9) ::  time_to_string                  !<
+
+
+    INTEGER(iwp) ::  current_timestep_number_spinup = 0  !< number if timestep during spinup
+    INTEGER(iwp) ::  day_of_year                         !< day of the year
+
+    INTEGER(iwp) ::  i  !< running index
+    INTEGER(iwp) ::  j  !< running index
+    INTEGER(iwp) ::  k  !< running index
+    INTEGER(iwp) ::  l  !< running index
+    INTEGER(iwp) ::  m  !< running index
+
+
+    LOGICAL ::  run_control_header_spinup = .FALSE.  !< flag parameter for steering whether the header information must be output
+
+
+    REAL(wp) ::  dt_save        !< temporary storage for time step
     REAL(wp) ::  pt_spinup      !< temporary storage of temperature
-    REAL(wp) ::  dt_save        !< temporary storage for time step
     REAL(wp) ::  second_of_day  !< second of the day
-                  
+
     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_save  !< temporary storage of temperature
     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_save   !< temporary storage of u wind component
@@ -171 +221 @@
     ALLOCATE( v_save(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
 
-    CALL exchange_horiz( pt, nbgp )   
-    CALL exchange_horiz( u,  nbgp )  
-    CALL exchange_horiz( v,  nbgp )  
- 
+    CALL exchange_horiz( pt, nbgp )
+    CALL exchange_horiz( u,  nbgp )
+    CALL exchange_horiz( v,  nbgp )
+
     pt_save = pt
     u_save  = u
@@ -180 +230 @@
 
 !
-!-- Set the same wall-adjacent velocity to all grid points. The sign of the 
-!-- original velocity field must be preserved because the surface schemes crash 
-!-- otherwise. The precise reason is still unknown. A minimum velocity of 0.1
-!-- m/s is used to maintain turbulent transfer at the surface.
+!-- Set the same wall-adjacent velocity to all grid points. The sign of the original velocity field
+!-- must be preserved because the surface schemes crash otherwise. The precise reason is still
+!-- unknown. A minimum velocity of 0.1 m/s is used to maintain turbulent transfer at the surface.
     IF ( land_surface )  THEN
        DO  m = 1, surf_lsm_h%ns
-          i   = surf_lsm_h%i(m)            
+          i   = surf_lsm_h%i(m)
           j   = surf_lsm_h%j(m)
           k   = surf_lsm_h%k(m)
-          u(k,j,i) = SIGN(1.0_wp,u_init(k)) * MAX( ABS( u_init(k) ),0.1_wp)
-          v(k,j,i) = SIGN(1.0_wp,v_init(k)) * MAX( ABS( v_init(k) ),0.1_wp)
+          u(k,j,i) = SIGN( 1.0_wp, u_init(k) ) * MAX( ABS( u_init(k) ), 0.1_wp)
+          v(k,j,i) = SIGN( 1.0_wp, v_init(k) ) * MAX( ABS( v_init(k) ), 0.1_wp)
        ENDDO
 
        DO  l = 0, 3
           DO  m = 1, surf_lsm_v(l)%ns
-             i   = surf_lsm_v(l)%i(m)            
+             i   = surf_lsm_v(l)%i(m)
              j   = surf_lsm_v(l)%j(m)
              k   = surf_lsm_v(l)%k(m)
-             u(k,j,i) = SIGN(1.0_wp,u_init(k)) * MAX( ABS( u_init(k) ),0.1_wp)
-             v(k,j,i) = SIGN(1.0_wp,v_init(k)) * MAX( ABS( v_init(k) ),0.1_wp)
+             u(k,j,i) = SIGN( 1.0_wp, u_init(k) ) * MAX( ABS( u_init(k) ), 0.1_wp)
+             v(k,j,i) = SIGN( 1.0_wp, v_init(k) ) * MAX( ABS( v_init(k) ), 0.1_wp)
           ENDDO
        ENDDO
@@ -206 +255 @@
     IF ( urban_surface )  THEN
        DO  m = 1, surf_usm_h%ns
-          i   = surf_usm_h%i(m)            
+          i   = surf_usm_h%i(m)
           j   = surf_usm_h%j(m)
           k   = surf_usm_h%k(m)
-          u(k,j,i) = SIGN(1.0_wp,u_init(k)) * MAX( ABS( u_init(k) ),0.1_wp)
-          v(k,j,i) = SIGN(1.0_wp,v_init(k)) * MAX( ABS( v_init(k) ),0.1_wp)
+          u(k,j,i) = SIGN( 1.0_wp, u_init(k) ) * MAX( ABS( u_init(k) ), 0.1_wp)
+          v(k,j,i) = SIGN( 1.0_wp, v_init(k) ) * MAX( ABS( v_init(k) ), 0.1_wp)
        ENDDO
 
        DO  l = 0, 3
           DO  m = 1, surf_usm_v(l)%ns
-             i   = surf_usm_v(l)%i(m)            
+             i   = surf_usm_v(l)%i(m)
              j   = surf_usm_v(l)%j(m)
              k   = surf_usm_v(l)%k(m)
-             u(k,j,i) = SIGN(1.0_wp,u_init(k)) * MAX( ABS( u_init(k) ),0.1_wp)
-             v(k,j,i) = SIGN(1.0_wp,v_init(k)) * MAX( ABS( v_init(k) ),0.1_wp)
+             u(k,j,i) = SIGN( 1.0_wp, u_init(k) ) * MAX( ABS( u_init(k) ), 0.1_wp)
+             v(k,j,i) = SIGN( 1.0_wp, v_init(k) ) * MAX( ABS( v_init(k) ), 0.1_wp)
           ENDDO
        ENDDO
     ENDIF
 
-    CALL exchange_horiz( u,  nbgp )
-    CALL exchange_horiz( v,  nbgp )
+    CALL exchange_horiz( u, nbgp )
+    CALL exchange_horiz( v, nbgp )
 
     dt_save = dt_3d
@@ -236 +285 @@
 
        CALL cpu_log( log_point_s(15), 'timesteps spinup', 'start' )
-   
+
 !
 !--    Start of intermediate step loop
        intermediate_timestep_count = 0
-       DO  WHILE ( intermediate_timestep_count < &
-                   intermediate_timestep_count_max )
+       DO  WHILE ( intermediate_timestep_count < intermediate_timestep_count_max )
 
           intermediate_timestep_count = intermediate_timestep_count + 1
 
 !
-!--       Set the steering factors for the prognostic equations which depend
-!--       on the timestep scheme
+!--       Set the steering factors for the prognostic equations which depend on the timestep scheme
           CALL timestep_scheme_steering
 
 
 !
-!--       Estimate a near-surface air temperature based on the position of the 
-!--       sun and user input about mean temperature and amplitude. The time is
-!--       shifted by one hour to simulate a lag between air temperature and
-!--       incoming radiation
-          CALL get_date_time( simulated_time - spinup_time - seconds_per_hour, &
-                              day_of_year=day_of_year,                         &
-                              second_of_day=second_of_day                      )
-
-          pt_spinup = spinup_pt_mean + spinup_pt_amplitude                     &
-                                     * solar_angle(day_of_year, second_of_day)
-
-!
-!--       Map air temperature to all grid points in the vicinity of a surface
-!--       element
+!--       Estimate a near-surface air temperature based on the position of the sun and user input
+!--       about mean temperature and amplitude. The time is shifted by one hour to simulate a lag
+!--       between air temperature and incoming radiation.
+          CALL get_date_time( simulated_time - spinup_time - seconds_per_hour,                     &
+                              day_of_year = day_of_year, second_of_day = second_of_day )
+
+          pt_spinup = spinup_pt_mean + spinup_pt_amplitude *                                       &
+                      solar_angle( day_of_year, second_of_day )
+
+!
+!--       Map air temperature to all grid points in the vicinity of a surface element
           IF ( land_surface )  THEN
              DO  m = 1, surf_lsm_h%ns
-                i   = surf_lsm_h%i(m)            
+                i   = surf_lsm_h%i(m)
                 j   = surf_lsm_h%j(m)
                 k   = surf_lsm_h%k(m)
@@ -276 +320 @@
              DO  l = 0, 3
                 DO  m = 1, surf_lsm_v(l)%ns
-                   i   = surf_lsm_v(l)%i(m)            
+                   i   = surf_lsm_v(l)%i(m)
                    j   = surf_lsm_v(l)%j(m)
                    k   = surf_lsm_v(l)%k(m)
@@ -286 +330 @@
           IF ( urban_surface )  THEN
              DO  m = 1, surf_usm_h%ns
-                i   = surf_usm_h%i(m)            
+                i   = surf_usm_h%i(m)
                 j   = surf_usm_h%j(m)
                 k   = surf_usm_h%k(m)
@@ -297 +341 @@
              DO  l = 0, 3
                 DO  m = 1, surf_usm_v(l)%ns
-                   i   = surf_usm_v(l)%i(m)            
+                   i   = surf_usm_v(l)%i(m)
                    j   = surf_usm_v(l)%j(m)
                    k   = surf_usm_v(l)%k(m)
@@ -308 +352 @@
           ENDIF
 
-          CALL exchange_horiz( pt,  nbgp )    
+          CALL exchange_horiz( pt, nbgp )
 
 
@@ -314 +358 @@
 !--       Swap the time levels in preparation for the next time step.
           timestep_count = timestep_count + 1
-     
+
           IF ( land_surface )  THEN
               CALL lsm_swap_timelevel ( 0 )
@@ -324 +368 @@
 
           IF ( land_surface )  THEN
-             CALL lsm_swap_timelevel ( MOD( timestep_count, 2) )
+             CALL lsm_swap_timelevel ( MOD( timestep_count, 2 ) )
           ENDIF
 
           IF ( urban_surface )  THEN
-             CALL usm_swap_timelevel ( MOD( timestep_count, 2) )
-          ENDIF
-         
-!
-!--       If required, compute virtual potential temperature 
-          IF ( humidity )  THEN 
-             CALL compute_vpt 
-          ENDIF 
+             CALL usm_swap_timelevel ( MOD( timestep_count, 2 ) )
+          ENDIF
+
+!
+!--       If required, compute virtual potential temperature
+          IF ( humidity )  THEN
+             CALL compute_vpt
+          ENDIF
 
 !
@@ -342 +386 @@
 
 !
-!--          First the vertical (and horizontal) fluxes in the surface 
-!--          (constant flux) layer are computed
+!--          First the vertical (and horizontal) fluxes in the surface (constant flux) layer are
+!--          computed
              IF ( constant_flux_layer )  THEN
                 CALL surface_layer_fluxes
@@ -349 +393 @@
 
 !
-!--          If required, solve the energy balance for the surface and run soil 
-!--          model. Call for horizontal as well as vertical surfaces.
-!--          The prognostic equation for soil moisure is switched off
+!--          If required, solve the energy balance for the surface and run soil model. Call for
+!--          horizontal as well as vertical surfaces. The prognostic equation for soil moisure is
+!--          switched off
              IF ( land_surface )  THEN
 
@@ -378 +422 @@
 
 !
-!--          If required, solve the energy balance for urban surfaces and run 
-!--          the material heat model
+!--          If required, solve the energy balance for urban surfaces and run the material heat model
              IF (urban_surface) THEN
 
@@ -417 +460 @@
 !--    Increase simulation time and output times
        current_timestep_number_spinup = current_timestep_number_spinup + 1
-       simulated_time             = simulated_time   + dt_3d
-       simulated_time_chr         = time_to_string( simulated_time )
-       time_since_reference_point = simulated_time - coupling_start_time
-       time_since_reference_point_chr = time_to_string( ABS(time_since_reference_point) )
-       
+       simulated_time                 = simulated_time   + dt_3d
+       simulated_time_chr             = time_to_string( simulated_time )
+       time_since_reference_point     = simulated_time - coupling_start_time
+       time_since_reference_point_chr = time_to_string( ABS( time_since_reference_point ) )
+
        IF ( time_since_reference_point < 0.0_wp )  THEN
           sign_chr = '-'
@@ -427 +470 @@
           sign_chr = ' '
        ENDIF
-      
-       
+
+
        IF ( data_output_during_spinup )  THEN
           IF ( simulated_time >= skip_time_do2d_xy )  THEN
-             time_do2d_xy       = time_do2d_xy     + dt_3d
+             time_do2d_xy      = time_do2d_xy     + dt_3d
           ENDIF
           IF ( simulated_time >= skip_time_do3d    )  THEN
-             time_do3d          = time_do3d        + dt_3d
-          ENDIF
-          time_dots          = time_dots        + dt_3d
+             time_do3d         = time_do3d        + dt_3d
+          ENDIF
+          time_dots            = time_dots        + dt_3d
           IF ( simulated_time >= skip_time_dopr )  THEN
-             time_dopr       = time_dopr        + dt_3d
-          ENDIF
-          time_run_control   = time_run_control + dt_3d
+             time_dopr         = time_dopr        + dt_3d
+          ENDIF
+          time_run_control     = time_run_control + dt_3d
 
 !
 !--       Carry out statistical analysis and output at the requested output times.
-!--       The MOD function is used for calculating the output time counters (like
-!--       time_dopr) in order to regard a possible decrease of the output time
-!--       interval in case of restart runs
-
-!
-!--       Set a flag indicating that so far no statistics have been created
-!--       for this time step
+!--       The MOD function is used for calculating the output time counters (like time_dopr) in
+!--       order to regard a possible decrease of the output time interval in case of restart runs.
+
+!
+!--       Set a flag indicating that so far no statistics have been created for this time step
           flow_statistics_called = .FALSE.
 
 !
 !--       If required, call flow_statistics for averaging in time
-          IF ( averaging_interval_pr /= 0.0_wp  .AND.                          &
-             ( dt_dopr - time_dopr ) <= averaging_interval_pr  .AND.           &
-             simulated_time >= skip_time_dopr )  THEN
+          IF ( averaging_interval_pr /= 0.0_wp  .AND.                                              &
+               ( dt_dopr - time_dopr ) <= averaging_interval_pr  .AND.                             &
+               simulated_time >= skip_time_dopr )                                                  &
+          THEN
              time_dopr_av = time_dopr_av + dt_3d
              IF ( time_dopr_av >= dt_averaging_input_pr )  THEN
                 do_sum = .TRUE.
-                time_dopr_av = MOD( time_dopr_av,                              &
-                               MAX( dt_averaging_input_pr, dt_3d ) )
+                time_dopr_av = MOD( time_dopr_av, MAX( dt_averaging_input_pr, dt_3d ) )
              ENDIF
           ENDIF
@@ -472 +513 @@
              IF ( dopr_n /= 0 )  CALL data_output_profiles
              time_dopr = MOD( time_dopr, MAX( dt_dopr, dt_3d ) )
-             time_dopr_av = 0.0_wp    ! due to averaging (see above)
+             time_dopr_av = 0.0_wp    ! Due to averaging (see above)
           ENDIF
 
@@ -502 +543 @@
 
 !
-!--    Computation and output of run control parameters.
-!--    This is also done whenever perturbations have been imposed
-!        IF ( time_run_control >= dt_run_control  .OR.                           &
-!             timestep_scheme(1:5) /= 'runge'  .OR.  disturbance_created )       &
-!        THEN
+!--    Computation and output of run control parameters. This is also done whenever perturbations
+!--    have been imposed
+!        IF ( time_run_control >= dt_run_control  .OR.                                              &
+!             timestep_scheme(1:5) /= 'runge'  .OR.  disturbance_created )  THEN
 !           CALL run_control
 !           IF ( time_run_control >= dt_run_control )  THEN
-!              time_run_control = MOD( time_run_control,                         &
-!                                      MAX( dt_run_control, dt_3d ) )
+!              time_run_control = MOD( time_run_control, MAX( dt_run_control, dt_3d ) )
 !           ENDIF
 !        ENDIF
@@ -529 +568 @@
 !
 !--       Write some general information about the spinup in run control file
-          WRITE ( 15, 101 )  current_timestep_number_spinup, sign_chr, time_since_reference_point_chr, dt_3d, pt_spinup
+          WRITE ( 15, 101 )  current_timestep_number_spinup, sign_chr,                             &
+                             time_since_reference_point_chr, dt_3d, pt_spinup
 !
 !--       Write buffer contents to disc immediately
@@ -537 +577 @@
 
 
-    ENDDO   ! time loop
+    ENDDO   ! Time loop
 
 !
@@ -563 +603 @@
 !
 !-- Formats
-100 FORMAT (///'Spinup control output:'/  &
-            '---------------------------------'// &
-            'ITER.   HH:MM:SS    DT   PT(z_MO)'/   &
-            '---------------------------------')
+100 FORMAT (///'Spinup control output:---------------------------------'//                         &
+            'ITER.   HH:MM:SS    DT   PT(z_MO)---------------------------------')
 101 FORMAT (I5,2X,A1,A9,1X,F6.2,3X,F6.2,2X,F6.2)
 
@@ -572 +610 @@
 
 !
-!-- Returns the cosine of the solar zenith angle at a given time. This routine
-!-- is similar to that for calculation zenith (see radiation_model_mod.f90)
-    !> @todo Load function calc_zenith of radiation model instead of
-    !>       rewrite the function here.
-    FUNCTION solar_angle( day_of_year, second_of_day ) 
-
-       USE basic_constants_and_equations_mod,                                  &
+!-- Returns the cosine of the solar zenith angle at a given time. This routine is similar to that
+!-- for calculation zenith (see radiation_model_mod.f90)
+    !> @todo Load function calc_zenith of radiation model instead of rewrite the function here.
+    FUNCTION solar_angle( day_of_year, second_of_day )
+
+       USE basic_constants_and_equations_mod,                                                      &
            ONLY:  pi
-      
+
        USE kinds
 
-       USE radiation_model_mod,                                                &
-           ONLY:  decl_1, decl_2, decl_3, lat, lon
-
-       IMPLICIT NONE 
+       USE radiation_model_mod,                                                                    &
+           ONLY:  decl_1,                                                                          &
+                  decl_2,                                                                          &
+                  decl_3,                                                                          &
+                  lat,                                                                             &
+                  lon
+
+       IMPLICIT NONE
 
 
        INTEGER(iwp), INTENT(IN) ::  day_of_year  !< day of the year
 
-       REAL(wp)             ::  declination      !< solar declination angle
-       REAL(wp)             ::  hour_angle       !< solar hour angle
-       REAL(wp), INTENT(IN) ::  second_of_day    !< current time of the day in UTC
-       REAL(wp)             ::  solar_angle      !< cosine of the solar zenith angle
-!
-!--    Calculate solar declination and hour angle   
-       declination = ASIN( decl_1 * SIN(decl_2 * REAL(day_of_year, KIND=wp) - decl_3) )
-       hour_angle  = 2.0_wp * pi * (second_of_day / 86400.0_wp) + lon - pi
+       REAL(wp)             ::  declination    !< solar declination angle
+       REAL(wp)             ::  hour_angle     !< solar hour angle
+       REAL(wp), INTENT(IN) ::  second_of_day  !< current time of the day in UTC
+       REAL(wp)             ::  solar_angle    !< cosine of the solar zenith angle
+!
+!--    Calculate solar declination and hour angle
+       declination = ASIN( decl_1 * SIN( decl_2 * REAL( day_of_year, KIND = wp) - decl_3 ) )
+       hour_angle  = 2.0_wp * pi * ( second_of_day / 86400.0_wp ) + lon - pi
 
 !
 !--    Calculate cosine of solar zenith angle
-       solar_angle = SIN(lat) * SIN(declination) + COS(lat) * COS(declination) &
-                     * COS(hour_angle)
+       solar_angle = SIN( lat ) * SIN( declination ) + COS( lat ) * COS( declination ) *           &
+                     COS( hour_angle )
 
     END FUNCTION solar_angle

palm/trunk/SOURCE/time_to_string.f90

@@ -1 +1 @@
 !> @file time_to_string.f90
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! This file is part of the PALM model system.
 !
-! PALM is free software: you can redistribute it and/or modify it under the
-! terms of the GNU General Public License as published by the Free Software
-! Foundation, either version 3 of the License, or (at your option) any later
-! version.
+! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
+! Public License as published by the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
 !
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
+! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
+! Public License for more details.
 !
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
+! You should have received a copy of the GNU General Public License along with PALM. If not, see
+! <http://www.gnu.org/licenses/>.
 !
 ! Copyright 1997-2020 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
+!
 !
 ! Current revisions:
@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! File re-formatted to follow the PALM coding standard
+!
+!
+! 4360 2020-01-07 11:25:50Z suehring
 ! Corrected "Former revisions" section
-! 
+!
 ! 3655 2019-01-07 16:51:22Z knoop
 ! Corrected "Former revisions" section
@@ -37 +41 @@
 ! ------------
 !> Transforming the time from real to character-string hh:mm:ss
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  FUNCTION time_to_string( time )
- 
+
 
     USE kinds
@@ -45 +49 @@
     IMPLICIT NONE
 
-    CHARACTER (LEN=9) ::  time_to_string !< 
+    CHARACTER(LEN=9) ::  time_to_string  !<
 
-    INTEGER(iwp)      ::  hours   !< 
-    INTEGER(iwp)      ::  minutes !< 
-    INTEGER(iwp)      ::  seconds !< 
+    INTEGER(iwp)     ::  hours    !<
+    INTEGER(iwp)     ::  minutes  !<
+    INTEGER(iwp)     ::  seconds  !<
 
-    REAL(wp)          ::  rest_time !< 
-    REAL(wp)          ::  time      !< 
+    REAL(wp)         ::  rest_time  !<
+    REAL(wp)         ::  time       !<
 
 !
@@ -64 +68 @@
 !-- Build the string
     IF ( hours < 100 )  THEN
-       WRITE (time_to_string,'(I2.2,'':'',I2.2,'':'',I2.2)')  hours, minutes, &
-                                                              seconds
+       WRITE (time_to_string,'(I2.2,'':'',I2.2,'':'',I2.2)')  hours, minutes, seconds
     ELSE
-       WRITE (time_to_string,'(I3.3,'':'',I2.2,'':'',I2.2)')  hours, minutes, &
-                                                              seconds
+       WRITE (time_to_string,'(I3.3,'':'',I2.2,'':'',I2.2)')  hours, minutes, seconds
     ENDIF
 

palm/trunk/SOURCE/timestep.f90

@@ -1 +1 @@
 !> @file timestep.f90
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! This file is part of the PALM model system.
 !
-! PALM is free software: you can redistribute it and/or modify it under the
-! terms of the GNU General Public License as published by the Free Software
-! Foundation, either version 3 of the License, or (at your option) any later
-! version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
+! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
+! Public License as published by the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
+! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
+! Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with PALM. If not, see
+! <http://www.gnu.org/licenses/>.
 !
 ! Copyright 1997-2020 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
+!
 !
 ! Current revisions:
-! ------------------
+! -----------------
 ! 
 ! 
@@ -25 +25 @@
 ! -----------------
 ! $Id$
-! bugfix: cpp-directives for serial mode added
-! 
+! File re-formatted to follow the PALM coding standard
+!
+!
+! 4444 2020-03-05 15:59:50Z raasch
+! Bugfix: cpp-directives for serial mode added
+!
 ! 4360 2020-01-07 11:25:50Z suehring
 ! Added missing OpenMP directives
-! 
+!
 ! 4233 2019-09-20 09:55:54Z knoop
 ! OpenACC data update host removed
-! 
+!
 ! 4182 2019-08-22 15:20:23Z scharf
 ! Corrected "Former revisions" section
-! 
+!
 ! 4101 2019-07-17 15:14:26Z gronemeier
-! - consider 2*Km within diffusion criterion as Km is considered twice within
-!   the diffusion of e,
-! - in RANS mode, instead of considering each wind component individually use
-!   the wind speed of 3d wind vector in CFL criterion
-! - do not limit the increase of dt based on its previous value in RANS mode
+! - Consider 2*Km within diffusion criterion as Km is considered twice within the diffusion of e,
+! - in RANS mode, instead of considering each wind component individually use the wind speed of 3d
+!   wind vector in CFL criterion
+! - Do not limit the increase of dt based on its previous value in RANS mode
 !
 ! 3658 2019-01-07 20:28:54Z knoop
@@ -53 +56 @@
 ! ------------
 !> Compute the time step under consideration of the FCL and diffusion criterion.
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE timestep
- 
-
-    USE arrays_3d,                                                             &
-        ONLY:  dzu, dzw, kh, km, u, u_stokes_zu, v, v_stokes_zu, w
-
-    USE control_parameters,                                                    &
-        ONLY:  cfl_factor, dt_3d, dt_fixed, dt_max, galilei_transformation,    &
-               message_string, rans_mode, stop_dt, timestep_reason, u_gtrans,  &
-               use_ug_for_galilei_tr, v_gtrans
-
-#if defined( __parallel )
-    USE control_parameters,                                                    &
-        ONLY:  coupling_mode, terminate_coupled, terminate_coupled_remote
-#endif
-
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, log_point
-
-    USE grid_variables,                                                        &
-        ONLY:  dx, dx2, dy, dy2
-
-    USE indices,                                                               &
-        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
+
+
+    USE arrays_3d,                                                                                 &
+        ONLY:  dzu,                                                                                &
+               dzw,                                                                                &
+               kh,                                                                                 &
+               km,                                                                                 &
+               u,                                                                                  &
+               u_stokes_zu,                                                                        &
+               v,                                                                                  &
+               v_stokes_zu,                                                                        &
+               w
+
+    USE control_parameters,                                                                        &
+        ONLY:  cfl_factor,                                                                         &
+               dt_3d,                                                                              &
+               dt_fixed,                                                                           &
+               dt_max,                                                                             &
+               galilei_transformation,                                                             &
+               message_string,                                                                     &
+               rans_mode,                                                                          &
+               stop_dt,                                                                            &
+               timestep_reason,                                                                    &
+               u_gtrans,                                                                           &
+               use_ug_for_galilei_tr,                                                              &
+               v_gtrans
+
+#if defined( __parallel )
+    USE control_parameters,                                                                        &
+        ONLY:  coupling_mode,                                                                      &
+               terminate_coupled,                                                                  &
+               terminate_coupled_remote
+#endif
+
+    USE cpulog,                                                                                    &
+        ONLY:  cpu_log,                                                                            &
+               log_point
+
+    USE grid_variables,                                                                            &
+        ONLY:  dx,                                                                                 &
+               dx2,                                                                                &
+               dy,                                                                                 &
+               dy2
+
+    USE indices,                                                                                   &
+        ONLY:  nxl,                                                                                &
+               nxlg,                                                                               &
+               nxr,                                                                                &
+               nxrg,                                                                               &
+               nyn,                                                                                &
+               nyng,                                                                               &
+               nys,                                                                                &
+               nysg,                                                                               &
+               nzb,                                                                                &
+               nzt
 
     USE interfaces
@@ -83 +118 @@
     USE kinds
 
-    USE bulk_cloud_model_mod,                                                  &
+    USE bulk_cloud_model_mod,                                                                      &
         ONLY:  dt_precipitation
 
     USE pegrid
 
-    USE pmc_interface,                                                         &
+    USE pmc_interface,                                                                             &
         ONLY:  nested_run
 
-    USE statistics,                                                            &
-        ONLY:  flow_statistics_called, hom, u_max, u_max_ijk, v_max, v_max_ijk,&
-               w_max, w_max_ijk
-
-#if defined( __parallel )
-    USE vertical_nesting_mod,                                                  &
-        ONLY:  vnested, vnest_timestep_sync
+    USE statistics,                                                                                &
+        ONLY:  flow_statistics_called,                                                             &
+               hom,                                                                                &
+               u_max,                                                                              &
+               u_max_ijk,                                                                          &
+               v_max,                                                                              &
+               v_max_ijk,                                                                          &
+               w_max,                                                                              &
+               w_max_ijk
+
+#if defined( __parallel )
+    USE vertical_nesting_mod,                                                                      &
+        ONLY:  vnested,                                                                            &
+               vnest_timestep_sync
 #endif
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i !< 
-    INTEGER(iwp) ::  j !< 
-    INTEGER(iwp) ::  k !< 
+    INTEGER(iwp) ::  i  !<
+    INTEGER(iwp) ::  j  !<
+    INTEGER(iwp) ::  k  !<
     INTEGER(iwp) ::  km_max_ijk(3) = -1  !< index values (i,j,k) of location where km_max occurs
     INTEGER(iwp) ::  kh_max_ijk(3) = -1  !< index values (i,j,k) of location where kh_max occurs
 
-    LOGICAL ::  stop_dt_local !< local switch for controlling the time stepping
-
-    REAL(wp) ::  div               !< 
-    REAL(wp) ::  dt_diff           !< 
-    REAL(wp) ::  dt_diff_l         !< 
-    REAL(wp) ::  dt_u              !< 
-    REAL(wp) ::  dt_u_l            !< 
-    REAL(wp) ::  dt_v              !< 
-    REAL(wp) ::  dt_v_l            !< 
-    REAL(wp) ::  dt_w              !< 
-    REAL(wp) ::  dt_w_l            !< 
-    REAL(wp) ::  km_max            !< maximum of Km in entire domain
-    REAL(wp) ::  kh_max            !< maximum of Kh in entire domain
-    REAL(wp) ::  u_gtrans_l        !< 
-    REAL(wp) ::  v_gtrans_l        !< 
- 
-    REAL(wp), DIMENSION(2)         ::  uv_gtrans_l !<
-#if defined( __parallel )
-    REAL(wp), DIMENSION(2)         ::  uv_gtrans   !< 
-    REAL(wp), DIMENSION(3)         ::  reduce      !< 
-    REAL(wp), DIMENSION(3)         ::  reduce_l    !<
-#endif
-    REAL(wp), DIMENSION(nzb+1:nzt) ::  dxyz2_min   !<  
+    LOGICAL ::  stop_dt_local  !< local switch for controlling the time stepping
+
+    REAL(wp) ::  div         !<
+    REAL(wp) ::  dt_diff     !<
+    REAL(wp) ::  dt_diff_l   !<
+    REAL(wp) ::  dt_u        !<
+    REAL(wp) ::  dt_u_l      !<
+    REAL(wp) ::  dt_v        !<
+    REAL(wp) ::  dt_v_l      !<
+    REAL(wp) ::  dt_w        !<
+    REAL(wp) ::  dt_w_l      !<
+    REAL(wp) ::  km_max      !< maximum of Km in entire domain
+    REAL(wp) ::  kh_max      !< maximum of Kh in entire domain
+    REAL(wp) ::  u_gtrans_l  !<
+    REAL(wp) ::  v_gtrans_l  !<
+
+    REAL(wp), DIMENSION(2)         ::  uv_gtrans_l  !<
+#if defined( __parallel )
+    REAL(wp), DIMENSION(2)         ::  uv_gtrans    !<
+    REAL(wp), DIMENSION(3)         ::  reduce       !<
+    REAL(wp), DIMENSION(3)         ::  reduce_l     !<
+#endif
+    REAL(wp), DIMENSION(nzb+1:nzt) ::  dxyz2_min    !<
     !$ACC DECLARE CREATE(dxyz2_min)
 
@@ -137 +179 @@
 
 !
-!-- In case of Galilei-transform not using the geostrophic wind as translation
-!-- velocity, compute the volume-averaged horizontal velocity components, which
-!-- will then be subtracted from the horizontal wind for the time step and
-!-- horizontal advection routines.
+!-- In case of Galilei-transform not using the geostrophic wind as translation velocity, compute the
+!-- volume-averaged horizontal velocity components, which will then be subtracted from the
+!-- horizontal wind for the time step and horizontal advection routines.
     IF ( galilei_transformation  .AND. .NOT.  use_ug_for_galilei_tr )  THEN
        IF ( flow_statistics_called )  THEN
 !
-!--       Horizontal averages already existent, just need to average them 
-!--       vertically.
+!--       Horizontal averages already existent, just need to average them vertically.
           u_gtrans = 0.0_wp
           v_gtrans = 0.0_wp
@@ -152 +192 @@
              v_gtrans = v_gtrans + hom(k,1,2,0)
           ENDDO
-          u_gtrans = u_gtrans / REAL( nzt - nzb, KIND=wp )
-          v_gtrans = v_gtrans / REAL( nzt - nzb, KIND=wp )
+          u_gtrans = u_gtrans / REAL( nzt - nzb, KIND = wp )
+          v_gtrans = v_gtrans / REAL( nzt - nzb, KIND = wp )
        ELSE
 !
@@ -167 +207 @@
              ENDDO
           ENDDO
-          uv_gtrans_l(1) = u_gtrans_l /                                        &
-                           REAL( (nxr-nxl+1)*(nyn-nys+1)*(nzt-nzb), KIND=wp )
-          uv_gtrans_l(2) = v_gtrans_l /                                        &
-                           REAL( (nxr-nxl+1)*(nyn-nys+1)*(nzt-nzb), KIND=wp )
+          uv_gtrans_l(1) = u_gtrans_l / REAL( (nxr-nxl+1) * (nyn-nys+1) * (nzt-nzb), KIND = wp )
+          uv_gtrans_l(2) = v_gtrans_l / REAL( (nxr-nxl+1) * (nyn-nys+1) * (nzt-nzb), KIND = wp )
 #if defined( __parallel )
           IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_ALLREDUCE( uv_gtrans_l, uv_gtrans, 2, MPI_REAL, MPI_SUM,    &
-                              comm2d, ierr )
-          u_gtrans = uv_gtrans(1) / REAL( numprocs, KIND=wp )
-          v_gtrans = uv_gtrans(2) / REAL( numprocs, KIND=wp )
+          CALL MPI_ALLREDUCE( uv_gtrans_l, uv_gtrans, 2, MPI_REAL, MPI_SUM, comm2d, ierr )
+          u_gtrans = uv_gtrans(1) / REAL( numprocs, KIND = wp )
+          v_gtrans = uv_gtrans(2) / REAL( numprocs, KIND = wp )
 #else
           u_gtrans = uv_gtrans_l(1)
@@ -185 +222 @@
 
 !
-!-- Determine the maxima of the velocity components, including their
-!-- grid index positions.
-    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, u, 'abs', 0.0_wp, &
-                         u_max, u_max_ijk )
-    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, v, 'abs', 0.0_wp, &
-                         v_max, v_max_ijk )
-    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, w, 'abs', 0.0_wp, &
-                         w_max, w_max_ijk )
+!-- Determine the maxima of the velocity components, including their grid index positions.
+    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, u, 'abs', 0.0_wp, u_max, u_max_ijk )
+    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, v, 'abs', 0.0_wp, v_max, v_max_ijk )
+    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, w, 'abs', 0.0_wp, w_max, w_max_ijk )
 
     IF ( .NOT. dt_fixed )  THEN
@@ -215 +248 @@
              DO  j = nys, nyn
                 DO  k = nzb+1, nzt
-                   dt_u_l = MIN( dt_u_l, ( dx     /                               &
-                                    ( ABS( u(k,j,i) - u_gtrans + u_stokes_zu(k) ) &
-                                      + 1.0E-10_wp ) ) )
-                   dt_v_l = MIN( dt_v_l, ( dy     /                               &
-                                    ( ABS( v(k,j,i) - v_gtrans + v_stokes_zu(k) ) &
-                                      + 1.0E-10_wp ) ) )
-                   dt_w_l = MIN( dt_w_l, ( dzu(k) /                               &
-                                    ( ABS( w(k,j,i) )            + 1.0E-10_wp ) ) )
+                   dt_u_l = MIN( dt_u_l, ( dx / ( ABS( u(k,j,i) - u_gtrans + u_stokes_zu(k) )      &
+                                                  + 1.0E-10_wp ) ) )
+                   dt_v_l = MIN( dt_v_l, ( dy / ( ABS( v(k,j,i) - v_gtrans + v_stokes_zu(k) )      &
+                                                  + 1.0E-10_wp ) ) )
+                   dt_w_l = MIN( dt_w_l, ( dzu(k) / ( ABS( w(k,j,i) ) + 1.0E-10_wp ) ) )
                 ENDDO
              ENDDO
@@ -230 +260 @@
 !
 !--       Consider the wind speed at the scalar-grid point
-!--       !> @note considering the wind speed instead of each individual wind
-!--       !>       component is only a workaround so far. This might has to be
-!--       !>       changed in the future.
+!--       !> @note Considering the wind speed instead of each individual wind component is only a
+!--       !>       workaround so far. This has to be changed in the future.
 
           !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
@@ -243 +272 @@
              DO  j = nys, nyn
                 DO  k = nzb+1, nzt
-                   dt_u_l = MIN( dt_u_l, ( MIN( dx, dy, dzu(k) ) / ( &
-                      SQRT(  ( 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans + u_stokes_zu(k) )**2   &
-                           + ( 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans + v_stokes_zu(k) )**2   &
-                           + ( 0.5 * ( w(k,j,i) + w(k-1,j,i) )                             )**2 ) &
-                      + 1.0E-10_wp ) ) )
+                   dt_u_l = MIN( dt_u_l, ( MIN( dx, dy, dzu(k) ) / ( SQRT(                         &
+                            ( 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans + u_stokes_zu(k) )**2     &
+                          + ( 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans + v_stokes_zu(k) )**2     &
+                          + ( 0.5 * ( w(k,j,i) + w(k-1,j,i) ) )**2 ) + 1.0E-10_wp ) ) )
                 ENDDO
              ENDDO
           ENDDO
-          
+
           dt_v_l = dt_u_l
           dt_w_l = dt_u_l
@@ -274 +302 @@
 !
 !--    Compute time step according to the diffusion criterion.
-!--    First calculate minimum grid spacing which only depends on index k.
-!--    When using the dynamic subgrid model, negative km are possible.
+!--    First calculate minimum grid spacing which only depends on index k. When using the dynamic
+!--    subgrid model, negative km are possible.
        dt_diff_l = 999999.0_wp
 
        !$ACC PARALLEL LOOP PRESENT(dxyz2_min, dzw)
        DO  k = nzb+1, nzt
-           dxyz2_min(k) = MIN( dx2, dy2, dzw(k)*dzw(k) ) * 0.125_wp
+           dxyz2_min(k) = MIN( dx2, dy2, dzw(k) * dzw(k) ) * 0.125_wp
        ENDDO
 
@@ -291 +319 @@
           DO  j = nys, nyn
              DO  k = nzb+1, nzt
-                dt_diff_l = MIN( dt_diff_l,                                       &
-                                 dxyz2_min(k) /                                   &
-                                    ( MAX( kh(k,j,i), 2.0_wp * ABS( km(k,j,i) ) ) &
-                                      + 1E-20_wp ) )
+                dt_diff_l = MIN( dt_diff_l, dxyz2_min(k) / ( MAX( kh(k,j,i), 2.0_wp *              &
+                            ABS( km(k,j,i) ) ) + 1E-20_wp ) )
              ENDDO
           ENDDO
@@ -301 +327 @@
 #if defined( __parallel )
        IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLREDUCE( dt_diff_l, dt_diff, 1, MPI_REAL, MPI_MIN, comm2d,   &
-                           ierr )
+       CALL MPI_ALLREDUCE( dt_diff_l, dt_diff, 1, MPI_REAL, MPI_MIN, comm2d, ierr )
 #else
        dt_diff = dt_diff_l
@@ -308 +333 @@
 
 !
-!--    The time step is the minimum of the 3-4 components and the diffusion time
-!--    step minus a reduction (cfl_factor) to be on the safe side.
+!--    The time step is the minimum of the 3-4 components and the diffusion time step minus a
+!--    reduction (cfl_factor) to be on the safe side.
 !--    The time step must not exceed the maximum allowed value.
        dt_3d = cfl_factor * MIN( dt_diff, dt_u, dt_v, dt_w, dt_precipitation )
@@ -328 +353 @@
 
 !
-!--       Determine the maxima of the diffusion coefficients, including their
-!--       grid index positions.
-          CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, km, 'abs',  &
-                               0.0_wp, km_max, km_max_ijk )
-          CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, kh, 'abs',  &
-                               0.0_wp, kh_max, kh_max_ijk )
-
-          WRITE( message_string, * ) 'Time step has reached minimum limit.',   &
-               '&dt              = ', dt_3d, ' s  Simulation is terminated.',  &
-               '&dt_u            = ', dt_u, ' s',                              &
-               '&dt_v            = ', dt_v, ' s',                              &
-               '&dt_w            = ', dt_w, ' s',                              &
-               '&dt_diff         = ', dt_diff, ' s',                           &
-               '&u_max           = ', u_max, ' m/s    k=', u_max_ijk(1),       &
-               '  j=', u_max_ijk(2), '  i=', u_max_ijk(3),                     &
-               '&v_max           = ', v_max, ' m/s    k=', v_max_ijk(1),       &
-               '  j=', v_max_ijk(2), '  i=', v_max_ijk(3),                     &
-               '&w_max           = ', w_max, ' m/s    k=', w_max_ijk(1),       &
-               '  j=', w_max_ijk(2), '  i=', w_max_ijk(3),                     &
-               '&km_max          = ', km_max, ' m2/s2  k=', km_max_ijk(1),     &
-               '  j=', km_max_ijk(2), '  i=', km_max_ijk(3),                   &
-               '&kh_max          = ', kh_max, ' m2/s2  k=', kh_max_ijk(1),     &
+!--       Determine the maxima of the diffusion coefficients, including their grid index positions.
+          CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, km, 'abs', 0.0_wp, km_max,      &
+                               km_max_ijk )
+          CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, kh, 'abs', 0.0_wp, kh_max,      &
+                               kh_max_ijk )
+
+          WRITE( message_string, * ) 'Time step has reached minimum limit.',                       &
+               '&dt              = ', dt_3d, ' s  Simulation is terminated.',                      &
+               '&dt_u            = ', dt_u, ' s',                                                  &
+               '&dt_v            = ', dt_v, ' s',                                                  &
+               '&dt_w            = ', dt_w, ' s',                                                  &
+               '&dt_diff         = ', dt_diff, ' s',                                               &
+               '&u_max           = ', u_max, ' m/s    k=', u_max_ijk(1),                           &
+               '  j=', u_max_ijk(2), '  i=', u_max_ijk(3),                                         &
+               '&v_max           = ', v_max, ' m/s    k=', v_max_ijk(1),                           &
+               '  j=', v_max_ijk(2), '  i=', v_max_ijk(3),                                         &
+               '&w_max           = ', w_max, ' m/s    k=', w_max_ijk(1),                           &
+               '  j=', w_max_ijk(2), '  i=', w_max_ijk(3),                                         &
+               '&km_max          = ', km_max, ' m2/s2  k=', km_max_ijk(1),                         &
+               '  j=', km_max_ijk(2), '  i=', km_max_ijk(3),                                       &
+               '&kh_max          = ', kh_max, ' m2/s2  k=', kh_max_ijk(1),                         &
                 '  j=', kh_max_ijk(2), '  i=', kh_max_ijk(3)
           CALL message( 'timestep', 'PA0312', 0, 1, 0, 6, 0 )
 !
-!--       In case of coupled runs inform the remote model of the termination 
-!--       and its reason, provided the remote model has not already been 
-!--       informed of another termination reason (terminate_coupled > 0) before.
+!--       In case of coupled runs inform the remote model of the termination and its reason,
+!--       provided the remote model has not already been informed of another termination reason
+!--       (terminate_coupled > 0).
 #if defined( __parallel )
           IF ( coupling_mode /= 'uncoupled' .AND. terminate_coupled == 0 )  THEN
              terminate_coupled = 2
              IF ( myid == 0 )  THEN
-                CALL MPI_SENDRECV( &
-                     terminate_coupled,        1, MPI_INTEGER, target_id,  0,  &
-                     terminate_coupled_remote, 1, MPI_INTEGER, target_id,  0,  &
-                     comm_inter, status, ierr )
+                CALL MPI_SENDRECV( terminate_coupled, 1, MPI_INTEGER, target_id, 0,                &
+                                   terminate_coupled_remote, 1, MPI_INTEGER, target_id,  0,        &
+                                   comm_inter, status, ierr )
              ENDIF
-             CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0,      &
-                             comm2d, ierr)
+             CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, comm2d, ierr)
           ENDIF
 #endif
@@ -372 +394 @@
 
 !
-!--    In case of nested runs all parent/child processes have to terminate if
-!--    one process has set the stop flag, i.e. they need to set the stop flag
-!--    too.
+!--    In case of nested runs all parent/child processes have to terminate if one process has set
+!--    the stop flag, i.e. they need to set the stop flag too.
        IF ( nested_run )  THEN
           stop_dt_local = stop_dt
 #if defined( __parallel )
-          CALL MPI_ALLREDUCE( stop_dt_local, stop_dt, 1, MPI_LOGICAL, MPI_LOR, &
-                              MPI_COMM_WORLD, ierr )
+          CALL MPI_ALLREDUCE( stop_dt_local, stop_dt, 1, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierr )
 #endif
        ENDIF
@@ -395 +415 @@
 #if defined( __parallel )
 !
-!-- Vertical nesting: coarse and fine grid timestep has to be identical    
+!-- Vertical nesting: coarse and fine grid timestep has to be identical
     IF ( vnested )  CALL vnest_timestep_sync
 #endif

palm/trunk/SOURCE/timestep_scheme_steering.f90

@@ -1 +1 @@
 !> @file timestep_scheme_steering.f90
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! This file is part of the PALM model system.
 !
-! PALM is free software: you can redistribute it and/or modify it under the
-! terms of the GNU General Public License as published by the Free Software
-! Foundation, either version 3 of the License, or (at your option) any later
-! version.
+! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
+! Public License as published by the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
 !
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
+! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
+! Public License for more details.
 !
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
+! You should have received a copy of the GNU General Public License along with PALM. If not, see
+! <http://www.gnu.org/licenses/>.
 !
 ! Copyright 1997-2020 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
+!
 !
 ! Current revisions:
-! ------------------
+! -----------------
 ! 
 ! 
@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! File re-formatted to follow the PALM coding standard
+!
+!
+! 4360 2020-01-07 11:25:50Z suehring
 ! Corrected "Former revisions" section
-! 
+!
 ! 3655 2019-01-07 16:51:22Z knoop
 ! OpenACC port for SPEC
@@ -36 +40 @@
 ! Description:
 ! ------------
-!> Depending on the timestep scheme set the steering factors for the prognostic
-!> equations.
-!------------------------------------------------------------------------------!
+!> Depending on the timestep scheme set the steering factors for the prognostic equations.
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE timestep_scheme_steering
- 
 
-    USE control_parameters,                                                    &
-        ONLY:  intermediate_timestep_count, timestep_scheme, tsc
+
+    USE control_parameters,                                                                        &
+        ONLY:  intermediate_timestep_count,                                                        &
+               timestep_scheme,                                                                    &
+               tsc
 
     USE kinds
@@ -52 +57 @@
     IF ( timestep_scheme(1:5) == 'runge' )  THEN
 !
-!--    Runge-Kutta schemes (here the factors depend on the respective
-!--    intermediate step)
+!--    Runge-Kutta schemes (here the factors depend on the respective intermediate step)
        IF ( timestep_scheme == 'runge-kutta-2' )  THEN
           IF ( intermediate_timestep_count == 1 )  THEN
@@ -62 +66 @@
        ELSE
           IF ( intermediate_timestep_count == 1 )  THEN
-             tsc(1:5) = (/ 1.0_wp,  1.0_wp /  3.0_wp,           0.0_wp, 0.0_wp, 0.0_wp /)
+             tsc(1:5) = (/ 1.0_wp,  1.0_wp /  3.0_wp,          0.0_wp, 0.0_wp, 0.0_wp /)
           ELSEIF ( intermediate_timestep_count == 2 )  THEN
              tsc(1:5) = (/ 1.0_wp, 15.0_wp / 16.0_wp, -25.0_wp/48.0_wp, 0.0_wp, 0.0_wp /)
           ELSE
              tsc(1:5) = (/ 1.0_wp,  8.0_wp / 15.0_wp,   1.0_wp/15.0_wp, 0.0_wp, 1.0_wp /)
-          ENDIF          
+          ENDIF
        ENDIF
 

palm/trunk/SOURCE/transpose.f90

@@ -1 +1 @@
 !> @file transpose.f90
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! This file is part of the PALM model system.
 !
-! PALM is free software: you can redistribute it and/or modify it under the
-! terms of the GNU General Public License as published by the Free Software
-! Foundation, either version 3 of the License, or (at your option) any later
-! version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
+! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
+! Public License as published by the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
+! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
+! Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with PALM. If not, see
+! <http://www.gnu.org/licenses/>.
 !
 ! Copyright 1997-2020 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
+!
 !
 ! Current revisions:
@@ -25 +25 @@
 ! -----------------
 ! $Id$
-! bugfix: cpp-directives added for serial mode
-! 
+! File re-formatted to follow the PALM coding standard
+!
+!
+! 4429 2020-02-27 15:24:30Z raasch
+! Bugfix: cpp-directives added for serial mode
+!
 ! 4415 2020-02-20 10:30:33Z raasch
-! bugfix for misplaced preprocessor directive
-! 
+! Bugfix for misplaced preprocessor directive
+!
 ! 4370 2020-01-10 14:00:44Z raasch
-! vector array renamed
-! 
+! Vector array renamed
+!
 ! 4366 2020-01-09 08:12:43Z raasch
-! modifications for NEC vectorization
-! 
+! Modifications for NEC vectorization
+!
 ! 4360 2020-01-07 11:25:50Z suehring
 ! Added missing OpenMP directives
-! 
+!
 ! 4182 2019-08-22 15:20:23Z scharf
 ! Corrected "Former revisions" section
-! 
+!
 ! 4171 2019-08-19 17:44:09Z gronemeier
-! loop reordering for performance optimization
+! Loop reordering for performance optimization
 !
 ! 3832 2019-03-28 13:16:58Z raasch
-! loop reordering for performance optimization
+! Loop reordering for performance optimization
 !
 ! 3694 2019-01-23 17:01:49Z knoop
@@ -57 +61 @@
 ! Description:
 ! ------------
-!> Resorting data for the transposition from x to y. The transposition itself
-!> is carried out in transpose_xy
-!------------------------------------------------------------------------------!
+!> Resorting data for the transposition from x to y. The transposition itself is carried out in
+!> transpose_xy.
+!--------------------------------------------------------------------------------------------------!
 
 #define __acc_fft_device ( defined( _OPENACC ) && ( defined ( __cuda_fft ) ) )
@@ -66 +70 @@
 
 
-     USE indices,                                                              &
-         ONLY:  nx
-
-     USE kinds
-
-     USE transpose_indices,                                                    &
-         ONLY:  nyn_x, nys_x, nzb_x, nzt_x
-
-     IMPLICIT NONE
-
-     REAL(wp) ::  f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x)  !<
-     REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) !<
-
-
-     INTEGER(iwp) ::  i !<
-     INTEGER(iwp) ::  j !<
-     INTEGER(iwp) ::  k !<
-!
-!-- Rearrange indices of input array in order to make data to be send
-!-- by MPI contiguous
-    !$OMP  PARALLEL PRIVATE ( i, j, k )
-    !$OMP  DO
-#if __acc_fft_device
-     !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-     !$ACC PRESENT(f_inv, f_in)
-#endif
-     DO  k = nzb_x, nzt_x
-         DO  j = nys_x, nyn_x
-             DO  i = 0, nx
-                 f_inv(j,k,i) = f_in(i,j,k)
-             ENDDO
-         ENDDO
-     ENDDO
-     !$OMP  END PARALLEL
-
- END SUBROUTINE resort_for_xy
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Transposition of input array (f_in) from x to y. For the input array, all
-!> elements along x reside on the same PE, while after transposition, all
-!> elements along y reside on the same PE.
-!------------------------------------------------------------------------------!
- SUBROUTINE transpose_xy( f_inv, f_out )
-
-
-#if defined( __parallel )
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, cpu_log_nowait, log_point_s
-#endif
-
-    USE indices,                                                               &
-        ONLY:  nx, ny
+    USE indices,                                                                                   &
+        ONLY:  nx
 
     USE kinds
 
-    USE pegrid
-
-    USE transpose_indices,                                                     &
-        ONLY:  nxl_y, nxr_y, nyn_x, nys_x, nzb_x, nzb_y, nzt_x, nzt_y
+    USE transpose_indices,                                                                         &
+        ONLY:  nyn_x,                                                                              &
+               nys_x,                                                                              &
+               nzb_x,                                                                              &
+               nzt_x
 
     IMPLICIT NONE
@@ -135 +87 @@
     INTEGER(iwp) ::  k  !<
 
-#if defined( __parallel )
-    INTEGER(iwp) ::  l  !<
-    INTEGER(iwp) ::  ys !<
-#endif
-
-    REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) !<
-    REAL(wp) ::  f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y) !<
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) ::  work !<
+    REAL(wp) ::  f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x)   !<
+    REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx)  !<
+
+!
+!-- Rearrange indices of input array in order to make data to be send by MPI contiguous
+    !$OMP  PARALLEL PRIVATE ( i, j, k )
+    !$OMP  DO
+#if __acc_fft_device
+    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
+    !$ACC PRESENT(f_inv, f_in)
+#endif
+    DO  k = nzb_x, nzt_x
+        DO  j = nys_x, nyn_x
+            DO  i = 0, nx
+               f_inv(j,k,i) = f_in(i,j,k)
+            ENDDO
+        ENDDO
+    ENDDO
+    !$OMP  END PARALLEL
+
+ END SUBROUTINE resort_for_xy
+
+
+!--------------------------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Transposition of input array (f_in) from x to y. For the input array, all elements along x reside
+!> on the same PE, while after transposition, all elements along y reside on the same PE.
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE transpose_xy( f_inv, f_out )
+
+
+#if defined( __parallel )
+    USE cpulog,                                                                                    &
+        ONLY:  cpu_log,                                                                            &
+               cpu_log_nowait,                                                                     &
+               log_point_s
+#endif
+
+    USE indices,                                                                                   &
+        ONLY:  nx,                                                                                 &
+               ny
+
+    USE kinds
+
+    USE pegrid
+
+    USE transpose_indices,                                                                         &
+        ONLY:  nxl_y,                                                                              &
+               nxr_y,                                                                              &
+               nyn_x,                                                                              &
+               nys_x,                                                                              &
+               nzb_x,                                                                              &
+               nzb_y,                                                                              &
+               nzt_x,                                                                              &
+               nzt_y
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i  !<
+    INTEGER(iwp) ::  j  !<
+    INTEGER(iwp) ::  k  !<
+
+#if defined( __parallel )
+    INTEGER(iwp) ::  l   !<
+    INTEGER(iwp) ::  ys  !<
+#endif
+
+    REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx)  !<
+    REAL(wp) ::  f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)  !<
+
+#if defined( __parallel )
+    REAL(wp), DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) ::  work  !<
 #if __acc_fft_device
     !$ACC DECLARE CREATE(work)
@@ -167 +182 @@
 
        IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLTOALL( f_inv(nys_x,nzb_x,0),  sendrecvcount_xy, MPI_REAL, &
-                          work(1,nzb_y,nxl_y,0), sendrecvcount_xy, MPI_REAL, &
-                          comm1dy, ierr )
+       CALL MPI_ALLTOALL( f_inv(nys_x,nzb_x,0),  sendrecvcount_xy, MPI_REAL,                       &
+                          work(1,nzb_y,nxl_y,0), sendrecvcount_xy, MPI_REAL, comm1dy, ierr )
 
 #if __acc_fft_device
@@ -227 +241 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Resorting data after the transposition from x to z. The transposition itself
-!> is carried out in transpose_xz
-!------------------------------------------------------------------------------!
+!> Resorting data after the transposition from x to z. The transposition itself is carried out in
+!> transpose_xz.
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE resort_for_xz( f_inv, f_out )
 
 
-     USE indices,                                                              &
-         ONLY:  nxl, nxr, nyn, nys, nz
-
-     USE kinds
-
-     IMPLICIT NONE
-
-     REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz) !<
-     REAL(wp) ::  f_out(1:nz,nys:nyn,nxl:nxr) !<
-
-     INTEGER(iwp) ::  i !<
-     INTEGER(iwp) ::  j !<
-     INTEGER(iwp) ::  k !<
-!
-!-- Rearrange indices of input array in order to make data to be send
-!-- by MPI contiguous.
-!-- In case of parallel fft/transposition, scattered store is faster in
-!-- backward direction!!!
-    !$OMP  PARALLEL PRIVATE ( i, j, k )
-    !$OMP  DO
-#if __acc_fft_device
-     !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-     !$ACC PRESENT(f_out, f_inv)
-#endif
-     DO  i = nxl, nxr
-         DO  j = nys, nyn
-             DO  k = 1, nz
-                 f_out(k,j,i) = f_inv(j,i,k)
-             ENDDO
-         ENDDO
-     ENDDO
-     !$OMP  END PARALLEL
-
- END SUBROUTINE resort_for_xz
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Transposition of input array (f_in) from x to z. For the input array, all
-!> elements along x reside on the same PE, while after transposition, all
-!> elements along z reside on the same PE.
-!------------------------------------------------------------------------------!
- SUBROUTINE transpose_xz( f_in, f_inv )
-
-#if defined( __parallel )
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, cpu_log_nowait, log_point_s
-
-    USE fft_xy,                                                                &
-        ONLY:  f_vec_x, temperton_fft_vec
-#endif
-
-    USE indices,                                                               &
-        ONLY:  nx, nxl, nxr, nyn, nys, nz
-#if defined( __parallel )
-    USE indices,                                                               &
-        ONLY:  nnx
-#endif
+    USE indices,                                                                                   &
+        ONLY:  nxl,                                                                                &
+               nxr,                                                                                &
+               nyn,                                                                                &
+               nys,                                                                                &
+               nz
 
     USE kinds
-
-    USE pegrid
-
-    USE transpose_indices,                                                     &
-        ONLY:  nyn_x, nys_x, nzb_x, nzt_x
 
     IMPLICIT NONE
@@ -308 +264 @@
     INTEGER(iwp) ::  j  !<
     INTEGER(iwp) ::  k  !<
-#if defined( __parallel )
-    INTEGER(iwp) ::  l  !<
-    INTEGER(iwp) ::  mm !<
-    INTEGER(iwp) ::  xs !<
-#endif
-
-    REAL(wp) ::  f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !<
-    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz) !<
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) ::  work !<
+
+    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)  !<
+    REAL(wp) ::  f_out(1:nz,nys:nyn,nxl:nxr)  !<
+
+!
+!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
+!-- In case of parallel fft/transposition, scattered store is faster in backward direction!!!
+   !$OMP  PARALLEL PRIVATE ( i, j, k )
+   !$OMP  DO
+#if __acc_fft_device
+   !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
+   !$ACC PRESENT(f_out, f_inv)
+#endif
+    DO  i = nxl, nxr
+        DO  j = nys, nyn
+            DO  k = 1, nz
+               f_out(k,j,i) = f_inv(j,i,k)
+            ENDDO
+        ENDDO
+    ENDDO
+    !$OMP  END PARALLEL
+
+ END SUBROUTINE resort_for_xz
+
+
+!--------------------------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Transposition of input array (f_in) from x to z. For the input array, all elements along x reside
+!> on the same PE, while after transposition, all elements along z reside on the same PE.
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE transpose_xz( f_in, f_inv )
+
+#if defined( __parallel )
+    USE cpulog,                                                                                    &
+        ONLY:  cpu_log,                                                                            &
+               cpu_log_nowait,                                                                     &
+               log_point_s
+
+    USE fft_xy,                                                                                    &
+        ONLY:  f_vec_x,                                                                            &
+               temperton_fft_vec
+#endif
+
+    USE indices,                                                                                   &
+        ONLY:  nx,                                                                                 &
+               nxl,                                                                                &
+               nxr,                                                                                &
+               nyn,                                                                                &
+               nys,                                                                                &
+               nz
+
+#if defined( __parallel )
+    USE indices,                                                                                   &
+        ONLY:  nnx
+#endif
+
+    USE kinds
+
+    USE pegrid
+
+    USE transpose_indices,                                                                         &
+        ONLY:  nyn_x,                                                                              &
+               nys_x,                                                                              &
+               nzb_x,                                                                              &
+               nzt_x
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i  !<
+    INTEGER(iwp) ::  j  !<
+    INTEGER(iwp) ::  k  !<
+
+#if defined( __parallel )
+    INTEGER(iwp) ::  l   !<
+    INTEGER(iwp) ::  mm  !<
+    INTEGER(iwp) ::  xs  !<
+#endif
+
+    REAL(wp) ::  f_in(0:nx,nys_x:nyn_x,nzb_x:nzt_x)  !<
+    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)         !<
+
+#if defined( __parallel )
+    REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) ::  work  !<
 #if __acc_fft_device
     !$ACC DECLARE CREATE(work)
@@ -325 +354 @@
 
     !
-    !-- If the PE grid is one-dimensional along y, the array has only to be
-    !-- reordered locally and therefore no transposition has to be done.
+    !-- If the PE grid is one-dimensional along y, the array has only to be reordered locally and
+    !-- therefore no transposition has to be done.
     IF ( pdims(1) /= 1 )  THEN
 
@@ -383 +412 @@
 
        IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLTOALL( work(nys_x,1,nzb_x,0), sendrecvcount_zx, MPI_REAL, &
-                          f_inv(nys,nxl,1),      sendrecvcount_zx, MPI_REAL, &
-                          comm1dx, ierr )
+       CALL MPI_ALLTOALL( work(nys_x,1,nzb_x,0), sendrecvcount_zx, MPI_REAL,                       &
+                          f_inv(nys,nxl,1),      sendrecvcount_zx, MPI_REAL, comm1dx, ierr )
 
 #if __acc_fft_device
@@ -422 +450 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Resorting data after the transposition from y to x. The transposition itself
-!> is carried out in transpose_yx
-!------------------------------------------------------------------------------!
+!> Resorting data after the transposition from y to x. The transposition itself is carried out in
+!> transpose_yx.
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE resort_for_yx( f_inv, f_out )
 
 
-     USE indices,                                                              &
-         ONLY:  nx
-
-     USE kinds
-
-     USE transpose_indices,                                                    &
-         ONLY:  nyn_x, nys_x, nzb_x, nzt_x
-
-     IMPLICIT NONE
-
-     REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) !<
-     REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !<
-
-
-     INTEGER(iwp) ::  i !<
-     INTEGER(iwp) ::  j !<
-     INTEGER(iwp) ::  k !<
-!
-!-- Rearrange indices of input array in order to make data to be send
-!-- by MPI contiguous
-    !$OMP  PARALLEL PRIVATE ( i, j, k )
-    !$OMP  DO
-#if __acc_fft_device
-     !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-     !$ACC PRESENT(f_out, f_inv)
-#endif
-     DO  k = nzb_x, nzt_x
-         DO  j = nys_x, nyn_x
-             DO  i = 0, nx
-                 f_out(i,j,k) = f_inv(j,k,i)
-             ENDDO
-         ENDDO
-     ENDDO
-     !$OMP  END PARALLEL
-
- END SUBROUTINE resort_for_yx
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Transposition of input array (f_in) from y to x. For the input array, all
-!> elements along y reside on the same PE, while after transposition, all
-!> elements along x reside on the same PE.
-!------------------------------------------------------------------------------!
- SUBROUTINE transpose_yx( f_in, f_inv )
-
-
-#if defined( __parallel )
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, cpu_log_nowait, log_point_s
-#endif
-
-    USE indices,                                                               &
-        ONLY:  nx, ny
+    USE indices,                                                                                   &
+        ONLY:  nx
 
     USE kinds
 
-    USE pegrid
-
-    USE transpose_indices,                                                     &
-        ONLY:  nxl_y, nxr_y, nyn_x, nys_x, nzb_x, nzb_y, nzt_x, nzt_y
+    USE transpose_indices,                                                                         &
+        ONLY:  nyn_x,                                                                              &
+               nys_x,                                                                              &
+               nzb_x,                                                                              &
+               nzt_x
 
     IMPLICIT NONE
@@ -499 +475 @@
     INTEGER(iwp) ::  j  !<
     INTEGER(iwp) ::  k  !<
-#if defined( __parallel )
-    INTEGER(iwp) ::  l  !<
-    INTEGER(iwp) ::  ys !<
-#endif
-
-    REAL(wp) ::  f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)  !<
-    REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx) !<
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) ::  work !<
+
+    REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx)  !<
+    REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x)  !<
+
+!
+!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
+   !$OMP  PARALLEL PRIVATE ( i, j, k )
+   !$OMP  DO
+#if __acc_fft_device
+   !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
+   !$ACC PRESENT(f_out, f_inv)
+#endif
+    DO  k = nzb_x, nzt_x
+        DO  j = nys_x, nyn_x
+            DO  i = 0, nx
+               f_out(i,j,k) = f_inv(j,k,i)
+            ENDDO
+        ENDDO
+    ENDDO
+    !$OMP  END PARALLEL
+
+ END SUBROUTINE resort_for_yx
+
+
+!--------------------------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Transposition of input array (f_in) from y to x. For the input array, all  elements along y
+!> reside on the same PE, while after transposition, all elements along x reside on the same PE.
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE transpose_yx( f_in, f_inv )
+
+
+#if defined( __parallel )
+    USE cpulog,                                                                                    &
+        ONLY:  cpu_log,                                                                            &
+               cpu_log_nowait,                                                                     &
+               log_point_s
+#endif
+
+    USE indices,                                                                                   &
+        ONLY:  nx,                                                                                 &
+               ny
+
+    USE kinds
+
+    USE pegrid
+
+    USE transpose_indices,                                                                         &
+        ONLY:  nxl_y,                                                                              &
+               nxr_y,                                                                              &
+               nyn_x,                                                                              &
+               nys_x,                                                                              &
+               nzb_x,                                                                              &
+               nzb_y,                                                                              &
+               nzt_x,                                                                              &
+               nzt_y
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i  !<
+    INTEGER(iwp) ::  j  !<
+    INTEGER(iwp) ::  k  !<
+
+#if defined( __parallel )
+    INTEGER(iwp) ::  l   !<
+    INTEGER(iwp) ::  ys  !<
+#endif
+
+    REAL(wp) ::  f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)   !<
+    REAL(wp) ::  f_inv(nys_x:nyn_x,nzb_x:nzt_x,0:nx)  !<
+
+#if defined( __parallel )
+    REAL(wp), DIMENSION(nyn_x-nys_x+1,nzb_y:nzt_y,nxl_y:nxr_y,0:pdims(2)-1) ::  work  !<
 #if __acc_fft_device
     !$ACC DECLARE CREATE(work)
@@ -552 +592 @@
 
        IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLTOALL( work(1,nzb_y,nxl_y,0), sendrecvcount_xy, MPI_REAL, &
-                          f_inv(nys_x,nzb_x,0),  sendrecvcount_xy, MPI_REAL, &
-                          comm1dy, ierr )
+       CALL MPI_ALLTOALL( work(1,nzb_y,nxl_y,0), sendrecvcount_xy, MPI_REAL,                       &
+                          f_inv(nys_x,nzb_x,0),  sendrecvcount_xy, MPI_REAL, comm1dy, ierr )
 
 #if __acc_fft_device
@@ -570 +609 @@
 
 !
-!--    Reorder array f_in the same way as ALLTOALL did it
+!--    Reorder array f_in the same way as ALLTOALL did it.
 !$OMP  PARALLEL PRIVATE ( i, j, k )
 !$OMP  DO
@@ -591 +630 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Transposition of input array (f_in) from y to x. For the input array, all
-!> elements along y reside on the same PE, while after transposition, all
-!> elements along x reside on the same PE.
-!> This is a direct transposition for arrays with indices in regular order
-!> (k,j,i) (cf. transpose_yx).
-!------------------------------------------------------------------------------!
+!> Transposition of input array (f_in) from y to x. For the input array, all elements along y reside
+!> on the same PE, while after transposition, all elements along x reside on the same PE. This is a
+!> direct transposition for arrays with indices in regular order (k,j,i) (cf. transpose_yx).
+!--------------------------------------------------------------------------------------------------!
 #if defined( __parallel )
  SUBROUTINE transpose_yxd( f_in, f_out )
 
 
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, log_point_s
-
-    USE indices,                                                               &
-        ONLY:  nnx, nny, nnz, nx, nxl, nxr, nyn, nys, nz
+    USE cpulog,                                                                                    &
+        ONLY:  cpu_log,                                                                            &
+               log_point_s
+
+    USE indices,                                                                                   &
+        ONLY:  nnx,                                                                                &
+               nny,                                                                                &
+               nnz,                                                                                &
+               nx,                                                                                 &
+               nxl,                                                                                &
+               nxr,                                                                                &
+               nyn,                                                                                &
+               nys,                                                                                &
+               nz
 
     USE kinds
@@ -614 +660 @@
     USE pegrid
 
-    USE transpose_indices,                                                     &
-        ONLY:  nyn_x, nys_x, nzb_x, nzt_x
+    USE transpose_indices,                                                                         &
+        ONLY:  nyn_x,                                                                              &
+               nys_x,                                                                              &
+               nzb_x,                                                                              &
+               nzt_x
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-    INTEGER(iwp) ::  l  !<
-    INTEGER(iwp) ::  m  !<
-    INTEGER(iwp) ::  xs !<
-
-    REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)          !<
-    REAL(wp) ::  f_inv(nxl:nxr,1:nz,nys:nyn)         !<
-    REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !<
-    REAL(wp) ::  work(nnx*nny*nnz)                   !<
-
-!
-!-- Rearrange indices of input array in order to make data to be send
-!-- by MPI contiguous
+    INTEGER(iwp) ::  i   !<
+    INTEGER(iwp) ::  j   !<
+    INTEGER(iwp) ::  k   !<
+    INTEGER(iwp) ::  l   !<
+    INTEGER(iwp) ::  m   !<
+    INTEGER(iwp) ::  xs  !<
+
+    REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)           !<
+    REAL(wp) ::  f_inv(nxl:nxr,1:nz,nys:nyn)          !<
+    REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x)  !<
+    REAL(wp) ::  work(nnx*nny*nnz)                    !<
+
+!
+!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
     DO  k = 1, nz
        DO  j = nys, nyn
@@ -646 +694 @@
     CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
     IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLTOALL( f_inv(nxl,1,nys), sendrecvcount_xy, MPI_REAL, &
-                       work(1),          sendrecvcount_xy, MPI_REAL, &
-                       comm1dx, ierr )
+    CALL MPI_ALLTOALL( f_inv(nxl,1,nys), sendrecvcount_xy, MPI_REAL,                               &
+                       work(1), sendrecvcount_xy, MPI_REAL, comm1dx, ierr )
     CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
 
@@ -670 +717 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Resorting data for the transposition from y to z. The transposition itself
-!> is carried out in transpose_yz
-!------------------------------------------------------------------------------!
+!> Resorting data for the transposition from y to z. The transposition itself is carried out in
+!> transpose_yz.
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE resort_for_yz( f_in, f_inv )
 
 
-     USE indices,                                                              &
-         ONLY:  ny
-
-     USE kinds
-
-     USE transpose_indices,                                                    &
-         ONLY:  nxl_y, nxr_y, nzb_y, nzt_y
-
-     IMPLICIT NONE
-
-     REAL(wp) ::  f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)  !<
-     REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) !<
-
-     INTEGER(iwp) ::  i !<
-     INTEGER(iwp) ::  j !<
-     INTEGER(iwp) ::  k !<
-
-!
-!-- Rearrange indices of input array in order to make data to be send
-!-- by MPI contiguous
-    !$OMP  PARALLEL PRIVATE ( i, j, k )
-    !$OMP  DO
-#if __acc_fft_device
-     !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-     !$ACC PRESENT(f_inv, f_in)
-#endif
-     DO  k = nzb_y, nzt_y
-         DO  i = nxl_y, nxr_y
-             DO  j = 0, ny
-                 f_inv(i,k,j) = f_in(j,i,k)
-             ENDDO
-         ENDDO
-     ENDDO
-     !$OMP  END PARALLEL
-
- END SUBROUTINE resort_for_yz
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Transposition of input array (f_in) from y to z. For the input array, all
-!> elements along y reside on the same PE, while after transposition, all
-!> elements along z reside on the same PE.
-!------------------------------------------------------------------------------!
- SUBROUTINE transpose_yz( f_inv, f_out )
-
-
-#if defined( __parallel )
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, cpu_log_nowait, log_point_s
-#endif
-
-    USE indices,                                                               &
-        ONLY:  ny, nz
+    USE indices,                                                                                   &
+        ONLY:  ny
 
     USE kinds
 
-    USE pegrid
-
-    USE transpose_indices,                                                     &
-        ONLY:  nxl_y, nxl_z, nxr_y, nxr_z, nyn_z, nys_z, nzb_y, nzt_y
+    USE transpose_indices,                                                                         &
+        ONLY:  nxl_y,                                                                              &
+               nxr_y,                                                                              &
+               nzb_y,                                                                              &
+               nzt_y
 
     IMPLICIT NONE
@@ -747 +742 @@
     INTEGER(iwp) ::  j  !<
     INTEGER(iwp) ::  k  !<
-#if defined( __parallel )
-    INTEGER(iwp) ::  l  !<
-    INTEGER(iwp) ::  zs !<
-#endif
-
-    REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) !<
-    REAL(wp) ::  f_out(nxl_z:nxr_z,nys_z:nyn_z,1:nz) !<
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) ::  work !<
+
+    REAL(wp) ::  f_in(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)   !<
+    REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny)  !<
+
+!
+!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
+   !$OMP  PARALLEL PRIVATE ( i, j, k )
+   !$OMP  DO
+#if __acc_fft_device
+    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
+    !$ACC PRESENT(f_inv, f_in)
+#endif
+    DO  k = nzb_y, nzt_y
+        DO  i = nxl_y, nxr_y
+            DO  j = 0, ny
+               f_inv(i,k,j) = f_in(j,i,k)
+            ENDDO
+        ENDDO
+    ENDDO
+    !$OMP  END PARALLEL
+
+ END SUBROUTINE resort_for_yz
+
+
+!--------------------------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Transposition of input array (f_in) from y to z. For the input array, all elements along y reside
+!> on the same PE, while after transposition, all elements along z reside on the same PE.
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE transpose_yz( f_inv, f_out )
+
+
+#if defined( __parallel )
+    USE cpulog,                                                                                    &
+        ONLY:  cpu_log,                                                                            &
+               cpu_log_nowait,                                                                     &
+               log_point_s
+#endif
+
+    USE indices,                                                                                   &
+        ONLY:  ny,                                                                                 &
+               nz
+
+    USE kinds
+
+    USE pegrid
+
+    USE transpose_indices,                                                                         &
+        ONLY:  nxl_y,                                                                              &
+               nxl_z,                                                                              &
+               nxr_y,                                                                              &
+               nxr_z,                                                                              &
+               nyn_z,                                                                              &
+               nys_z,                                                                              &
+               nzb_y,                                                                              &
+               nzt_y
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i  !<
+    INTEGER(iwp) ::  j  !<
+    INTEGER(iwp) ::  k  !<
+
+#if defined( __parallel )
+    INTEGER(iwp) ::  l   !<
+    INTEGER(iwp) ::  zs  !<
+#endif
+
+    REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny)  !<
+    REAL(wp) ::  f_out(nxl_z:nxr_z,nys_z:nyn_z,1:nz)  !<
+
+#if defined( __parallel )
+    REAL(wp), DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) ::  work  !<
 #if __acc_fft_device
     !$ACC DECLARE CREATE(work)
@@ -764 +823 @@
 
 !
-!-- If the PE grid is one-dimensional along y, only local reordering
-!-- of the data is necessary and no transposition has to be done.
+!-- If the PE grid is one-dimensional along y, only local reordering of the data is necessary and no
+!-- transposition has to be done.
     IF ( pdims(1) == 1 )  THEN
 
@@ -799 +858 @@
 
        IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLTOALL( f_inv(nxl_y,nzb_y,0),  sendrecvcount_yz, MPI_REAL, &
-                          work(nxl_z,1,nys_z,0), sendrecvcount_yz, MPI_REAL, &
-                          comm1dx, ierr )
+       CALL MPI_ALLTOALL( f_inv(nxl_y,nzb_y,0),  sendrecvcount_yz, MPI_REAL,                       &
+                          work(nxl_z,1,nys_z,0), sendrecvcount_yz, MPI_REAL, comm1dx, ierr )
 
 #if __acc_fft_device
@@ -840 +898 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Resorting data for the transposition from z to x. The transposition itself
-!> is carried out in transpose_zx
-!------------------------------------------------------------------------------!
+!> Resorting data for the transposition from z to x. The transposition itself is carried out in
+!> transpose_zx.
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE resort_for_zx( f_in, f_inv )
 
 
-     USE indices,                                                              &
-         ONLY:  nxl, nxr, nyn, nys, nz
-
-     USE kinds
-
-     IMPLICIT NONE
-
-     REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)  !<
-     REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz) !<
-
-     INTEGER(iwp) ::  i !<
-     INTEGER(iwp) ::  j !<
-     INTEGER(iwp) ::  k !<
-
-!
-!-- Rearrange indices of input array in order to make data to be send
-!-- by MPI contiguous
-    !$OMP  PARALLEL PRIVATE ( i, j, k )
-    !$OMP  DO
-#if __acc_fft_device
-    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-    !$ACC PRESENT(f_in, f_inv)
-#endif
-     DO  i = nxl, nxr
-         DO  j = nys, nyn
-             DO  k = 1,nz
-                 f_inv(j,i,k) = f_in(k,j,i)
-             ENDDO
-         ENDDO
-     ENDDO
-     !$OMP  END PARALLEL
-
- END SUBROUTINE resort_for_zx
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Transposition of input array (f_in) from z to x. For the input array, all
-!> elements along z reside on the same PE, while after transposition, all
-!> elements along x reside on the same PE.
-!------------------------------------------------------------------------------!
- SUBROUTINE transpose_zx( f_inv, f_out )
-
-
-#if defined( __parallel )
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, cpu_log_nowait, log_point_s
-
-    USE fft_xy,                                                                &
-        ONLY:  f_vec_x, temperton_fft_vec
-#endif
-
-    USE indices,                                                               &
-        ONLY:  nx, nxl, nxr, nyn, nys, nz
-#if defined( __parallel )
-    USE indices,                                                               &
-        ONLY:  nnx
-#endif
+    USE indices,                                                                                   &
+        ONLY:  nxl,                                                                                &
+               nxr,                                                                                &
+               nyn,                                                                                &
+               nys,                                                                                &
+               nz
 
     USE kinds
-
-    USE pegrid
-
-    USE transpose_indices,                                                     &
-        ONLY:  nyn_x, nys_x, nzb_x, nzt_x
 
     IMPLICIT NONE
@@ -921 +921 @@
     INTEGER(iwp) ::  j  !<
     INTEGER(iwp) ::  k  !<
-#if defined( __parallel )
-    INTEGER(iwp) ::  l  !<
-    INTEGER(iwp) ::  mm !<
-    INTEGER(iwp) ::  xs !<
-#endif
-
-    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)         !<
-    REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x) !<
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) ::  work !<
+
+    REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)   !<
+    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)  !<
+
+!
+!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
+   !$OMP  PARALLEL PRIVATE ( i, j, k )
+   !$OMP  DO
+#if __acc_fft_device
+   !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
+   !$ACC PRESENT(f_in, f_inv)
+#endif
+    DO  i = nxl, nxr
+        DO  j = nys, nyn
+            DO  k = 1,nz
+               f_inv(j,i,k) = f_in(k,j,i)
+            ENDDO
+        ENDDO
+    ENDDO
+    !$OMP  END PARALLEL
+
+ END SUBROUTINE resort_for_zx
+
+
+!--------------------------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Transposition of input array (f_in) from z to x. For the input array, all elements along z reside
+!> on the same PE, while after transposition, all elements along x reside on the same PE.
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE transpose_zx( f_inv, f_out )
+
+
+#if defined( __parallel )
+    USE cpulog,                                                                                    &
+        ONLY:  cpu_log,                                                                            &
+               cpu_log_nowait,                                                                     &
+               log_point_s
+
+    USE fft_xy,                                                                                    &
+        ONLY:  f_vec_x,                                                                            &
+               temperton_fft_vec
+#endif
+
+    USE indices,                                                                                   &
+        ONLY:  nx,                                                                                 &
+               nxl,                                                                                &
+               nxr,                                                                                &
+               nyn,                                                                                &
+               nys,                                                                                &
+               nz
+
+#if defined( __parallel )
+    USE indices,                                                                                   &
+        ONLY:  nnx
+#endif
+
+    USE kinds
+
+    USE pegrid
+
+    USE transpose_indices,                                                                         &
+        ONLY:  nyn_x,                                                                              &
+               nys_x,                                                                              &
+               nzb_x,                                                                              &
+               nzt_x
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i  !<
+    INTEGER(iwp) ::  j  !<
+    INTEGER(iwp) ::  k  !<
+
+#if defined( __parallel )
+    INTEGER(iwp) ::  l   !<
+    INTEGER(iwp) ::  mm  !<
+    INTEGER(iwp) ::  xs  !<
+#endif
+
+    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)          !<
+    REAL(wp) ::  f_out(0:nx,nys_x:nyn_x,nzb_x:nzt_x)  !<
+
+#if defined( __parallel )
+    REAL(wp), DIMENSION(nys_x:nyn_x,nnx,nzb_x:nzt_x,0:pdims(1)-1) ::  work  !<
 #if __acc_fft_device
     !$ACC DECLARE CREATE(work)
@@ -939 +1012 @@
 
 !
-!-- If the PE grid is one-dimensional along y, only local reordering
-!-- of the data is necessary and no transposition has to be done.
+!-- If the PE grid is one-dimensional along y, only local reordering of the data is necessary and no
+!-- transposition has to be done.
     IF ( pdims(1) == 1 )  THEN
 
@@ -974 +1047 @@
 
        IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLTOALL( f_inv(nys,nxl,1),      sendrecvcount_zx, MPI_REAL, &
-                          work(nys_x,1,nzb_x,0), sendrecvcount_zx, MPI_REAL, &
-                          comm1dx, ierr )
+       CALL MPI_ALLTOALL( f_inv(nys,nxl,1),      sendrecvcount_zx, MPI_REAL,                       &
+                          work(nys_x,1,nzb_x,0), sendrecvcount_zx, MPI_REAL, comm1dx, ierr )
 
 #if __acc_fft_device
@@ -1036 +1108 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Resorting data after the transposition from z to y. The transposition itself
-!> is carried out in transpose_zy
-!------------------------------------------------------------------------------!
+!> Resorting data after the transposition from z to y. The transposition itself is carried out in
+!> transpose_zy.
+!--------------------------------------------------------------------------------------------------!
  SUBROUTINE resort_for_zy( f_inv, f_out )
 
 
-     USE indices,                                                              &
-         ONLY:  ny
-
-     USE kinds
-
-     USE transpose_indices,                                                    &
-         ONLY:  nxl_y, nxr_y, nzb_y, nzt_y
-
-     IMPLICIT NONE
-
-     REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) !<
-     REAL(wp) ::  f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y) !<
-
-
-     INTEGER(iwp) ::  i !<
-     INTEGER(iwp) ::  j !<
-     INTEGER(iwp) ::  k !<
-
-!
-!-- Rearrange indices of input array in order to make data to be send
-!-- by MPI contiguous
-    !$OMP  PARALLEL PRIVATE ( i, j, k )
-    !$OMP  DO
-#if __acc_fft_device
-    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
-    !$ACC PRESENT(f_out, f_inv)
-#endif
-     DO  k = nzb_y, nzt_y
-         DO  i = nxl_y, nxr_y
-             DO  j = 0, ny
-                 f_out(j,i,k) = f_inv(i,k,j)
-             ENDDO
-         ENDDO
-     ENDDO
-     !$OMP  END PARALLEL
-
- END SUBROUTINE resort_for_zy
-
-
-!------------------------------------------------------------------------------!
-! Description:cpu_log_nowait
-! ------------
-!> Transposition of input array (f_in) from z to y. For the input array, all
-!> elements along z reside on the same PE, while after transposition, all
-!> elements along y reside on the same PE.
-!------------------------------------------------------------------------------!
- SUBROUTINE transpose_zy( f_in, f_inv )
-
-
-#if defined( __parallel )
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, cpu_log_nowait, log_point_s
-#endif
-
-    USE indices,                                                               &
-        ONLY:  ny, nz
+    USE indices,                                                                                   &
+        ONLY:  ny
 
     USE kinds
 
-    USE pegrid
-
-    USE transpose_indices,                                                     &
-        ONLY:  nxl_y, nxl_z, nxr_y, nxr_z, nyn_z, nys_z, nzb_y, nzt_y
+    USE transpose_indices,                                                                         &
+        ONLY:  nxl_y,                                                                              &
+               nxr_y,                                                                              &
+               nzb_y,                                                                              &
+               nzt_y
 
     IMPLICIT NONE
@@ -1114 +1133 @@
     INTEGER(iwp) ::  j  !<
     INTEGER(iwp) ::  k  !<
-#if defined( __parallel )
-    INTEGER(iwp) ::  l  !<
-    INTEGER(iwp) ::  zs !<
-#endif
-
-    REAL(wp) ::  f_in(nxl_z:nxr_z,nys_z:nyn_z,1:nz)  !<
-    REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny) !<
-
-#if defined( __parallel )
-    REAL(wp), DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) ::  work !<
+
+    REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny)  !<
+    REAL(wp) ::  f_out(0:ny,nxl_y:nxr_y,nzb_y:nzt_y)  !<
+
+!
+!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
+    !$OMP  PARALLEL PRIVATE ( i, j, k )
+    !$OMP  DO
+#if __acc_fft_device
+    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i,j,k) &
+    !$ACC PRESENT(f_out, f_inv)
+#endif
+    DO  k = nzb_y, nzt_y
+        DO  i = nxl_y, nxr_y
+            DO  j = 0, ny
+               f_out(j,i,k) = f_inv(i,k,j)
+            ENDDO
+        ENDDO
+    ENDDO
+    !$OMP  END PARALLEL
+
+ END SUBROUTINE resort_for_zy
+
+
+!--------------------------------------------------------------------------------------------------!
+! Description:cpu_log_nowait
+! ------------
+!> Transposition of input array (f_in) from z to y. For the input array, all elements along z reside
+!> on the same PE, while after transposition, all elements along y reside on the same PE.
+!--------------------------------------------------------------------------------------------------!
+ SUBROUTINE transpose_zy( f_in, f_inv )
+
+
+#if defined( __parallel )
+    USE cpulog,                                                                                    &
+        ONLY:  cpu_log,                                                                            &
+               cpu_log_nowait,                                                                     &
+               log_point_s
+#endif
+
+    USE indices,                                                                                   &
+        ONLY:  ny,                                                                                 &
+               nz
+
+    USE kinds
+
+    USE pegrid
+
+    USE transpose_indices,                                                                         &
+        ONLY:  nxl_y,                                                                              &
+               nxl_z,                                                                              &
+               nxr_y,                                                                              &
+               nxr_z,                                                                              &
+               nyn_z,                                                                              &
+               nys_z,                                                                              &
+               nzb_y,                                                                              &
+               nzt_y
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i  !<
+    INTEGER(iwp) ::  j  !<
+    INTEGER(iwp) ::  k  !<
+
+#if defined( __parallel )
+    INTEGER(iwp) ::  l   !<
+    INTEGER(iwp) ::  zs  !<
+#endif
+
+    REAL(wp) ::  f_in(nxl_z:nxr_z,nys_z:nyn_z,1:nz)   !<
+    REAL(wp) ::  f_inv(nxl_y:nxr_y,nzb_y:nzt_y,0:ny)  !<
+
+#if defined( __parallel )
+    REAL(wp), DIMENSION(nxl_z:nxr_z,nzt_y-nzb_y+1,nys_z:nyn_z,0:pdims(1)-1) ::  work  !<
 #if __acc_fft_device
     !$ACC DECLARE CREATE(work)
@@ -1130 +1213 @@
 
 !
-!-- If the PE grid is one-dimensional along y, the array has only to be
-!-- reordered locally and therefore no transposition has to be done.
+!-- If the PE grid is one-dimensional along y, the array has only to be reordered locally and
+!-- therefore no transposition has to be done.
     IF ( pdims(1) /= 1 )  THEN
 
@@ -1169 +1252 @@
 
        IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-       CALL MPI_ALLTOALL( work(nxl_z,1,nys_z,0), sendrecvcount_yz, MPI_REAL, &
-                          f_inv(nxl_y,nzb_y,0),  sendrecvcount_yz, MPI_REAL, &
-                          comm1dx, ierr )
+       CALL MPI_ALLTOALL( work(nxl_z,1,nys_z,0), sendrecvcount_yz, MPI_REAL,                       &
+                          f_inv(nxl_y,nzb_y,0),  sendrecvcount_yz, MPI_REAL, comm1dx, ierr )
 
 #if __acc_fft_device
@@ -1207 +1289 @@
 
 
-!------------------------------------------------------------------------------!
+!--------------------------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Transposition of input array (f_in) from z to y. For the input array, all
-!> elements along z reside on the same PE, while after transposition, all
-!> elements along y reside on the same PE.
-!> This is a direct transposition for arrays with indices in regular order
-!> (k,j,i) (cf. transpose_zy).
-!------------------------------------------------------------------------------!
+!> Transposition of input array (f_in) from z to y. For the input array, all elements along z reside
+!> on the same PE, while after transposition, all elements along y reside on the same PE. This is a
+!> direct transposition for arrays with indices in regular order (k,j,i) (cf. transpose_zy).
+!--------------------------------------------------------------------------------------------------!
 #if defined( __parallel )
  SUBROUTINE transpose_zyd( f_in, f_out )
 
 
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, log_point_s
-
-    USE indices,                                                               &
-        ONLY:  nnx, nny, nnz, nxl, nxr, nyn, nys, ny, nz
+    USE cpulog,                                                                                    &
+        ONLY:  cpu_log,                                                                            &
+               log_point_s
+
+    USE indices,                                                                                   &
+        ONLY:  nnx,                                                                                &
+               nny,                                                                                &
+               nnz,                                                                                &
+               nxl,                                                                                &
+               nxr,                                                                                &
+               nyn,                                                                                &
+               nys,                                                                                &
+               ny,                                                                                 &
+               nz
 
     USE kinds
@@ -1230 +1319 @@
     USE pegrid
 
-    USE transpose_indices,                                                     &
-        ONLY:  nxl_yd, nxr_yd, nzb_yd, nzt_yd
+    USE transpose_indices,                                                                         &
+        ONLY:  nxl_yd,                                                                             &
+               nxr_yd,                                                                             &
+               nzb_yd,                                                                             &
+               nzt_yd
 
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i  !<
-    INTEGER(iwp) ::  j  !<
-    INTEGER(iwp) ::  k  !<
-    INTEGER(iwp) ::  l  !<
-    INTEGER(iwp) ::  m  !<
-    INTEGER(iwp) ::  ys !<
-
-    REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)              !<
-    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)             !<
-    REAL(wp) ::  f_out(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd) !<
-    REAL(wp) ::  work(nnx*nny*nnz)                       !<
-
-!
-!-- Rearrange indices of input array in order to make data to be send
-!-- by MPI contiguous
+    INTEGER(iwp) ::  i   !<
+    INTEGER(iwp) ::  j   !<
+    INTEGER(iwp) ::  k   !<
+    INTEGER(iwp) ::  l   !<
+    INTEGER(iwp) ::  m   !<
+    INTEGER(iwp) ::  ys  !<
+
+    REAL(wp) ::  f_in(1:nz,nys:nyn,nxl:nxr)               !<
+    REAL(wp) ::  f_inv(nys:nyn,nxl:nxr,1:nz)              !<
+    REAL(wp) ::  f_out(0:ny,nxl_yd:nxr_yd,nzb_yd:nzt_yd)  !<
+    REAL(wp) ::  work(nnx*nny*nnz)                        !<
+
+!
+!-- Rearrange indices of input array in order to make data to be send by MPI contiguous.
     DO  i = nxl, nxr
        DO  j = nys, nyn
@@ -1259 +1350 @@
 
 !
-!-- Move data to different array, because memory location of work1 is
-!-- needed further below (work1 = work2).
-!-- If the PE grid is one-dimensional along x, only local reordering
-!-- of the data is necessary and no transposition has to be done.
+!-- Move data to different array, because memory location of work1 is needed further below
+!-- (work1 = work2). If the PE grid is one-dimensional along x, only local reordering of the data is
+!-- necessary and no transposition has to be done.
     IF ( pdims(2) == 1 )  THEN
        DO  k = 1, nz
@@ -1278 +1368 @@
     CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
     IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zyd, MPI_REAL, &
-                       work(1),          sendrecvcount_zyd, MPI_REAL, &
-                       comm1dy, ierr )
+    CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zyd, MPI_REAL,                              &
+                       work(1), sendrecvcount_zyd, MPI_REAL, comm1dy, ierr )
     CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )