Changeset 3650


Ignore:
Timestamp:
Jan 4, 2019 1:01:33 PM (3 years ago)
Author:
kanani
Message:

Bugfix/additions to enable restarts with biometeorology (biometeorology_mod, module_interface)

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

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

    r3646 r3650  
    1515! PALM. If not, see <http://www.gnu.org/licenses/>.
    1616!
    17 ! Copyright 2018-2018 Deutscher Wetterdienst (DWD)
    18 ! Copyright 2018-2018 Institute of Computer Science, Academy of Sciences, Prague
    19 ! Copyright 2018-2018 Leibniz Universitaet Hannover
     17! 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
    2020!--------------------------------------------------------------------------------!
    2121!
     
    2727! -----------------
    2828! $Id$
     29! Bugfixes and additions for enabling restarts with biometeorology
     30!
     31! 3646 2018-12-28 17:58:49Z kanani
    2932! Remove check for simulated_time > 0, it is not required since biometeorology
    3033! is only called from time_integration and not during time_integration_spinup
     
    180183!
    181184!-- Declare all global variables within the module (alphabetical order)
     185    INTEGER(iwp) ::  bio_nmrtbl
    182186    INTEGER(iwp) ::  ai                      = 0  !< loop index in azimuth direction
    183187    INTEGER(iwp) ::  bi                      = 0  !< loop index of bit location within an 8bit-integer (one Byte)
     
    234238    bio_init, bio_parin, bio_perct, bio_perct_av, bio_pet,                     &
    235239    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
    236241!
    237242!-- UVEM PUBLIC variables and methods
    238     uvem_calc_exposure, uv_exposure
     243    PUBLIC uvem_calc_exposure, uv_exposure
    239244
    240245!
     
    305310       MODULE PROCEDURE bio_parin
    306311    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
    308332!
    309333!-- Calculate UV exposure grid
     
    363387                  .NOT. average_trigger_utci  .AND.                            &
    364388                  .NOT. average_trigger_pet ) THEN
    365 !
    366 !--             Allocate the required grids
    367                 IF ( .NOT. ALLOCATED( perct_av ) ) THEN
    368                    ALLOCATE( perct_av (nys:nyn,nxl:nxr) )
    369                 ENDIF
    370                 perct_av = REAL( bio_fill_value, KIND = wp )
    371 
    372                 IF ( .NOT. ALLOCATED( utci_av ) ) THEN
    373                    ALLOCATE( utci_av (nys:nyn,nxl:nxr) )
    374                 ENDIF
    375                 utci_av = REAL( bio_fill_value, KIND = wp )
    376 
    377                 IF ( .NOT. ALLOCATED( pet_av ) ) THEN
    378                    ALLOCATE( pet_av (nys:nyn,nxl:nxr) )
    379                 ENDIF
    380                 pet_av = REAL( bio_fill_value, KIND = wp )
    381389!
    382390!--             Memorize the first index called to control averaging
     
    401409!            modules. Set averaging switch to .TRUE. in that case.
    402410             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) )
    404412                aver_perct = .TRUE.
    405413                pt_av = 0.0_wp
     
    407415
    408416             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) )
    410418                aver_q = .TRUE.
    411419                q_av = 0.0_wp
     
    646654!
    647655!-- 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).
    648660       CASE ( 'bio_mrt' )
    649661          unit = 'degree_C'
    650662          IF ( .NOT. ALLOCATED( tmrt_grid ) )  THEN
    651663             ALLOCATE( tmrt_grid (nys:nyn,nxl:nxr) )
     664             tmrt_grid = REAL( bio_fill_value, KIND = wp )
    652665          ENDIF
    653           tmrt_grid = REAL( bio_fill_value, KIND = wp )
    654666
    655667       CASE ( 'bio_perct*' )
     
    657669          IF ( .NOT. ALLOCATED( perct ) )  THEN
    658670             ALLOCATE( perct (nys:nyn,nxl:nxr) )
     671             perct = REAL( bio_fill_value, KIND = wp )
    659672          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
    661677
    662678       CASE ( 'bio_utci*' )
     
    664680          IF ( .NOT. ALLOCATED( utci ) )  THEN
    665681             ALLOCATE( utci (nys:nyn,nxl:nxr) )
     682             utci = REAL( bio_fill_value, KIND = wp )
    666683          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
    668688
    669689       CASE ( 'bio_pet*' )
     
    671691          IF ( .NOT. ALLOCATED( pet ) )  THEN
    672692             ALLOCATE( pet (nys:nyn,nxl:nxr) )
     693             pet = REAL( bio_fill_value, KIND = wp )
    673694          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
    675700
    676701       CASE ( 'uvem_vitd3*' )
     
    11101135!
    11111136!-- Init UVEM and load lookup tables
    1112     CALL netcdf_data_input_uvem
     1137    IF ( uv_exposure )  CALL netcdf_data_input_uvem
    11131138
    11141139 END SUBROUTINE bio_init
     
    14721497
    14731498 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
    14741649
    14751650
  • palm/trunk/SOURCE/module_interface.f90

    r3649 r3650  
    2525! -----------------
    2626! $Id$
     27! Add restart routines for biometeorology
     28!
     29! 3649 2019-01-02 16:52:21Z suehring
    2730! Initialize strings, in order to avoid compiler warnings for non-initialized
    2831! characters with intent(out) attribute
     
    7578              bio_3d_data_averaging,                                           &
    7679              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
    7885
    7986   USE bulk_cloud_model_mod,                                                   &
     
    552559   CHARACTER (LEN=*), INTENT(OUT) ::  grid_z !< netcdf dimension in z-direction
    553560!
    554 !--As long as no action is done in this subroutine, initial strings with   
     561!--As long as no action is done in this subroutine, initialize strings with   
    555562!--intent(out) attribute, in order to avoid compiler warnings.
    556563   found  = .FALSE.
     
    878885   LOGICAL,           INTENT(OUT) ::  found    !< flag if variable was found
    879886
     887   IF ( .NOT. found )  CALL bio_rrd_global( found ) ! ToDo: change interface to pass variable
    880888   IF ( .NOT. found )  CALL bcm_rrd_global( found ) ! ToDo: change interface to pass variable
    881889   IF ( .NOT. found )  CALL flight_rrd_global( found ) ! ToDo: change interface to pass variable
     
    899907
    900908
     909   IF ( biometeorology )       CALL bio_wrd_global
    901910   IF ( bulk_cloud_model )     CALL bcm_wrd_global
    902911   IF ( virtual_flight )       CALL flight_wrd_global
     
    946955
    947956
     957   IF ( .NOT. found ) CALL bio_rrd_local(                                      &
     958                              found                                            &
     959                           )
     960
    948961   IF ( .NOT. found ) CALL bcm_rrd_local(                                      &
    949962                              file_index, map_index,                           &
     
    10391052
    10401053
     1054   IF ( biometeorology )       CALL bio_wrd_local
    10411055   IF ( bulk_cloud_model )     CALL bcm_wrd_local
    10421056   IF ( air_chemistry )        CALL chem_wrd_local
Note: See TracChangeset for help on using the changeset viewer.