Changeset 3650 for palm/trunk/SOURCE
- Timestamp:
- Jan 4, 2019 1:01:33 PM (6 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
biometeorology_mod.f90 (modified) (14 diffs)
-
module_interface.f90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/biometeorology_mod.f90
r3646 r3650 15 15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 16 16 ! 17 ! Copyright 2018-201 8Deutscher Wetterdienst (DWD)18 ! Copyright 2018-201 8Institute of Computer Science, Academy of Sciences, Prague19 ! Copyright 2018-201 8Leibniz Universitaet Hannover17 ! Copyright 2018-2019 Deutscher Wetterdienst (DWD) 18 ! Copyright 2018-2019 Institute of Computer Science, Academy of Sciences, Prague 19 ! Copyright 2018-2019 Leibniz Universitaet Hannover 20 20 !--------------------------------------------------------------------------------! 21 21 ! … … 27 27 ! ----------------- 28 28 ! $Id$ 29 ! Bugfixes and additions for enabling restarts with biometeorology 30 ! 31 ! 3646 2018-12-28 17:58:49Z kanani 29 32 ! Remove check for simulated_time > 0, it is not required since biometeorology 30 33 ! is only called from time_integration and not during time_integration_spinup … … 180 183 ! 181 184 !-- Declare all global variables within the module (alphabetical order) 185 INTEGER(iwp) :: bio_nmrtbl 182 186 INTEGER(iwp) :: ai = 0 !< loop index in azimuth direction 183 187 INTEGER(iwp) :: bi = 0 !< loop index of bit location within an 8bit-integer (one Byte) … … 234 238 bio_init, bio_parin, bio_perct, bio_perct_av, bio_pet, & 235 239 bio_pet_av, bio_utci, bio_utci_av, thermal_comfort, time_bio_results, & 240 bio_nmrtbl, bio_wrd_local, bio_rrd_local, bio_wrd_global, bio_rrd_global 236 241 ! 237 242 !-- UVEM PUBLIC variables and methods 238 uvem_calc_exposure, uv_exposure243 PUBLIC uvem_calc_exposure, uv_exposure 239 244 240 245 ! … … 305 310 MODULE PROCEDURE bio_parin 306 311 END INTERFACE bio_parin 307 312 ! 313 !-- Read global restart parameters 314 INTERFACE bio_rrd_global 315 MODULE PROCEDURE bio_rrd_global 316 END INTERFACE bio_rrd_global 317 ! 318 !-- Read local restart parameters 319 INTERFACE bio_rrd_local 320 MODULE PROCEDURE bio_rrd_local 321 END INTERFACE bio_rrd_local 322 ! 323 !-- Write global restart parameters 324 INTERFACE bio_wrd_global 325 MODULE PROCEDURE bio_wrd_global 326 END INTERFACE bio_wrd_global 327 ! 328 !-- Write local restart parameters 329 INTERFACE bio_wrd_local 330 MODULE PROCEDURE bio_wrd_local 331 END INTERFACE bio_wrd_local 308 332 ! 309 333 !-- Calculate UV exposure grid … … 363 387 .NOT. average_trigger_utci .AND. & 364 388 .NOT. average_trigger_pet ) THEN 365 !366 !-- Allocate the required grids367 IF ( .NOT. ALLOCATED( perct_av ) ) THEN368 ALLOCATE( perct_av (nys:nyn,nxl:nxr) )369 ENDIF370 perct_av = REAL( bio_fill_value, KIND = wp )371 372 IF ( .NOT. ALLOCATED( utci_av ) ) THEN373 ALLOCATE( utci_av (nys:nyn,nxl:nxr) )374 ENDIF375 utci_av = REAL( bio_fill_value, KIND = wp )376 377 IF ( .NOT. ALLOCATED( pet_av ) ) THEN378 ALLOCATE( pet_av (nys:nyn,nxl:nxr) )379 ENDIF380 pet_av = REAL( bio_fill_value, KIND = wp )381 389 ! 382 390 !-- Memorize the first index called to control averaging … … 401 409 ! modules. Set averaging switch to .TRUE. in that case. 402 410 IF ( .NOT. ALLOCATED( pt_av ) ) THEN 403 ALLOCATE( pt_av(nzb:nzt+1,nys :nyn,nxl:nxr) )411 ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 404 412 aver_perct = .TRUE. 405 413 pt_av = 0.0_wp … … 407 415 408 416 IF ( .NOT. ALLOCATED( q_av ) ) THEN 409 ALLOCATE( q_av(nzb:nzt+1,nys :nyn,nxl:nxr) )417 ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 410 418 aver_q = .TRUE. 411 419 q_av = 0.0_wp … … 646 654 ! 647 655 !-- Allocate a temporary array with the desired output dimensions. 656 !-- Arrays for time-averaged thermal indices are also allocated here because they are not running 657 !-- through the standard averaging procedure in bio_3d_data_averaging as the values of the 658 !-- averaged thermal indices are derived in a single step based on priorly averaged arrays 659 !-- (see bio_calculate_thermal_index_maps). 648 660 CASE ( 'bio_mrt' ) 649 661 unit = 'degree_C' 650 662 IF ( .NOT. ALLOCATED( tmrt_grid ) ) THEN 651 663 ALLOCATE( tmrt_grid (nys:nyn,nxl:nxr) ) 664 tmrt_grid = REAL( bio_fill_value, KIND = wp ) 652 665 ENDIF 653 tmrt_grid = REAL( bio_fill_value, KIND = wp )654 666 655 667 CASE ( 'bio_perct*' ) … … 657 669 IF ( .NOT. ALLOCATED( perct ) ) THEN 658 670 ALLOCATE( perct (nys:nyn,nxl:nxr) ) 671 perct = REAL( bio_fill_value, KIND = wp ) 659 672 ENDIF 660 perct = REAL( bio_fill_value, KIND = wp ) 673 IF ( .NOT. ALLOCATED( perct_av ) ) THEN 674 ALLOCATE( perct_av (nys:nyn,nxl:nxr) ) 675 perct_av = REAL( bio_fill_value, KIND = wp ) 676 ENDIF 661 677 662 678 CASE ( 'bio_utci*' ) … … 664 680 IF ( .NOT. ALLOCATED( utci ) ) THEN 665 681 ALLOCATE( utci (nys:nyn,nxl:nxr) ) 682 utci = REAL( bio_fill_value, KIND = wp ) 666 683 ENDIF 667 utci = REAL( bio_fill_value, KIND = wp ) 684 IF ( .NOT. ALLOCATED( utci_av ) ) THEN 685 ALLOCATE( utci_av (nys:nyn,nxl:nxr) ) 686 utci_av = REAL( bio_fill_value, KIND = wp ) 687 ENDIF 668 688 669 689 CASE ( 'bio_pet*' ) … … 671 691 IF ( .NOT. ALLOCATED( pet ) ) THEN 672 692 ALLOCATE( pet (nys:nyn,nxl:nxr) ) 693 pet = REAL( bio_fill_value, KIND = wp ) 673 694 ENDIF 674 pet = REAL( bio_fill_value, KIND = wp ) 695 IF ( .NOT. ALLOCATED( pet_av ) ) THEN 696 ALLOCATE( pet_av (nys:nyn,nxl:nxr) ) 697 pet_av = REAL( bio_fill_value, KIND = wp ) 698 ENDIF 699 675 700 676 701 CASE ( 'uvem_vitd3*' ) … … 1110 1135 ! 1111 1136 !-- Init UVEM and load lookup tables 1112 CALL netcdf_data_input_uvem1137 IF ( uv_exposure ) CALL netcdf_data_input_uvem 1113 1138 1114 1139 END SUBROUTINE bio_init … … 1472 1497 1473 1498 END SUBROUTINE bio_calc_ipt 1499 1500 !------------------------------------------------------------------------------! 1501 ! Description: 1502 ! ------------ 1503 !> Soubroutine reads global biometeorology configuration from restart file(s) 1504 !------------------------------------------------------------------------------! 1505 SUBROUTINE bio_rrd_global( found ) 1506 1507 USE control_parameters, & 1508 ONLY: length, restart_string 1509 1510 1511 IMPLICIT NONE 1512 1513 LOGICAL, INTENT(OUT) :: found !< variable found? yes = .T., no = .F. 1514 1515 found = .TRUE. 1516 1517 1518 SELECT CASE ( restart_string(1:length) ) 1519 1520 ! 1521 !-- read control flags to determine if input grids need to be averaged 1522 CASE ( 'aver_perct' ) 1523 READ ( 13 ) aver_perct 1524 1525 CASE ( 'aver_q' ) 1526 READ ( 13 ) aver_q 1527 1528 CASE ( 'aver_u' ) 1529 READ ( 13 ) aver_u 1530 1531 CASE ( 'aver_v' ) 1532 READ ( 13 ) aver_v 1533 1534 CASE ( 'aver_w' ) 1535 READ ( 13 ) aver_w 1536 ! 1537 !-- read control flags to determine which thermal index needs to trigger averaging 1538 CASE ( 'average_trigger_perct' ) 1539 READ ( 13 ) average_trigger_perct 1540 1541 CASE ( 'average_trigger_utci' ) 1542 READ ( 13 ) average_trigger_utci 1543 1544 CASE ( 'average_trigger_pet' ) 1545 READ ( 13 ) average_trigger_pet 1546 1547 1548 CASE DEFAULT 1549 1550 found = .FALSE. 1551 1552 END SELECT 1553 1554 1555 END SUBROUTINE bio_rrd_global 1556 1557 1558 !------------------------------------------------------------------------------! 1559 ! Description: 1560 ! ------------ 1561 !> Soubroutine reads local biometeorology configuration from restart file(s) 1562 !------------------------------------------------------------------------------! 1563 SUBROUTINE bio_rrd_local( found ) 1564 1565 1566 USE control_parameters, & 1567 ONLY: length, restart_string 1568 1569 1570 IMPLICIT NONE 1571 1572 1573 LOGICAL, INTENT(OUT) :: found !< variable found? yes = .T., no = .F. 1574 1575 found = .TRUE. 1576 1577 1578 SELECT CASE ( restart_string(1:length) ) 1579 1580 CASE ( 'nmrtbl' ) 1581 READ ( 13 ) bio_nmrtbl 1582 1583 CASE ( 'mrt_av_grid' ) 1584 IF ( .NOT. ALLOCATED( mrt_av_grid ) ) THEN 1585 ALLOCATE( mrt_av_grid(bio_nmrtbl) ) 1586 ENDIF 1587 READ ( 13 ) mrt_av_grid 1588 1589 1590 CASE DEFAULT 1591 1592 found = .FALSE. 1593 1594 END SELECT 1595 1596 1597 END SUBROUTINE bio_rrd_local 1598 1599 !------------------------------------------------------------------------------! 1600 ! Description: 1601 ! ------------ 1602 !> Write global restart data for the biometeorology module. 1603 !------------------------------------------------------------------------------! 1604 SUBROUTINE bio_wrd_global 1605 1606 IMPLICIT NONE 1607 1608 CALL wrd_write_string( 'aver_perct' ) 1609 WRITE ( 14 ) aver_perct 1610 CALL wrd_write_string( 'aver_q' ) 1611 WRITE ( 14 ) aver_q 1612 CALL wrd_write_string( 'aver_u' ) 1613 WRITE ( 14 ) aver_u 1614 CALL wrd_write_string( 'aver_v' ) 1615 WRITE ( 14 ) aver_v 1616 CALL wrd_write_string( 'aver_w' ) 1617 WRITE ( 14 ) aver_w 1618 CALL wrd_write_string( 'average_trigger_perct' ) 1619 WRITE ( 14 ) average_trigger_perct 1620 CALL wrd_write_string( 'average_trigger_utci' ) 1621 WRITE ( 14 ) average_trigger_utci 1622 CALL wrd_write_string( 'average_trigger_pet' ) 1623 WRITE ( 14 ) average_trigger_pet 1624 1625 END SUBROUTINE bio_wrd_global 1626 1627 1628 !------------------------------------------------------------------------------! 1629 ! Description: 1630 ! ------------ 1631 !> Write local restart data for the biometeorology module. 1632 !------------------------------------------------------------------------------! 1633 SUBROUTINE bio_wrd_local 1634 1635 IMPLICIT NONE 1636 1637 ! 1638 !-- First nmrtbl has to be written/read, because it is the dimension of mrt_av_grid 1639 CALL wrd_write_string( 'nmrtbl' ) 1640 WRITE ( 14 ) nmrtbl 1641 1642 IF ( ALLOCATED( mrt_av_grid ) ) THEN 1643 CALL wrd_write_string( 'mrt_av_grid' ) 1644 WRITE ( 14 ) mrt_av_grid 1645 ENDIF 1646 1647 1648 END SUBROUTINE bio_wrd_local 1474 1649 1475 1650 -
palm/trunk/SOURCE/module_interface.f90
r3649 r3650 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Add restart routines for biometeorology 28 ! 29 ! 3649 2019-01-02 16:52:21Z suehring 27 30 ! Initialize strings, in order to avoid compiler warnings for non-initialized 28 31 ! characters with intent(out) attribute … … 75 78 bio_3d_data_averaging, & 76 79 bio_data_output_2d, & 77 bio_data_output_3d 80 bio_data_output_3d, & 81 bio_rrd_global, & 82 bio_rrd_local, & 83 bio_wrd_global, & 84 bio_wrd_local 78 85 79 86 USE bulk_cloud_model_mod, & … … 552 559 CHARACTER (LEN=*), INTENT(OUT) :: grid_z !< netcdf dimension in z-direction 553 560 ! 554 !--As long as no action is done in this subroutine, initial strings with561 !--As long as no action is done in this subroutine, initialize strings with 555 562 !--intent(out) attribute, in order to avoid compiler warnings. 556 563 found = .FALSE. … … 878 885 LOGICAL, INTENT(OUT) :: found !< flag if variable was found 879 886 887 IF ( .NOT. found ) CALL bio_rrd_global( found ) ! ToDo: change interface to pass variable 880 888 IF ( .NOT. found ) CALL bcm_rrd_global( found ) ! ToDo: change interface to pass variable 881 889 IF ( .NOT. found ) CALL flight_rrd_global( found ) ! ToDo: change interface to pass variable … … 899 907 900 908 909 IF ( biometeorology ) CALL bio_wrd_global 901 910 IF ( bulk_cloud_model ) CALL bcm_wrd_global 902 911 IF ( virtual_flight ) CALL flight_wrd_global … … 946 955 947 956 957 IF ( .NOT. found ) CALL bio_rrd_local( & 958 found & 959 ) 960 948 961 IF ( .NOT. found ) CALL bcm_rrd_local( & 949 962 file_index, map_index, & … … 1039 1052 1040 1053 1054 IF ( biometeorology ) CALL bio_wrd_local 1041 1055 IF ( bulk_cloud_model ) CALL bcm_wrd_local 1042 1056 IF ( air_chemistry ) CALL chem_wrd_local
Note: See TracChangeset
for help on using the changeset viewer.
