Changeset 3693 for palm


Ignore:
Timestamp:
Jan 23, 2019 3:20:53 PM (3 years ago)
Author:
dom_dwd_user
Message:

biometeorology_mod.f90:
(C) renamed averageing switches from e.g. 'aver_q' to 'do_average_q' for better readability
(N) introduced a tmrt_av_grid to store time-averaged mean radiant temperature in a discrete 2d grid (analoge to tmrt_grid). Added mrt_av_grid to restart methods.
(B) replaced mis-named do_average_perct by do_average_theta, as confusing otherwise.
(C) improved general code commenting
(C) 'thermal_comfort' now defaults to .FALSE. (analogue to 'uv_exposure').

File:
1 edited

Legend:

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

    r3685 r3693  
    2727! -----------------
    2828! $Id$
     29! Added usage of time_averaged mean radiant temperature, together with calculation,
     30! grid and restart routines. General cleanup and commenting.
     31!
     32! 3685 2019-01-21 01:02:11Z knoop
    2933! Some interface calls moved to module_interface + cleanup
    3034!
     
    113117              surface_pressure
    114118
    115     USE date_and_time_mod,                                                                                                        &
     119    USE date_and_time_mod,                                                     &
    116120        ONLY:  calc_date_and_time, day_of_year, time_utc
    117121
     
    125129    USE kinds  !< Set precision of INTEGER and REAL arrays according to PALM
    126130
    127     USE netcdf_data_input_mod,                                                                                                    &
    128         ONLY:  netcdf_data_input_uvem, uvem_projarea_f, uvem_radiance_f,                                                          &
     131    USE netcdf_data_input_mod,                                                 &
     132        ONLY:  netcdf_data_input_uvem, uvem_projarea_f, uvem_radiance_f,       &
    129133               uvem_irradiance_f, uvem_integration_f, building_obstruction_f
    130134!
     
    152156!-- Grids for averaged thermal indices
    153157    REAL(wp), DIMENSION(:), ALLOCATABLE   ::  mrt_av_grid   !< time average mean
     158    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tmrt_av_grid  !< tmrt results (degree_C)
    154159    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  perct_av      !< PT results (aver. input)   (degree_C)
    155160    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  utci_av       !< UTCI results (aver. input) (degree_C)
     
    165170!
    166171!--
    167     LOGICAL ::  aver_perct = .FALSE.  !< switch: do perct averaging in this module? (if .FALSE. this is done globally)
    168     LOGICAL ::  aver_q     = .FALSE.  !< switch: do e  averaging in this module?
    169     LOGICAL ::  aver_u     = .FALSE.  !< switch: do u  averaging in this module?
    170     LOGICAL ::  aver_v     = .FALSE.  !< switch: do v  averaging in this module?
    171     LOGICAL ::  aver_w     = .FALSE.  !< switch: do w  averaging in this module?
     172    LOGICAL ::  do_average_theta = .FALSE.  !< switch: do theta averaging in this module? (if .FALSE. this is done globally)
     173    LOGICAL ::  do_average_q     = .FALSE.  !< switch: do e averaging in this module?
     174    LOGICAL ::  do_average_u     = .FALSE.  !< switch: do u averaging in this module?
     175    LOGICAL ::  do_average_v     = .FALSE.  !< switch: do v averaging in this module?
     176    LOGICAL ::  do_average_w     = .FALSE.  !< switch: do w averaging in this module?
     177    LOGICAL ::  do_average_mrt   = .FALSE.  !< switch: do mrt averaging in this module?
    172178    LOGICAL ::  average_trigger_perct = .FALSE.  !< update averaged input on call to bio_perct?
    173179    LOGICAL ::  average_trigger_utci  = .FALSE.  !< update averaged input on call to bio_utci?
    174180    LOGICAL ::  average_trigger_pet   = .FALSE.  !< update averaged input on call to bio_pet?
    175181
    176     LOGICAL ::  thermal_comfort = .TRUE.  !< Turn all thermal indices on or off
     182    LOGICAL ::  thermal_comfort = .FALSE.  !< Turn all thermal indices on or off
    177183    LOGICAL ::  bio_perct     = .TRUE.   !< Turn index PT (instant. input) on or off
    178184    LOGICAL ::  bio_perct_av  = .TRUE.   !< Turn index PT (averaged input) on or off
     
    378384!
    379385!--          Averaging, as well as the allocation of the required grids must be
    380 !            done only once, independent from for how many thermal indices
    381 !            averaged output is desired.
    382 !            Therefore wee need to memorize which index is the one that controls
    383 !            the averaging (what must be the first thermal index called).
    384 !            Indices are in unknown order as depending on the input file,
    385 !            determine first index to average und update only once
     386!--          done only once, independent from for how many thermal indices
     387!--          averaged output is desired.
     388!--          Therefore wee need to memorize which index is the one that controls
     389!--          the averaging (what must be the first thermal index called).
     390!--          Indices are in unknown order as depending on the input file,
     391!--          determine first index to average und update only once
    386392
    387393!--          Only proceed here if this was not done for any index before. This
    388 !            is done only once during the whole model run.
     394!--          is done only once during the whole model run.
    389395             IF ( .NOT. average_trigger_perct .AND.                            &
    390396                  .NOT. average_trigger_utci  .AND.                            &
     
    413419             IF ( .NOT. ALLOCATED( pt_av ) )  THEN
    414420                ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    415                 aver_perct = .TRUE.
     421                do_average_theta = .TRUE.
    416422                pt_av = 0.0_wp
    417423             ENDIF
     
    419425             IF ( .NOT. ALLOCATED( q_av ) )  THEN
    420426                ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    421                 aver_q = .TRUE.
     427                do_average_q = .TRUE.
    422428                q_av = 0.0_wp
    423429             ENDIF
     
    425431             IF ( .NOT. ALLOCATED( u_av ) )  THEN
    426432                ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    427                 aver_u = .TRUE.
     433                do_average_u = .TRUE.
    428434                u_av = 0.0_wp
    429435             ENDIF
     
    431437             IF ( .NOT. ALLOCATED( v_av ) )  THEN
    432438                ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    433                 aver_v = .TRUE.
     439                do_average_v = .TRUE.
    434440                v_av = 0.0_wp
    435441             ENDIF
     
    437443             IF ( .NOT. ALLOCATED( w_av ) )  THEN
    438444                ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    439                 aver_w = .TRUE.
     445                do_average_w = .TRUE.
    440446                w_av = 0.0_wp
     447             ENDIF
     448
     449             IF ( .NOT. ALLOCATED( mrt_av_grid ) )  THEN
     450                ALLOCATE( mrt_av_grid(nmrtbl) )
     451                do_average_mrt = .TRUE.
     452                mrt_av_grid = 0.0_wp
    441453             ENDIF
    442454
     
    480492                RETURN
    481493
    482              IF ( ALLOCATED( pt_av ) .AND. aver_perct ) THEN
     494             IF ( ALLOCATED( pt_av ) .AND. do_average_theta ) THEN
    483495                DO  i = nxl, nxr
    484496                   DO  j = nys, nyn
     
    490502             ENDIF
    491503
    492              IF ( ALLOCATED( q_av )  .AND. aver_q ) THEN
     504             IF ( ALLOCATED( q_av )  .AND. do_average_q ) THEN
    493505                DO  i = nxl, nxr
    494506                   DO  j = nys, nyn
     
    500512             ENDIF
    501513
    502              IF ( ALLOCATED( u_av )  .AND. aver_u ) THEN
     514             IF ( ALLOCATED( u_av )  .AND. do_average_u ) THEN
    503515                DO  i = nxlg, nxrg       !< yes, ghost points are required here!
    504516                   DO  j = nysg, nyng
     
    510522             ENDIF
    511523
    512              IF ( ALLOCATED( v_av )  .AND. aver_v ) THEN
     524             IF ( ALLOCATED( v_av )  .AND. do_average_v ) THEN
    513525                DO  i = nxlg, nxrg       !< yes, ghost points are required here!
    514526                   DO  j = nysg, nyng
     
    520532             ENDIF
    521533
    522              IF ( ALLOCATED( w_av )  .AND. aver_w ) THEN
     534             IF ( ALLOCATED( w_av )  .AND. do_average_w ) THEN
    523535                DO  i = nxlg, nxrg       !< yes, ghost points are required here!
    524536                   DO  j = nysg, nyng
     
    528540                   ENDDO
    529541                ENDDO
     542             ENDIF
     543
     544             IF ( ALLOCATED( mrt_av_grid ) .AND. do_average_mrt )  THEN
     545
     546                IF ( mrt_include_sw )  THEN
     547                   mrt_av_grid(:) = mrt_av_grid(:) +                           &
     548                      (( human_absorb * mrtinsw(:) + human_emiss * mrtinlw(:)) &
     549                      / (human_emiss * sigma_sb)) ** .25_wp - degc_to_k
     550                ELSE
     551                   mrt_av_grid(:) = mrt_av_grid(:) +                           &
     552                      (human_emiss * mrtinlw(:) / sigma_sb) ** .25_wp          &
     553                      - degc_to_k
     554                ENDIF
    530555             ENDIF
    531556!
     
    564589                TRIM( variable ) /= 'bio_pet*' ) RETURN
    565590
    566              IF ( ALLOCATED( pt_av ) .AND. aver_perct ) THEN
     591             IF ( ALLOCATED( pt_av ) .AND. do_average_theta ) THEN
    567592                DO  i = nxl, nxr
    568593                   DO  j = nys, nyn
     
    575600             ENDIF
    576601
    577              IF ( ALLOCATED( q_av ) .AND. aver_q ) THEN
     602             IF ( ALLOCATED( q_av ) .AND. do_average_q ) THEN
    578603                DO  i = nxl, nxr
    579604                   DO  j = nys, nyn
     
    586611             ENDIF
    587612
    588              IF ( ALLOCATED( u_av ) .AND. aver_u ) THEN
     613             IF ( ALLOCATED( u_av ) .AND. do_average_u ) THEN
    589614                DO  i = nxlg, nxrg       !< yes, ghost points are required here!
    590615                   DO  j = nysg, nyng
     
    597622             ENDIF
    598623
    599              IF ( ALLOCATED( v_av ) .AND. aver_v ) THEN
     624             IF ( ALLOCATED( v_av ) .AND. do_average_v ) THEN
    600625                DO  i = nxlg, nxrg
    601626                   DO  j = nysg, nyng
     
    608633             ENDIF
    609634
    610              IF ( ALLOCATED( w_av ) .AND. aver_w ) THEN
     635             IF ( ALLOCATED( w_av ) .AND. do_average_w ) THEN
    611636                DO  i = nxlg, nxrg
    612637                   DO  j = nysg, nyng
     
    618643                ENDDO
    619644             ENDIF
     645
     646             IF ( ALLOCATED( mrt_av_grid ) .AND. do_average_mrt )  THEN
     647                mrt_av_grid(:) = mrt_av_grid(:) / REAL( average_count_3d, KIND=wp )
     648             ENDIF
     649
    620650!
    621651!--          Udate all thermal index grids with updated averaged input
     
    793823
    794824!------------------------------------------------------------------------------!
    795 !
    796825! Description:
    797826! ------------
     
    817846    CHARACTER (LEN=*), INTENT(OUT) ::  grid   !< Grid type (always "zu1" for biom)
    818847    LOGICAL, INTENT(OUT)           ::  found  !< Output found?
    819     LOGICAL, INTENT(OUT)           ::  two_d  !< Flag parameter that indicates 2D variables, horizontal cross sections, must be .TRUE.
     848    LOGICAL, INTENT(OUT)           ::  two_d  !< Flag parameter that indicates 2D variables,
     849                                              !< horizontal cross sections, must be .TRUE. for thermal indices and uv
    820850    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !< Temp. result grid to return
    821851!
     
    911941           END IF
    912942
    913            !
     943!
    914944!--    Before data is transfered to local_pf, transfer is it 2D dummy variable and exchange ghost points therein.
    915945!--    However, at this point this is only required for instantaneous arrays, time-averaged quantities are already exchanged.
     
    950980
    951981!------------------------------------------------------------------------------!
    952 !
    953982! Description:
    954983! ------------
     
    12111240! Description:
    12121241! ------------
     1242!> Soubroutine reads global biometeorology configuration from restart file(s)
     1243!------------------------------------------------------------------------------!
     1244 SUBROUTINE bio_rrd_global( found )
     1245
     1246    USE control_parameters,                                                    &
     1247        ONLY:  length, restart_string
     1248
     1249
     1250    IMPLICIT NONE
     1251
     1252    LOGICAL, INTENT(OUT) ::  found      !< variable found? yes = .T., no = .F.
     1253
     1254    found = .TRUE.
     1255
     1256
     1257    SELECT CASE ( restart_string(1:length) )
     1258
     1259!
     1260!--    read control flags to determine if input grids need to be averaged
     1261       CASE ( 'do_average_theta' )
     1262          READ ( 13 )  do_average_theta
     1263
     1264       CASE ( 'do_average_q' )
     1265          READ ( 13 )  do_average_q
     1266
     1267       CASE ( 'do_average_u' )
     1268          READ ( 13 )  do_average_u
     1269
     1270       CASE ( 'do_average_v' )
     1271          READ ( 13 )  do_average_v
     1272
     1273       CASE ( 'do_average_w' )
     1274          READ ( 13 )  do_average_w
     1275
     1276       CASE ( 'do_average_mrt' )
     1277          READ ( 13 )  do_average_mrt
     1278
     1279!
     1280!--    read control flags to determine which thermal index needs to trigger averaging
     1281       CASE ( 'average_trigger_perct' )
     1282          READ ( 13 )  average_trigger_perct
     1283
     1284       CASE ( 'average_trigger_utci' )
     1285          READ ( 13 )  average_trigger_utci
     1286
     1287       CASE ( 'average_trigger_pet' )
     1288          READ ( 13 )  average_trigger_pet
     1289
     1290
     1291       CASE DEFAULT
     1292
     1293          found = .FALSE.
     1294
     1295    END SELECT
     1296
     1297
     1298 END SUBROUTINE bio_rrd_global
     1299
     1300
     1301!------------------------------------------------------------------------------!
     1302! Description:
     1303! ------------
     1304!> Soubroutine reads local biometeorology configuration from restart file(s)
     1305!------------------------------------------------------------------------------!
     1306 SUBROUTINE bio_rrd_local( found )
     1307
     1308
     1309    USE control_parameters,                                                    &
     1310        ONLY:  length, restart_string
     1311
     1312
     1313    IMPLICIT NONE
     1314
     1315
     1316    LOGICAL, INTENT(OUT) ::  found      !< variable found? yes = .T., no = .F.
     1317
     1318    found = .TRUE.
     1319
     1320
     1321    SELECT CASE ( restart_string(1:length) )
     1322
     1323       CASE ( 'nmrtbl' )
     1324          READ ( 13 )  bio_nmrtbl
     1325
     1326       CASE ( 'mrt_av_grid' )
     1327          IF ( .NOT. ALLOCATED( mrt_av_grid ) )  THEN
     1328             ALLOCATE( mrt_av_grid(bio_nmrtbl) )
     1329          ENDIF
     1330          READ ( 13 )  mrt_av_grid
     1331
     1332
     1333       CASE DEFAULT
     1334
     1335          found = .FALSE.
     1336
     1337    END SELECT
     1338
     1339
     1340 END SUBROUTINE bio_rrd_local
     1341
     1342!------------------------------------------------------------------------------!
     1343! Description:
     1344! ------------
     1345!> Write global restart data for the biometeorology module.
     1346!------------------------------------------------------------------------------!
     1347 SUBROUTINE bio_wrd_global
     1348
     1349    IMPLICIT NONE
     1350
     1351    CALL wrd_write_string( 'do_average_theta' )
     1352    WRITE ( 14 )  do_average_theta
     1353    CALL wrd_write_string( 'do_average_q' )
     1354    WRITE ( 14 )  do_average_q
     1355    CALL wrd_write_string( 'do_average_u' )
     1356    WRITE ( 14 )  do_average_u
     1357    CALL wrd_write_string( 'do_average_v' )
     1358    WRITE ( 14 )  do_average_v
     1359    CALL wrd_write_string( 'do_average_w' )
     1360    WRITE ( 14 )  do_average_w
     1361    CALL wrd_write_string( 'do_average_mrt' )
     1362    WRITE ( 14 )  do_average_mrt
     1363    CALL wrd_write_string( 'average_trigger_perct' )
     1364    WRITE ( 14 )  average_trigger_perct
     1365    CALL wrd_write_string( 'average_trigger_utci' )
     1366    WRITE ( 14 )  average_trigger_utci
     1367    CALL wrd_write_string( 'average_trigger_pet' )
     1368    WRITE ( 14 )  average_trigger_pet
     1369
     1370 END SUBROUTINE bio_wrd_global
     1371
     1372
     1373!------------------------------------------------------------------------------!
     1374! Description:
     1375! ------------
     1376!> Write local restart data for the biometeorology module.
     1377!------------------------------------------------------------------------------!
     1378 SUBROUTINE bio_wrd_local
     1379
     1380    IMPLICIT NONE
     1381
     1382!
     1383!-- First nmrtbl has to be written/read, because it is the dimension of mrt_av_grid
     1384    CALL wrd_write_string( 'nmrtbl' )
     1385    WRITE ( 14 )  nmrtbl
     1386
     1387    IF ( ALLOCATED( mrt_av_grid ) )  THEN
     1388       CALL wrd_write_string( 'mrt_av_grid' )
     1389       WRITE ( 14 )  mrt_av_grid
     1390    ENDIF
     1391
     1392
     1393 END SUBROUTINE bio_wrd_local
     1394
     1395
     1396!------------------------------------------------------------------------------!
     1397! Description:
     1398! ------------
    12131399!> Calculate biometeorology MRT for all 2D grid
    12141400!------------------------------------------------------------------------------!
     
    12251411    INTEGER(iwp)                ::  l     !< Running index, radiation coordinates
    12261412
     1413
     1414    IF ( av ) THEN
     1415       IF ( .NOT. ALLOCATED( tmrt_av_grid ) )  THEN
     1416          ALLOCATE( tmrt_av_grid (nys:nyn,nxl:nxr) )
     1417       ENDIF
     1418
     1419       DO  l = 1, nmrtbl
     1420          i = mrtbl(ix,l)
     1421          j = mrtbl(iy,l)
     1422          k = mrtbl(iz,l)
     1423          IF ( k - get_topography_top_index_ji( j, i, 's' ) ==                 &
     1424                bio_cell_level + 1_iwp) THEN
     1425
     1426             tmrt_av_grid(j,i) = mrt_av_grid(l)
     1427
     1428          ENDIF
     1429       ENDDO
     1430
     1431    ELSE
     1432
    12271433!
    12281434!-- Calculate biometeorology MRT from local radiation fluxes calculated by RTM and assign
    12291435!-- into 2D grid. Depending on selected output quantities, tmrt_grid might not have been
    12301436!-- allocated in bio_check_data_output yet.
    1231     IF ( .NOT. ALLOCATED( tmrt_grid ) )  THEN
    1232        ALLOCATE( tmrt_grid (nys:nyn,nxl:nxr) )
    1233     ENDIF
    1234     tmrt_grid = REAL( bio_fill_value, KIND = wp )
    1235 
    1236     DO  l = 1, nmrtbl
    1237        i = mrtbl(ix,l)
    1238        j = mrtbl(iy,l)
    1239        k = mrtbl(iz,l)
    1240        IF ( k - get_topography_top_index_ji( j, i, 's' ) == bio_cell_level +   &
    1241              1_iwp) THEN
    1242           IF ( mrt_include_sw )  THEN
    1243               tmrt_grid(j,i) = ((human_absorb*mrtinsw(l) +                     &
    1244                                 human_emiss*mrtinlw(l))  /                     &
    1245                                (human_emiss*sigma_sb)) ** .25_wp - degc_to_k
    1246           ELSE
    1247               tmrt_grid(j,i) = (human_emiss*mrtinlw(l) / sigma_sb) ** .25_wp   &
    1248                                  - degc_to_k
     1437       IF ( .NOT. ALLOCATED( tmrt_grid ) )  THEN
     1438          ALLOCATE( tmrt_grid (nys:nyn,nxl:nxr) )
     1439       ENDIF
     1440       tmrt_grid = REAL( bio_fill_value, KIND = wp )
     1441
     1442       DO  l = 1, nmrtbl
     1443          i = mrtbl(ix,l)
     1444          j = mrtbl(iy,l)
     1445          k = mrtbl(iz,l)
     1446          IF ( k - get_topography_top_index_ji( j, i, 's' ) == bio_cell_level +   &
     1447                1_iwp) THEN
     1448             IF ( mrt_include_sw )  THEN
     1449                 tmrt_grid(j,i) = ((human_absorb*mrtinsw(l) +                     &
     1450                                   human_emiss*mrtinlw(l))  /                     &
     1451                                  (human_emiss*sigma_sb)) ** .25_wp - degc_to_k
     1452             ELSE
     1453                 tmrt_grid(j,i) = (human_emiss*mrtinlw(l) / sigma_sb) ** .25_wp   &
     1454                                    - degc_to_k
     1455             ENDIF
    12491456          ENDIF
    1250        ENDIF
    1251     ENDDO
     1457       ENDDO
     1458    ENDIF
    12521459
    12531460END SUBROUTINE bio_calculate_mrt_grid
     
    13421549!-- local mtr value at [i,j]
    13431550    tmrt = bio_fill_value  !< this can be a valid result (e.g. for inside some ostacle)
    1344     IF ( radiation ) THEN
     1551    IF ( .NOT. average_input ) THEN
    13451552!
    13461553!--    Use MRT from RTM precalculated in tmrt_grid
    13471554       tmrt = tmrt_grid(j,i)
     1555    ELSE
     1556       tmrt = tmrt_av_grid(j,i)
    13481557    ENDIF
    13491558
     
    14881697    REAL(wp), INTENT ( OUT ) ::  ipt    !< Instationary perceived temp.   (degree_C)
    14891698!
     1699!-- return immediatelly if nothing to do!
     1700    IF ( .NOT. thermal_comfort ) THEN
     1701        RETURN
     1702    ENDIF
     1703!
    14901704!-- If clo equals the initial value, this is the initial call
    14911705    IF ( clo <= -998._wp ) THEN
     
    15051719 END SUBROUTINE bio_calc_ipt
    15061720
    1507 !------------------------------------------------------------------------------!
    1508 ! Description:
    1509 ! ------------
    1510 !> Soubroutine reads global biometeorology configuration from restart file(s)
    1511 !------------------------------------------------------------------------------!
    1512  SUBROUTINE bio_rrd_global( found )
    1513 
    1514     USE control_parameters,                                                    &
    1515         ONLY:  length, restart_string
    1516 
    1517 
    1518     IMPLICIT NONE
    1519 
    1520     LOGICAL, INTENT(OUT) ::  found      !< variable found? yes = .T., no = .F.
    1521 
    1522     found = .TRUE.
    1523 
    1524 
    1525     SELECT CASE ( restart_string(1:length) )
    1526 
    1527 !
    1528 !--    read control flags to determine if input grids need to be averaged
    1529        CASE ( 'aver_perct' )
    1530           READ ( 13 )  aver_perct
    1531 
    1532        CASE ( 'aver_q' )
    1533           READ ( 13 )  aver_q
    1534 
    1535        CASE ( 'aver_u' )
    1536           READ ( 13 )  aver_u
    1537 
    1538        CASE ( 'aver_v' )
    1539           READ ( 13 )  aver_v
    1540 
    1541        CASE ( 'aver_w' )
    1542           READ ( 13 )  aver_w
    1543 !
    1544 !--    read control flags to determine which thermal index needs to trigger averaging
    1545        CASE ( 'average_trigger_perct' )
    1546           READ ( 13 )  average_trigger_perct
    1547 
    1548        CASE ( 'average_trigger_utci' )
    1549           READ ( 13 )  average_trigger_utci
    1550 
    1551        CASE ( 'average_trigger_pet' )
    1552           READ ( 13 )  average_trigger_pet
    1553 
    1554 
    1555        CASE DEFAULT
    1556 
    1557           found = .FALSE.
    1558 
    1559     END SELECT
    1560 
    1561 
    1562  END SUBROUTINE bio_rrd_global
    1563 
    1564 
    1565 !------------------------------------------------------------------------------!
    1566 ! Description:
    1567 ! ------------
    1568 !> Soubroutine reads local biometeorology configuration from restart file(s)
    1569 !------------------------------------------------------------------------------!
    1570  SUBROUTINE bio_rrd_local( found )
    1571 
    1572 
    1573     USE control_parameters,                                                    &
    1574         ONLY:  length, restart_string
    1575 
    1576 
    1577     IMPLICIT NONE
    1578 
    1579 
    1580     LOGICAL, INTENT(OUT) ::  found      !< variable found? yes = .T., no = .F.
    1581 
    1582     found = .TRUE.
    1583 
    1584 
    1585     SELECT CASE ( restart_string(1:length) )
    1586 
    1587        CASE ( 'nmrtbl' )
    1588           READ ( 13 )  bio_nmrtbl
    1589 
    1590        CASE ( 'mrt_av_grid' )
    1591           IF ( .NOT. ALLOCATED( mrt_av_grid ) )  THEN
    1592              ALLOCATE( mrt_av_grid(bio_nmrtbl) )
    1593           ENDIF
    1594           READ ( 13 )  mrt_av_grid
    1595 
    1596 
    1597        CASE DEFAULT
    1598 
    1599           found = .FALSE.
    1600 
    1601     END SELECT
    1602 
    1603 
    1604  END SUBROUTINE bio_rrd_local
    1605 
    1606 !------------------------------------------------------------------------------!
    1607 ! Description:
    1608 ! ------------
    1609 !> Write global restart data for the biometeorology module.
    1610 !------------------------------------------------------------------------------!
    1611  SUBROUTINE bio_wrd_global
    1612 
    1613     IMPLICIT NONE
    1614 
    1615     CALL wrd_write_string( 'aver_perct' )
    1616     WRITE ( 14 )  aver_perct
    1617     CALL wrd_write_string( 'aver_q' )
    1618     WRITE ( 14 )  aver_q
    1619     CALL wrd_write_string( 'aver_u' )
    1620     WRITE ( 14 )  aver_u
    1621     CALL wrd_write_string( 'aver_v' )
    1622     WRITE ( 14 )  aver_v
    1623     CALL wrd_write_string( 'aver_w' )
    1624     WRITE ( 14 )  aver_w
    1625     CALL wrd_write_string( 'average_trigger_perct' )
    1626     WRITE ( 14 )  average_trigger_perct
    1627     CALL wrd_write_string( 'average_trigger_utci' )
    1628     WRITE ( 14 )  average_trigger_utci
    1629     CALL wrd_write_string( 'average_trigger_pet' )
    1630     WRITE ( 14 )  average_trigger_pet
    1631 
    1632  END SUBROUTINE bio_wrd_global
    1633 
    1634 
    1635 !------------------------------------------------------------------------------!
    1636 ! Description:
    1637 ! ------------
    1638 !> Write local restart data for the biometeorology module.
    1639 !------------------------------------------------------------------------------!
    1640  SUBROUTINE bio_wrd_local
    1641 
    1642     IMPLICIT NONE
    1643 
    1644 !
    1645 !-- First nmrtbl has to be written/read, because it is the dimension of mrt_av_grid
    1646     CALL wrd_write_string( 'nmrtbl' )
    1647     WRITE ( 14 )  nmrtbl
    1648 
    1649     IF ( ALLOCATED( mrt_av_grid ) )  THEN
    1650        CALL wrd_write_string( 'mrt_av_grid' )
    1651        WRITE ( 14 )  mrt_av_grid
    1652     ENDIF
    1653 
    1654 
    1655  END SUBROUTINE bio_wrd_local
    16561721
    16571722
     
    16611726!> SUBROUTINE for calculating UTCI Temperature (UTCI)
    16621727!> computed by a 6th order approximation
    1663 !
     1728!>
    16641729!> UTCI regression equation after
    16651730!> Bröde P, Fiala D, Blazejczyk K, Holmér I, Jendritzky G, Kampmann B, Tinz B,
     
    16671732!> Climate Index (UTCI). International Journal of Biometeorology 56 (3):481-494.
    16681733!> doi:10.1007/s00484-011-0454-1
    1669 !
     1734!>
    16701735!> original source available at:
    16711736!> www.utci.org
     
    17281793!
    17291794!-- Wind altitude correction from hag to 10m after Broede et al. (2012), eq.3
    1730 !  z(0) is set to 0.01 according to UTCI profile definition
     1795!-- z(0) is set to 0.01 according to UTCI profile definition
    17311796    va = ws_hag *  log ( 10.0_wp / 0.01_wp ) / log ( hag / 0.01_wp )
    17321797!
     
    17491814!
    17501815!-- For routine application. For wind speeds and relative
    1751 !  humidity values below 0.5 m/s or 5%, respectively, the
    1752 !  user is advised to use the lower bounds for the calculations.
     1816!-- humidity values below 0.5 m/s or 5%, respectively, the
     1817!-- user is advised to use the lower bounds for the calculations.
    17531818    IF ( va < 0.5_wp ) va = 0.5_wp
    17541819    IF ( va > 17._wp ) va = 17._wp
     
    19882053       (  1.33374846e-03_wp ) * ta2 *                 pa4 +                    &
    19892054       (  3.55375387e-03_wp ) *       va  *           pa4 +                    &
    1990        ( -5.13027851e-04_wp ) * ta  * va *            pa4 +                    &
     2055       ( -5.13027851e-04_wp ) * ta  * va  *           pa4 +                    &
    19912056       (  1.02449757e-04_wp ) *       va2 *           pa4 +                    &
    19922057       ( -1.48526421e-03_wp ) *             d_tmrt  * pa4 +                    &
     
    20342099!
    20352100!-- Parameters for standard "Klima-Michel"
    2036     REAL(wp), PARAMETER :: eta = 0._wp  !< Mechanical work efficiency for walking on flat ground (compare to Fanger (1972) pp 24f)
    2037     REAL(wp), PARAMETER :: actlev = 134.6862_wp !< Workload by activity per standardized surface (A_Du)
     2101    REAL(wp), PARAMETER :: eta = 0._wp  !< Mechanical work efficiency for walking on flat ground
     2102                                        !< (compare to Fanger (1972) pp 24f)
     2103    REAL(wp), PARAMETER :: actlev = 134.6862_wp  !< Workload by activity per standardized surface (A_Du)
    20382104!
    20392105!-- Type of program variables
     
    20722138!-- Tresholds: clothing insulation (account for model inaccuracies)
    20732139!
    2074 !  summer clothing
     2140!-- summer clothing
    20752141    sclo     = 0.44453_wp
    20762142!
    2077 !  winter clothing
     2143!-- winter clothing
    20782144    wclo     = 1.76267_wp
    20792145!
     
    20962162!
    20972163!--          Case: comfort achievable by varying clothing insulation
    2098 !            Between winter and summer set values
     2164!--          Between winter and summer set values
    20992165             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta, sclo,      &
    21002166                pmv_s, wclo, pmv_w, eps, pmva, top, ncount, clo )
     
    21312197!
    21322198!--          Case: comfort achievable by varying clothing insulation
    2133 !            between winter and summer set values
     2199!--          between winter and summer set values
    21342200             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta, sclo,      &
    21352201                               pmv_s, wclo, pmv_w, eps, pmva, top, ncount, clo )
     
    21722238!
    21732239!--    Required clothing insulation (ireq) is exclusively defined for
    2174 !      operative temperatures (top) less 10 (C) for a
    2175 !      reference wind of 0.2 m/s according to 8.73 (C) for 0.1 m/s
     2240!--    operative temperatures (top) less 10 (C) for a
     2241!--    reference wind of 0.2 m/s according to 8.73 (C) for 0.1 m/s
    21762242       clon = ireq_neutral ( perct_ij, ireq_minimal, nerr )
    21772243       clo = clon
     
    22022268! Description:
    22032269! ------------
    2204 !> The SUBROUTINE calculates the saturation water vapour pressure
     2270!> The SUBROUTINE calculates the (saturation) water vapour pressure
    22052271!> (hPa = hecto Pascal) for a given temperature ta (degC).
    2206 !> For example, ta can be the air temperature or the dew point temperature.
     2272!> 'ta' can be the air temperature or the dew point temperature. The first will
     2273!> result in the current vapor pressure (hPa), the latter will calulate the
     2274!> saturation vapor pressure (hPa).
    22072275!------------------------------------------------------------------------------!
    22082276 SUBROUTINE saturation_vapor_pressure( ta, svp_ta )
     
    22112279
    22122280    REAL(wp), INTENT ( IN )  ::  ta     !< ambient air temperature (degC)
    2213     REAL(wp), INTENT ( OUT ) ::  svp_ta !< saturation water vapour pressure (hPa)
     2281    REAL(wp), INTENT ( OUT ) ::  svp_ta !< water vapour pressure (hPa)
    22142282
    22152283    REAL(wp)      ::  b
     
    22192287    IF ( ta < 0._wp ) THEN
    22202288!
    2221 !--    ta  < 0 (degC): saturation water vapour pressure over ice
     2289!--    ta  < 0 (degC): water vapour pressure over ice
    22222290       b = 17.84362_wp
    22232291       c = 245.425_wp
    22242292    ELSE
    22252293!
    2226 !--    ta >= 0 (degC): saturation water vapour pressure over water
     2294!--    ta >= 0 (degC): water vapour pressure over water
    22272295       b = 17.08085_wp
    22282296       c = 234.175_wp
     
    22482316!
    22492317!-- Input variables of argument list:
    2250     REAL(wp), INTENT ( IN )  :: ta     !< Ambient temperature (degC)
     2318    REAL(wp), INTENT ( IN )  :: ta       !< Ambient temperature (degC)
    22512319    REAL(wp), INTENT ( IN )  :: tmrt     !< Mean radiant temperature (degC)
    2252     REAL(wp), INTENT ( IN )  :: vp     !< Water vapour pressure (hPa)
    2253     REAL(wp), INTENT ( IN )  :: ws    !< Wind speed (m/s) 1 m above ground
    2254     REAL(wp), INTENT ( IN )  :: pair       !< Barometric pressure (hPa)
     2320    REAL(wp), INTENT ( IN )  :: vp       !< Water vapour pressure (hPa)
     2321    REAL(wp), INTENT ( IN )  :: ws       !< Wind speed (m/s) 1 m above ground
     2322    REAL(wp), INTENT ( IN )  :: pair     !< Barometric air pressure (hPa)
    22552323    REAL(wp), INTENT ( IN )  :: actlev   !< Individuals activity level per unit surface area (W/m2)
    22562324    REAL(wp), INTENT ( IN )  :: eta      !< Individuals work efficiency (dimensionless)
     
    22622330    REAL(wp), INTENT ( IN )  :: pmv_s    !< Fanger's PMV corresponding to sclo
    22632331!
    2264 ! Output variables of argument list:
     2332!-- Output variables of argument list:
    22652333    REAL(wp), INTENT ( OUT ) :: pmva     !< 0 (set to zero, because clo is evaluated for comfort)
    22662334    REAL(wp), INTENT ( OUT ) :: top      !< Operative temperature (degC) at found root of Fanger's PMV
    22672335    REAL(wp), INTENT ( OUT ) :: clo_res  !< Resulting clothing insulation value (clo)
    22682336    INTEGER(iwp), INTENT ( OUT ) :: nerr !< Error status / quality flag
    2269 !           nerr >= 0, o.k., and nerr is the number of iterations for
    2270 !                              convergence
    2271 !           nerr = -1: error = malfunction of Ridder's convergence method
    2272 !           nerr = -2: error = maximum iterations (max_iteration) exceeded
    2273 !           nerr = -3: error = root not bracketed between sclo and wclo
     2337                                         !< nerr >= 0, o.k., and nerr is the number of iterations for convergence
     2338                                         !< nerr = -1: error = malfunction of Ridder's convergence method
     2339                                         !< nerr = -2: error = maximum iterations (max_iteration) exceeded
     2340                                         !< nerr = -3: error = root not bracketed between sclo and wclo
    22742341!
    22752342!-- Type of program variables
     
    24282495!-- Output variables of argument list:
    24292496    REAL(wp), INTENT ( OUT ) ::  pmva    !< Actual Predicted Mean Vote (PMV,
    2430 !            dimensionless) according to Fanger corresponding to meteorological
    2431 !            (ta,tmrt,pa,ws,pair) and individual variables (clo, actlev, eta)
     2497                                         !< dimensionless) according to Fanger corresponding to meteorological
     2498                                         !< (ta,tmrt,pa,ws,pair) and individual variables (clo, actlev, eta)
    24322499    REAL(wp), INTENT ( OUT ) ::  top     !< operative temperature (degC)
    24332500!
     
    24472514    REAL(wp) ::  ws           !< wind speed                             (m/s)
    24482515    REAL(wp) ::  z1           !< Empiric factor for the adaption of the heat
    2449 !            ballance equation to the psycho-physical scale (Equ. 40 in FANGER)
     2516                              !< ballance equation to the psycho-physical scale (Equ. 40 in FANGER)
    24502517    REAL(wp) ::  z2           !< Water vapour diffution through the skin
    24512518    REAL(wp) ::  z3           !< Sweat evaporation from the skin surface
     
    24852552!
    24862553!-- Calculation of clothing surface temperature (t_clothing) based on
    2487 !  Newton-approximation with air temperature as initial guess
     2554!-- Newton-approximation with air temperature as initial guess
    24882555    t_clothing = ta
    24892556    DO i = 1, 3
     
    24932560!
    24942561!-- Empiric factor for the adaption of the heat ballance equation
    2495 !  to the psycho-physical scale (Equ. 40 in FANGER)
     2562!-- to the psycho-physical scale (Equ. 40 in FANGER)
    24962563    z1 = ( .303_wp * EXP ( -.036_wp * actlev ) + .0275_wp )
    24972564!
     
    25352602
    25362603    IMPLICIT NONE
     2604
    25372605!
    25382606!-- Input variables of argument list:
     
    25432611    REAL(wp),     INTENT ( IN )  :: tmrt     !< Mean radiant temperature (degC) at screen level
    25442612    REAL(wp),     INTENT ( IN )  :: ws       !< Wind speed (m/s) 1 m above ground
     2613
    25452614!
    25462615!-- Output variables of argument list:
    25472616    INTEGER(iwp), INTENT ( OUT ) :: nerr     !< Error status / quality flag
    2548 !             0 = o.k.
    2549 !            -2 = pmva outside valid regression range
    2550 !            -3 = rel. humidity set to 5 % or 95 %, respectively
    2551 !            -4 = deltapmv set to avoid pmvs < 0
    2552 !
    2553 !-- Internal variable types:
    2554     REAL(wp) ::  pmv          !<
    2555     REAL(wp) ::  pa_p50       !<
    2556     REAL(wp) ::  pa           !<
    2557     REAL(wp) ::  apa          !<
    2558     REAL(wp) ::  dapa         !<
    2559     REAL(wp) ::  sqvel        !<
    2560     REAL(wp) ::  dtmrt        !<
    2561     REAL(wp) ::  p10          !<
    2562     REAL(wp) ::  p95          !<
    2563     REAL(wp) ::  gew          !<
    2564     REAL(wp) ::  gew2         !<
     2617                                             !<  0 = o.k.
     2618                                             !< -2 = pmva outside valid regression range
     2619                                             !< -3 = rel. humidity set to 5 % or 95 %, respectively
     2620                                             !< -4 = deltapmv set to avoid pmvs < 0
     2621
     2622!
     2623!-- Internal variables:
     2624    REAL(wp) ::  pmv          !< temp storage og predicted mean vote
     2625    REAL(wp) ::  pa_p50       !< ratio actual water vapour pressure to that of relative humidity of 50 %
     2626    REAL(wp) ::  pa           !< vapor pressure (hPa) with hard bounds
     2627    REAL(wp) ::  apa          !< natural logarithm of pa (with hard lower border)
     2628    REAL(wp) ::  dapa         !< difference of apa and pa_p50
     2629    REAL(wp) ::  sqvel        !< square root of local wind velocity
     2630    REAL(wp) ::  dtmrt        !< difference mean radiation to air temperature
     2631    REAL(wp) ::  p10          !< lower bound for pa
     2632    REAL(wp) ::  p95          !< upper bound for pa
     2633    REAL(wp) ::  weight       !<
     2634    REAL(wp) ::  weight2      !<
    25652635    REAL(wp) ::  dpmv_1       !<
    25662636    REAL(wp) ::  dpmv_2       !<
     
    26572727    ENDIF
    26582728!
    2659 !-- Air temperature
    2660 !    ta = ta
    26612729!-- Difference mean radiation to air temperature
    26622730    dtmrt = tmrt - ta
     
    26702738       RETURN
    26712739    ENDIF
    2672     gew = MOD ( pmv, 1._wp )
    2673     IF ( gew < 0._wp ) gew = 0._wp
     2740    weight = MOD ( pmv, 1._wp )
     2741    IF ( weight < 0._wp ) weight = 0._wp
    26742742    IF ( nreg > 5_iwp ) THEN
    26752743       ! nreg=6
    26762744       nreg  = 5_iwp
    2677        gew   = pmv - 5._wp
    2678        gew2  = pmv - 6._wp
    2679        IF ( gew2 > 0_iwp ) THEN
    2680           gew = ( gew - gew2 ) / gew
     2745       weight   = pmv - 5._wp
     2746       weight2  = pmv - 6._wp
     2747       IF ( weight2 > 0_iwp ) THEN
     2748          weight = ( weight - weight2 ) / weight
    26812749       ENDIF
    26822750    ENDIF
     
    27092777!
    27102778!-- Calculate pmv modification
    2711     deltapmv = ( 1._wp - gew ) * dpmv_1 + gew * dpmv_2
     2779    deltapmv = ( 1._wp - weight ) * dpmv_1 + weight * dpmv_2
    27122780    pmvs = pmva + deltapmv
    27132781    IF ( ( pmvs ) < 0._wp ) THEN
     
    27462814!-- Additional output variables of argument list:
    27472815    REAL(wp), INTENT ( OUT ) ::  dperctm    !< Mean deviation perct (classical gt) to gt* (rational gt
    2748 !            calculated based on Gagge's rational PMV*)
     2816                                            !< calculated based on Gagge's rational PMV*)
    27492817    REAL(wp), INTENT ( OUT ) ::  dperctstd  !< dperctm plus its standard deviation times a factor
    2750 !            determining the significance to perceive sultriness
     2818                                            !< determining the significance to perceive sultriness
    27512819    REAL(wp), INTENT ( OUT ) ::  sultr_res
    27522820!
     
    27582826!
    27592827!-- Types of coefficients mean deviation plus standard deviation
    2760 !  regression coefficients: third order polynomial
     2828!-- regression coefficients: third order polynomial
    27612829    REAL(wp), PARAMETER ::  dperctsa = +0.0268918_wp
    27622830    REAL(wp), PARAMETER ::  dperctsb = +0.0465957_wp
     
    27652833!
    27662834!-- Factor to mean standard deviation defining SIGNificance for
    2767 !  sultriness
     2835!-- sultriness
    27682836    REAL(wp), PARAMETER :: faktor = 1._wp
    27692837!
     
    28142882    INTEGER(iwp), INTENT ( OUT ) ::  nerr !< Error indicator: 0 = o.k., +1 = denominator for intersection = 0
    28152883    REAL(wp),     INTENT ( OUT ) ::  dpmv_cold_res    !< Increment to adjust pmva according to the results of Gagge's
    2816 !              2 node model depending on the input
     2884                                                      !< 2 node model depending on the input
    28172885!
    28182886!-- Type of program variables
     
    28262894    REAL(wp) ::  sqrt_ws
    28272895    INTEGER(iwp) ::  i
    2828 !     INTEGER(iwp) ::  j
    28292896    INTEGER(iwp) ::  i_bin
    28302897!
     
    28392906!
    28402907!-- Initialise
    2841     nerr       = 0_iwp
     2908    nerr           = 0_iwp
    28422909    dpmv_cold_res  = 0._wp
    2843     pmvc       = pmva
    2844     dtmrt      = tmrt - ta
    2845     sqrt_ws   = ws
     2910    pmvc           = pmva
     2911    dtmrt          = tmrt - ta
     2912    sqrt_ws        = ws
    28462913    IF ( sqrt_ws < 0.10_wp ) THEN
    28472914       sqrt_ws = 0.10_wp
     
    28852952!
    28862953!-- Adjust to operative temperature scaled according
    2887 !  to classical PMV (Fanger)
     2954!-- to classical PMV (Fanger)
    28882955    dpmv_cold_res = delta_cold(i_bin) - dpmv_adj(pmva)
    28892956
     
    29092976    REAL(wp)      ::  pmv
    29102977    INTEGER(iwp)  ::  i, i_bin
    2911 
    2912 !                                   range_1        range_2        range_3
     2978!
     2979!--                                 range_1        range_2        range_3
    29132980    DATA (coef(i, 0), i = 1, n_bin) /0.0941540_wp, -0.1506620_wp, -0.0871439_wp/
    29142981    DATA (coef(i, 1), i = 1, n_bin) /0.0783162_wp, -1.0612651_wp,  0.1695040_wp/
     
    30113078!
    30123079!-- DuBois D, DuBois EF: A formula to estimate the approximate surface area if
    3013 !  height and weight be known. In: Arch. Int. Med.. 17, 1916, S. 863?871.
     3080!-- height and weight be known. In: Arch. Int. Med.. 17, 1916, S. 863?871.
    30143081    surf = 0.007184_wp * height**0.725_wp * weight**0.425_wp
    30153082    RETURN
     
    30333100!------------------------------------------------------------------------------!
    30343101 SUBROUTINE persdat ( age, weight, height, sex, work, a_surf, actlev )
    3035 !
     3102
    30363103    IMPLICIT NONE
    30373104
     
    31643231!
    31653232!--          Case: comfort achievable by varying clothing insulation
    3166 !            between winter and summer set values
     3233!--          between winter and summer set values
    31673234             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta , sclo,     &
    31683235                            pmv_s, wclo, pmv_w, eps, pmva, top, ncount, clo )
     
    32053272!
    32063273!--          Case: comfort achievable by varying clothing insulation
    3207 !            between winter and summer set values
     3274!--          between winter and summer set values
    32083275             CALL iso_ridder ( ta, tmrt, vp, ws, pair, actlev, eta, sclo,      &
    32093276                               pmv_s, wclo, pmv_w, eps, pmva, top, ncount, clo )
     
    32483315!
    32493316!--    Required clothing insulation (ireq) is exclusively defined for
    3250 !      operative temperatures (top) less 10 (C) for a
    3251 !      reference wind of 0.2 m/s according to 8.73 (C) for 0.1 m/s
     3317!--    operative temperatures (top) less 10 (C) for a
     3318!--    reference wind of 0.2 m/s according to 8.73 (C) for 0.1 m/s
    32523319       clon = ireq_neutral ( ipt, ireq_minimal, nerr )
    32533320       clo = clon
     
    33873454    REAL(wp), INTENT ( IN )  ::  pa       !< Vapour pressure          (hPa)
    33883455    REAL(wp), INTENT ( IN )  ::  pair     !< Air pressure             (hPa)
    3389     REAL(wp), INTENT ( IN )  ::  in_ws   !< Wind speed               (m/s)
     3456    REAL(wp), INTENT ( IN )  ::  in_ws    !< Wind speed               (m/s)
    33903457    REAL(wp), INTENT ( IN )  ::  actlev   !< Metabolic + work energy  (W/m²)
    33913458    REAL(wp), INTENT ( IN )  ::  dt       !< Timestep                 (s)
     
    34153482    REAL(wp) ::  ws           !< wind speed                             (m/s)
    34163483    REAL(wp) ::  z1           !< Empiric factor for the adaption of the heat
    3417 !            ballance equation to the psycho-physical scale (Equ. 40 in FANGER)
     3484                              !< ballance equation to the psycho-physical scale (Equ. 40 in FANGER)
    34183485    REAL(wp) ::  z2           !< Water vapour diffution through the skin
    34193486    REAL(wp) ::  z3           !< Sweat evaporation from the skin surface
     
    34273494
    34283495    INTEGER(iwp) :: i         !< running index
    3429     INTEGER(iwp) ::  niter  !< Running index
     3496    INTEGER(iwp) ::  niter    !< Running index
    34303497
    34313498!
     
    34573524!
    34583525!-- Calculation of clothing surface temperature (t_clothing) based on
    3459 !  newton-approximation with air temperature as initial guess
     3526!-- newton-approximation with air temperature as initial guess
    34603527    niter = INT( dt * 10._wp, KIND=iwp )
    34613528    IF ( niter < 1 ) niter = 1_iwp
     
    34793546!
    34803547!-- Empiric factor for the adaption of the heat ballance equation
    3481 !  to the psycho-physical scale (Equ. 40 in FANGER)
     3548!-- to the psycho-physical scale (Equ. 40 in FANGER)
    34823549    z1 = ( .303_wp * EXP ( -.036_wp * actlev ) + .0275_wp )
    34833550!
     
    36173684    REAL(wp), INTENT( OUT ) ::  int_heat  !< internal heat production (W)
    36183685    REAL(wp), INTENT( OUT ) ::  rtv       !< respiratory volume
    3619 !
    3620 !-- Constants:
    3621 !     REAL(wp), PARAMETER :: cair = 1010._wp        !< replaced by c_p
    3622 !     REAL(wp), PARAMETER :: evap = 2.42_wp * 10._wp **6._wp  !< replaced by l_v
    36233686!
    36243687!-- Internal variables:
Note: See TracChangeset for help on using the changeset viewer.