Changeset 1826 for palm/trunk


Ignore:
Timestamp:
Apr 7, 2016 12:01:39 PM (9 years ago)
Author:
maronga
Message:

further modularization of radiation model and plant canopy model

Location:
palm/trunk
Files:
9 edited
2 moved

Legend:

Unmodified
Added
Removed
  • palm/trunk/SCRIPTS/mbuild

    r1818 r1826  
    2222# Current revisions:
    2323# ------------------
    24 #
     24# Added note that the script does not work on MAC OS
    2525#
    2626# Former revisions:
     
    119119# Procedure to compile code on local and remote hosts using the
    120120# make-mechanism. The source code must be provided on the local host.
     121#
     122# @note This script does not work on MAC OS
    121123#--------------------------------------------------------------------------------#
    122124
  • palm/trunk/SOURCE/Makefile

    r1823 r1826  
    2020# Current revisions:
    2121# ------------------
    22 #
     22# Renamed radiation_model to radiation_model_mod.
     23# Renamed plant_canopy_model to plant_canopy_model_mod.
    2324#
    2425# Former revisions:
     
    278279        ls_forcing.f90 message.f90 microphysics.f90 modules.f90 mod_kinds.f90 \
    279280        mod_particle_attributes.f90 netcdf_interface.f90 nudging.f90 \
    280         package_parin.f90 palm.f90 parin.f90 plant_canopy_model.f90 pmc_interface.f90 \
     281        package_parin.f90 palm.f90 parin.f90 plant_canopy_model_mod.f90 pmc_interface.f90 \
    281282        pmc_client.f90 pmc_general.f90 pmc_handle_communicator.f90 pmc_mpi_wrapper.f90 \
    282283        pmc_server.f90 \
    283284        poisfft.f90 poismg.f90 \
    284285        poismg_fast.f90 pres.f90 print_1d.f90 production_e.f90 \
    285         prognostic_equations.f90 progress_bar.f90 radiation_model.f90 \
     286        prognostic_equations.f90 progress_bar.f90 radiation_model_mod.f90 \
    286287        random_function.f90 random_gauss.f90 random_generator_parallel.f90 \
    287288        read_3d_binary.f90 read_var_list.f90 run_control.f90 \
     
    347348advec_w_up.o: modules.o mod_kinds.o
    348349average_3d_data.o: modules.o cpulog.o mod_kinds.o land_surface_model_mod.o\
    349                    radiation_model.o
     350                   radiation_model_mod.o
    350351boundary_conds.o: modules.o mod_kinds.o
    351352buoyancy.o: modules.o mod_kinds.o
     
    356357check_open.o: modules.o mod_kinds.o mod_particle_attributes.o netcdf_interface.o
    357358check_parameters.o: modules.o mod_kinds.o land_surface_model_mod.o \
    358         netcdf_interface.o plant_canopy_model.o pmc_interface.o radiation_model.o \
     359        netcdf_interface.o plant_canopy_model_mod.o pmc_interface.o radiation_model_mod.o \
    359360        subsidence.o
    360361close_file.o: modules.o mod_kinds.o netcdf_interface.o
     
    375376data_output_tseries.o: modules.o cpulog.o mod_kinds.o netcdf_interface.o
    376377data_output_2d.o: modules.o cpulog.o mod_kinds.o mod_particle_attributes.o\
    377    netcdf_interface.o land_surface_model_mod.o radiation_model.o
     378   netcdf_interface.o land_surface_model_mod.o radiation_model_mod.o
    378379data_output_3d.o: modules.o cpulog.o mod_kinds.o mod_particle_attributes.o\
    379380   netcdf_interface.o land_surface_model_mod.o
     
    392393fft_xy.o: cuda_fft_interfaces.o modules.o mod_kinds.o singleton.o temperton_fft.o
    393394flow_statistics.o: modules.o cpulog.o mod_kinds.o land_surface_model_mod.o\
    394    netcdf_interface.o radiation_model.o
     395   netcdf_interface.o radiation_model_mod.o
    395396global_min_max.o: modules.o mod_kinds.o
    396397header.o: modules.o cpulog.o mod_kinds.o netcdf_interface.o land_surface_model_mod.o\
    397    plant_canopy_model.o pmc_handle_communicator.o pmc_interface.o \
    398    radiation_model.o spectrum.o subsidence.o
     398plant_canopy_model_mod.o pmc_handle_communicator.o pmc_interface.o \
     399   radiation_model_mod.o spectrum.o subsidence.o
    399400inflow_turbulence.o: modules.o cpulog.o mod_kinds.o
    400401init_1d_model.o: modules.o mod_kinds.o
    401402init_3d_model.o: modules.o mod_kinds.o advec_ws.o cpulog.o land_surface_model_mod.o \
    402    lpm_init.o ls_forcing.o netcdf_interface.o plant_canopy_model.o \
    403    radiation_model.o random_function.o random_generator_parallel.o \
     403   lpm_init.o ls_forcing.o netcdf_interface.o plant_canopy_model_mod.o \
     404   radiation_model_mod.o random_function.o random_generator_parallel.o \
    404405        surface_layer_fluxes.o
    405406init_advec.o: modules.o mod_kinds.o
     
    415416init_slope.o: modules.o mod_kinds.o
    416417interaction_droplets_ptq.o: modules.o mod_kinds.o
    417 land_surface_model_mod.o: modules.o mod_kinds.o radiation_model.o
     418land_surface_model_mod.o: modules.o mod_kinds.o radiation_model_mod.o
    418419local_stop.o: modules.o mod_kinds.o pmc_interface.o
    419420local_tremain.o: modules.o cpulog.o mod_kinds.o
     
    454455   land_surface_model_mod.o spectrum.o
    455456nudging.o: modules.o cpulog.o mod_kinds.o
    456 package_parin.o: modules.o mod_kinds.o \
    457    plant_canopy_model.o radiation_model.o spectrum.o
     457package_parin.o: modules.o mod_kinds.o spectrum.o
    458458palm.o: modules.o cpulog.o ls_forcing.o mod_kinds.o nudging.o\
    459459        pmc_interface.o surface_layer_fluxes.o
    460460parin.o: modules.o cpulog.o land_surface_model_mod.o mod_kinds.o netcdf_interface.o \
    461    pmc_interface.o progress_bar.o
    462 plant_canopy_model.o: modules.o mod_kinds.o
     461   plant_canopy_model_mod.o pmc_interface.o progress_bar.o radiation_model_mod.o
     462plant_canopy_model_mod.o: modules.o mod_kinds.o
    463463pmc_interface.o: modules.o mod_kinds.o pmc_client.o pmc_general.o\
    464464        pmc_handle_communicator.o pmc_mpi_wrapper.o pmc_server.o
     
    480480        cpulog.o diffusion_e.o diffusion_s.o diffusion_u.o diffusion_v.o diffusion_w.o \
    481481        eqn_state_seawater.o mod_kinds.o microphysics.o \
    482         nudging.o plant_canopy_model.o production_e.o radiation_model.o \
     482        nudging.o plant_canopy_model_mod.o production_e.o radiation_model_mod.o \
    483483        subsidence.o user_actions.o
    484484progress_bar.o: modules.o mod_kinds.o
    485 radiation_model.o : modules.o mod_particle_attributes.o
     485radiation_model_mod.o : modules.o mod_particle_attributes.o
    486486random_function.o: mod_kinds.o
    487487random_gauss.o: mod_kinds.o random_function.o random_generator_parallel.o
    488488random_generator_parallel.o: mod_kinds.o
    489489read_3d_binary.o: modules.o cpulog.o mod_kinds.o land_surface_model_mod.o\
    490                   radiation_model.o random_function.o\
     490                  radiation_model_mod.o random_function.o\
    491491                  random_generator_parallel.o
    492 read_var_list.o: modules.o mod_kinds.o netcdf_interface.o plant_canopy_model.o
     492read_var_list.o: modules.o mod_kinds.o netcdf_interface.o plant_canopy_model_mod.o
    493493run_control.o: modules.o cpulog.o mod_kinds.o
    494494set_slicer_attributes_dvrp.o: modules.o mod_kinds.o
     
    498498subsidence.o: modules.o mod_kinds.o
    499499sum_up_3d_data.o: modules.o cpulog.o mod_kinds.o land_surface_model_mod.o\
    500                   radiation_model.o
     500                  radiation_model_mod.o
    501501surface_coupler.o: modules.o cpulog.o mod_kinds.o
    502502surface_layer_fluxes.o: modules.o mod_kinds.o land_surface_model_mod.o
     
    507507        cpulog.o interaction_droplets_ptq.o land_surface_model_mod.o \
    508508        ls_forcing.o mod_kinds.o nudging.o pmc_interface.o production_e.o \
    509         prognostic_equations.o progress_bar.o radiation_model.o \
     509        prognostic_equations.o progress_bar.o radiation_model_mod.o \
    510510        spectrum.o user_actions.o surface_layer_fluxes.o
    511511time_to_string.o: mod_kinds.o
     
    532532user_init_grid.o: modules.o mod_kinds.o user_module.o
    533533user_init_land_surface.o: modules.o mod_kinds.o user_module.o land_surface_model_mod.o
    534 user_init_plant_canopy.o: modules.o mod_kinds.o user_module.o plant_canopy_model.o
    535 user_init_radiation.o: modules.o mod_kinds.o user_module.o radiation_model.o
     534user_init_plant_canopy.o: modules.o mod_kinds.o user_module.o plant_canopy_model_mod.o
     535user_init_radiation.o: modules.o mod_kinds.o user_module.o radiation_model_mod.o
    536536user_last_actions.o: modules.o mod_kinds.o user_module.o
    537537user_lpm_advec.o: modules.o mod_kinds.o user_module.o
     
    545545wall_fluxes.o: modules.o mod_kinds.o
    546546write_3d_binary.o: modules.o cpulog.o mod_kinds.o land_surface_model_mod.o\
    547                    radiation_model.o random_function.o\
     547                   radiation_model_mod.o random_function.o\
    548548                   random_generator_parallel.o
    549 write_var_list.o: modules.o mod_kinds.o netcdf_interface.o plant_canopy_model.o
     549write_var_list.o: modules.o mod_kinds.o netcdf_interface.o plant_canopy_model_mod.o
  • palm/trunk/SOURCE/check_parameters.f90

    r1825 r1826  
    1919! Current revisions:
    2020! -----------------
    21 !
    22 !
     21! Moved checks for radiation model to the respective module.
     22! Moved checks for plant canopy model to the respective module.
     23! Bugfix for check of too large roughness_length
     24!
    2325! Former revisions:
    2426! -----------------
     
    349351    USE land_surface_model_mod,                                                &
    350352        ONLY: land_surface, lsm_check_data_output, lsm_check_data_output_pr,   &
    351               lsm_check_parameters, nzs, zs
     353              lsm_check_parameters
     354
    352355    USE kinds
    353356    USE model_1d
     
    355358        ONLY:  dopr_unit, do2d_unit, do3d_unit, netcdf_data_format,            &
    356359               netcdf_data_format_string
     360
    357361    USE particle_attributes
    358362    USE pegrid
    359     USE plant_canopy_model_mod
     363    USE plant_canopy_model_mod,                                                &
     364        ONLY:  pcm_check_parameters, plant_canopy
     365       
    360366    USE pmc_interface,                                                         &
    361367        ONLY:  cpl_id, nested_run
     368
    362369    USE profil_parameter
    363     USE radiation_model_mod
     370    USE radiation_model_mod,                                                   &
     371        ONLY: radiation, radiation_check_data_output,                          &
     372              radiation_check_data_output_pr, radiation_check_parameters
    364373    USE statistics
    365374    USE subsidence_mod
     
    10221031    ENDIF
    10231032
    1024     IF ( plant_canopy )  THEN
     1033!
     1034!-- When plant canopy model is used, peform addtional checks
     1035    IF ( plant_canopy )  CALL pcm_check_parameters
    10251036   
    1026        IF ( canopy_drag_coeff == 0.0_wp )  THEN
    1027           message_string = 'plant_canopy = .TRUE. requires a non-zero drag '// &
    1028                            'coefficient & given value is canopy_drag_coeff = 0.0'
    1029           CALL message( 'check_parameters', 'PA0041', 1, 2, 0, 6, 0 )
    1030        ENDIF
    1031    
    1032        IF ( ( alpha_lad /= 9999999.9_wp  .AND.  beta_lad == 9999999.9_wp )  .OR.&
    1033               beta_lad /= 9999999.9_wp   .AND.  alpha_lad == 9999999.9_wp )  THEN
    1034           message_string = 'using the beta function for the construction ' //  &
    1035                            'of the leaf area density profile requires '    //  &
    1036                            'both alpha_lad and beta_lad to be /= 9999999.9'
    1037           CALL message( 'check_parameters', 'PA0118', 1, 2, 0, 6, 0 )
    1038        ENDIF
    1039    
    1040        IF ( calc_beta_lad_profile  .AND.  lai_beta == 0.0_wp )  THEN
    1041           message_string = 'using the beta function for the construction ' //  &
    1042                            'of the leaf area density profile requires '    //  &
    1043                            'a non-zero lai_beta, but given value is '      //  &
    1044                            'lai_beta = 0.0'
    1045           CALL message( 'check_parameters', 'PA0119', 1, 2, 0, 6, 0 )
    1046        ENDIF
    1047 
    1048        IF ( calc_beta_lad_profile  .AND.  lad_surface /= 0.0_wp )  THEN
    1049           message_string = 'simultaneous setting of alpha_lad /= 9999999.9' // &
    1050                            'and lad_surface /= 0.0 is not possible, '       // &
    1051                            'use either vertical gradients or the beta '     // &
    1052                            'function for the construction of the leaf area '// &
    1053                            'density profile'
    1054           CALL message( 'check_parameters', 'PA0120', 1, 2, 0, 6, 0 )
    1055        ENDIF
    1056 
    1057        IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    1058           message_string = 'plant_canopy = .TRUE. requires cloud_scheme /=' // &
    1059                            ' seifert_beheng'
    1060           CALL message( 'check_parameters', 'PA0360', 1, 2, 0, 6, 0 )
    1061        ENDIF
    1062 
    1063     ENDIF
    1064 
    10651037!
    10661038!-- When land surface model is used, peform addtional checks
    10671039    IF ( land_surface )  CALL lsm_check_parameters
    10681040
    1069 
    1070     IF ( radiation )  THEN
    1071        IF ( radiation_scheme /= 'constant'   .AND.                             &
    1072             radiation_scheme /= 'clear-sky'  .AND.                             &
    1073             radiation_scheme /= 'rrtmg' )  THEN
    1074           message_string = 'unknown radiation_scheme = '//                     &
    1075                            TRIM( radiation_scheme )
    1076           CALL message( 'check_parameters', 'PA0405', 1, 2, 0, 6, 0 )
    1077        ELSEIF ( radiation_scheme == 'rrtmg' )  THEN
    1078 #if ! defined ( __rrtmg )
    1079           message_string = 'radiation_scheme = "rrtmg" requires ' //           &
    1080                            'compilation of PALM with pre-processor ' //        &
    1081                            'directive -D__rrtmg'
    1082           CALL message( 'check_parameters', 'PA0407', 1, 2, 0, 6, 0 )
    1083 #endif
    1084 #if defined ( __rrtmg ) && ! defined( __netcdf )
    1085           message_string = 'radiation_scheme = "rrtmg" requires ' //           &
    1086                            'the use of NetCDF (preprocessor directive ' //     &
    1087                            '-D__netcdf'
    1088           CALL message( 'check_parameters', 'PA0412', 1, 2, 0, 6, 0 )
    1089 #endif
    1090 
    1091        ENDIF
    1092        IF ( albedo_type == 0  .AND.  albedo == 9999999.9_wp  .AND.             &
    1093             radiation_scheme == 'clear-sky')  THEN
    1094           message_string = 'radiation_scheme = "clear-sky" in combination' //  &
    1095                            'with albedo_type = 0 requires setting of albedo'// &
    1096                            ' /= 9999999.9'
    1097           CALL message( 'check_parameters', 'PA0410', 1, 2, 0, 6, 0 )
    1098        ENDIF
    1099        IF ( albedo_type == 0  .AND.  radiation_scheme == 'rrtmg'  .AND.        &
    1100           (    albedo_lw_dif == 9999999.9_wp .OR. albedo_lw_dir == 9999999.9_wp&
    1101           .OR. albedo_sw_dif == 9999999.9_wp .OR. albedo_sw_dir == 9999999.9_wp&
    1102           ) ) THEN
    1103           message_string = 'radiation_scheme = "rrtmg" in combination' //      &
    1104                            'with albedo_type = 0 requires setting of ' //      &
    1105                            'albedo_lw_dif /= 9999999.9' //                     &
    1106                            'albedo_lw_dir /= 9999999.9' //                     &
    1107                            'albedo_sw_dif /= 9999999.9 and' //                 &
    1108                            'albedo_sw_dir /= 9999999.9'
    1109           CALL message( 'check_parameters', 'PA0411', 1, 2, 0, 6, 0 )
    1110        ENDIF
    1111        IF ( topography /= 'flat' )  THEN
    1112           message_string = 'radiation scheme cannot be used ' //               &
    1113                            'in combination with  topography /= "flat"'
    1114           CALL message( 'check_parameters', 'PA0414', 1, 2, 0, 6, 0 )
    1115        ENDIF
    1116     ENDIF
     1041!
     1042!-- When radiation model is used, peform addtional checks
     1043    IF ( radiation )  CALL radiation_check_parameters
    11171044
    11181045    IF ( .NOT. ( loop_optimization == 'cache'  .OR.                            &
     
    29802907             ENDIF
    29812908
    2982           CASE ( 'rad_net' )
    2983              IF ( (  .NOT.  radiation )  .OR.  radiation_scheme == 'constant' )&
    2984              THEN
    2985                 message_string = 'data_output_pr = ' //                        &
    2986                                  TRIM( data_output_pr(i) ) // ' is not ava' // &
    2987                                  'lable for radiation = .FALSE. or ' //        &
    2988                                  'radiation_scheme = "constant"'
    2989                 CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
    2990              ELSE
    2991                 dopr_index(i) = 101
    2992                 dopr_unit(i)  = 'W/m2'
    2993                 hom(:,2,101,:)  = SPREAD( zw, 2, statistic_regions+1 )
    2994              ENDIF
    2995 
    2996           CASE ( 'rad_lw_in' )
    2997              IF ( (  .NOT.  radiation)  .OR.  radiation_scheme == 'constant' ) &
    2998              THEN
    2999                 message_string = 'data_output_pr = ' //                        &
    3000                                  TRIM( data_output_pr(i) ) // ' is not ava' // &
    3001                                  'lable for radiation = .FALSE. or ' //        &
    3002                                  'radiation_scheme = "constant"'
    3003                 CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
    3004              ELSE
    3005                 dopr_index(i) = 102
    3006                 dopr_unit(i)  = 'W/m2'
    3007                 hom(:,2,102,:)  = SPREAD( zw, 2, statistic_regions+1 )
    3008              ENDIF
    3009 
    3010           CASE ( 'rad_lw_out' )
    3011              IF ( (  .NOT. radiation )  .OR.  radiation_scheme == 'constant' ) &
    3012              THEN
    3013                 message_string = 'data_output_pr = ' //                        &
    3014                                  TRIM( data_output_pr(i) ) // ' is not ava' // &
    3015                                  'lable for radiation = .FALSE. or ' //        &
    3016                                  'radiation_scheme = "constant"'
    3017                 CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
    3018              ELSE
    3019                 dopr_index(i) = 103
    3020                 dopr_unit(i)  = 'W/m2'
    3021                 hom(:,2,103,:)  = SPREAD( zw, 2, statistic_regions+1 )
    3022              ENDIF
    3023 
    3024           CASE ( 'rad_sw_in' )
    3025              IF ( (  .NOT. radiation )  .OR.  radiation_scheme == 'constant' ) &
    3026              THEN
    3027                 message_string = 'data_output_pr = ' //                        &
    3028                                  TRIM( data_output_pr(i) ) // ' is not ava' // &
    3029                                  'lable for radiation = .FALSE. or ' //        &
    3030                                  'radiation_scheme = "constant"'
    3031                 CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
    3032              ELSE
    3033                 dopr_index(i) = 104
    3034                 dopr_unit(i)  = 'W/m2'
    3035                 hom(:,2,104,:)  = SPREAD( zw, 2, statistic_regions+1 )
    3036              ENDIF
    3037 
    3038           CASE ( 'rad_sw_out')
    3039              IF ( (  .NOT.  radiation )  .OR.  radiation_scheme == 'constant' ) &
    3040              THEN
    3041                 message_string = 'data_output_pr = ' //                        &
    3042                                  TRIM( data_output_pr(i) ) // ' is not ava' // &
    3043                                  'lable for radiation = .FALSE. or ' //        &
    3044                                  'radiation_scheme = "constant"'
    3045                 CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
    3046              ELSE
    3047                 dopr_index(i) = 105
    3048                 dopr_unit(i)  = 'W/m2'
    3049                 hom(:,2,105,:)  = SPREAD( zw, 2, statistic_regions+1 )
    3050              ENDIF
    3051 
    3052           CASE ( 'rad_lw_cs_hr' )
    3053              IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )   &
    3054              THEN
    3055                 message_string = 'data_output_pr = ' //                        &
    3056                                  TRIM( data_output_pr(i) ) // ' is not ava' // &
    3057                                  'lable for radiation = .FALSE. or ' //        &
    3058                                  'radiation_scheme /= "rrtmg"'
    3059                 CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
    3060              ELSE
    3061                 dopr_index(i) = 106
    3062                 dopr_unit(i)  = 'K/h'
    3063                 hom(:,2,106,:)  = SPREAD( zu, 2, statistic_regions+1 )
    3064              ENDIF
    3065 
    3066           CASE ( 'rad_lw_hr' )
    3067              IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )   &
    3068              THEN
    3069                 message_string = 'data_output_pr = ' //                        &
    3070                                  TRIM( data_output_pr(i) ) // ' is not ava' // &
    3071                                  'lable for radiation = .FALSE. or ' //        &
    3072                                  'radiation_scheme /= "rrtmg"'
    3073                 CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
    3074              ELSE
    3075                 dopr_index(i) = 107
    3076                 dopr_unit(i)  = 'K/h'
    3077                 hom(:,2,107,:)  = SPREAD( zu, 2, statistic_regions+1 )
    3078              ENDIF
    3079 
    3080           CASE ( 'rad_sw_cs_hr' )
    3081              IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )   &
    3082              THEN
    3083                 message_string = 'data_output_pr = ' //                        &
    3084                                  TRIM( data_output_pr(i) ) // ' is not ava' // &
    3085                                  'lable for radiation = .FALSE. or ' //        &
    3086                                  'radiation_scheme /= "rrtmg"'
    3087                 CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
    3088              ELSE
    3089                 dopr_index(i) = 108
    3090                 dopr_unit(i)  = 'K/h'
    3091                 hom(:,2,108,:)  = SPREAD( zu, 2, statistic_regions+1 )
    3092              ENDIF
    3093 
    3094           CASE ( 'rad_sw_hr' )
    3095              IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )   &
    3096              THEN
    3097                 message_string = 'data_output_pr = ' //                        &
    3098                                  TRIM( data_output_pr(i) ) // ' is not ava' // &
    3099                                  'lable for radiation = .FALSE. or ' //        &
    3100                                  'radiation_scheme /= "rrtmg"'
    3101                 CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
    3102              ELSE
    3103                 dopr_index(i) = 109
    3104                 dopr_unit(i)  = 'K/h'
    3105                 hom(:,2,109,:)  = SPREAD( zu, 2, statistic_regions+1 )
    3106              ENDIF
     2909 
    31072910
    31082911          CASE DEFAULT
    31092912
    3110              CALL lsm_check_data_output_pr( data_output_pr(i), i, unit, dopr_unit(i) )
    3111 
     2913             CALL lsm_check_data_output_pr( data_output_pr(i), i, unit,        &
     2914                                            dopr_unit(i) )
     2915
     2916             IF ( unit == 'illegal' )  THEN
     2917                CALL radiation_check_data_output_pr( data_output_pr(i), i,     &
     2918                                                     unit, dopr_unit(i) )
     2919             ENDIF
     2920             
    31122921             IF ( unit == 'illegal' )  THEN
    31132922                CALL user_check_data_output_pr( data_output_pr(i), i, unit )
     
    32883097             unit = 'kg/kg'
    32893098
    3290           CASE ( 'rad_lw_in', 'rad_lw_out', 'rad_lw_cs_hr', 'rad_lw_hr',       &
    3291                  'rad_sw_in', 'rad_sw_out', 'rad_sw_cs_hr', 'rad_sw_hr' )
    3292              IF (  .NOT.  radiation  .OR.  radiation_scheme /= 'rrtmg' )  THEN
    3293                 message_string = '"output of "' // TRIM( var ) // '" requi' // &
    3294                                  'res radiation = .TRUE. and ' //              &
    3295                                  'radiation_scheme = "rrtmg"'
    3296                 CALL message( 'check_parameters', 'PA0406', 1, 2, 0, 6, 0 )
    3297              ENDIF
    3298              unit = 'W/m2'
    3299 
    33003099          CASE ( 'rho' )
    33013100             IF (  .NOT.  ocean )  THEN
     
    33303129             CONTINUE
    33313130
    3332           CASE ( 'lai*', 'lwp*', 'ol*', 'pra*', 'prr*', 'qsws*', 'rad_net*',   &
    3333                  'rrtm_aldif*', 'rrtm_aldir*', 'rrtm_asdif*', 'rrtm_asdir*',   &
    3334                  'shf*', 't*', 'u*', 'z0*', 'z0h*', 'z0q*' )
     3131          CASE ( 'lai*', 'lwp*', 'ol*', 'pra*', 'prr*', 'qsws*', 'shf*', 't*', &
     3132                 'u*', 'z0*', 'z0h*', 'z0q*' )
    33353133             IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
    33363134                message_string = 'illegal value for data_output: "' //         &
     
    33393137                CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 )
    33403138             ENDIF
    3341              IF (  .NOT.  radiation  .OR.  radiation_scheme /= "rrtmg" )  THEN
    3342                 IF ( TRIM( var ) == 'rrtm_aldif*'  .OR.                        &
    3343                      TRIM( var ) == 'rrtm_aldir*'  .OR.                        &
    3344                      TRIM( var ) == 'rrtm_asdif*'  .OR.                        &
    3345                      TRIM( var ) == 'rrtm_asdir*'      )                       &
    3346                 THEN
    3347                    message_string = 'output of "' // TRIM( var ) // '" require'&
    3348                                     // 's radiation = .TRUE. and radiation_sch'&
    3349                                     // 'eme = "rrtmg"'
    3350                    CALL message( 'check_parameters', 'PA0409', 1, 2, 0, 6, 0 )
    3351                 ENDIF
    3352              ENDIF
    3353              IF ( TRIM( var ) == 'lai*'  .AND.  .NOT.  land_surface )  THEN
    3354                 message_string = 'output of "' // TRIM( var ) // '" requi' //  &
    3355                                  'res land_surface = .TRUE.'
    3356                 CALL message( 'check_parameters', 'PA0404', 1, 2, 0, 6, 0 )
    3357              ENDIF
     3139
    33583140             IF ( TRIM( var ) == 'lwp*'  .AND.  .NOT. cloud_physics )  THEN
    33593141                message_string = 'output of "' // TRIM( var ) // '" requi' //  &
     
    33843166             ENDIF
    33853167
    3386              IF ( TRIM( var ) == 'lai*'   )  unit = 'none'
    33873168             IF ( TRIM( var ) == 'lwp*'   )  unit = 'kg/m2'
    33883169             IF ( TRIM( var ) == 'ol*'   )   unit = 'm'
     
    33903171             IF ( TRIM( var ) == 'prr*'   )  unit = 'mm/s'
    33913172             IF ( TRIM( var ) == 'qsws*'  )  unit = 'kgm/kgs'
    3392              IF ( TRIM( var ) == 'rad_net*'      ) unit = 'W/m2'   
    3393              IF ( TRIM( var ) == 'rrtm_aldif*'   ) unit = ''   
    3394              IF ( TRIM( var ) == 'rrtm_aldir*'   ) unit = ''
    3395              IF ( TRIM( var ) == 'rrtm_asdif*'   ) unit = ''
    3396              IF ( TRIM( var ) == 'rrtm_asdir*'   ) unit = ''
    33973173             IF ( TRIM( var ) == 'shf*'   )  unit = 'K*m/s'
    33983174             IF ( TRIM( var ) == 't*'     )  unit = 'K'
     
    34043180
    34053181             CALL lsm_check_data_output ( var, unit, i, ilen, k )
    3406              
     3182 
     3183             IF ( unit == 'illegal' )  THEN
     3184                CALL radiation_check_data_output( var, unit, i, ilen, k )
     3185             ENDIF
     3186
    34073187             IF ( unit == 'illegal' )  THEN
    34083188                CALL user_check_data_output( var, unit )
     
    40733853    ENDIF
    40743854
     3855    CALL location_message( 'finished', .TRUE. )
     3856
    40753857!
    40763858!-- Prevent empty time records in volume, cross-section and masked data in case of
     
    41003882    IF ( ( constant_flux_layer .OR.  &
    41013883           INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 ) &
    4102          .AND. roughness_length <= 0.5 * dz )  THEN
     3884         .AND. roughness_length > 0.5 * dz )  THEN
    41033885       message_string = 'roughness_length must be smaller than dz/2'
    41043886       CALL message( 'check_parameters', 'PA0424', 1, 2, 0, 6, 0 )
  • palm/trunk/SOURCE/header.f90

    r1823 r1826  
    1919! Current revisions:
    2020! -----------------
    21 !
     21! Moved radiation model header output to the respective module.
     22! Moved canopy model header output to the respective module.
    2223!
    2324! Former revisions:
     
    289290
    290291    USE plant_canopy_model_mod,                                                &
    291         ONLY:  alpha_lad, beta_lad, calc_beta_lad_profile, canopy_drag_coeff,  &
    292                canopy_mode, cthf, lad, lad_surface, lad_vertical_gradient,     &
    293                lad_vertical_gradient_level, lad_vertical_gradient_level_ind,   &
    294                lai_beta, leaf_scalar_exch_coeff, leaf_surface_conc, pch_index, &
    295                plant_canopy
     292        ONLY:  pcm_header, plant_canopy
    296293
    297294    USE pmc_handle_communicator,                                               &
     
    302299
    303300    USE radiation_model_mod,                                                   &
    304         ONLY:  albedo, albedo_type, albedo_type_name, constant_albedo,         &
    305                day_init, dt_radiation, lambda, lw_radiation, net_radiation,    &
    306                radiation, radiation_scheme, sw_radiation, time_utc_init
     301        ONLY:  radiation, radiation_header
    307302   
    308303    USE spectrum,                                                              &
     
    339334    CHARACTER (LEN=70) ::  run_classification  !<
    340335   
    341     CHARACTER (LEN=85) ::  roben               !<
    342     CHARACTER (LEN=85) ::  runten              !<
     336    CHARACTER (LEN=85) ::  r_upper             !<
     337    CHARACTER (LEN=85) ::  r_lower             !<
    343338   
    344339    CHARACTER (LEN=86) ::  coordinates         !<
    345340    CHARACTER (LEN=86) ::  gradients           !<
    346     CHARACTER (LEN=86) ::  leaf_area_density   !<
    347     CHARACTER (LEN=86) ::  roots               !<
    348341    CHARACTER (LEN=86) ::  slices              !<
    349342    CHARACTER (LEN=86) ::  temperatures        !<
     
    383376    INTEGER(iwp) ::  npe_total      !<
    384377   
    385     REAL(wp) ::  canopy_height                    !< canopy height (in m)
     378
    386379    REAL(wp) ::  cpuseconds_per_simulated_second  !<
    387380    REAL(wp) ::  lower_left_coord_x               !< x-coordinate of nest domain
     
    903896    ENDIF
    904897
    905     IF ( plant_canopy )  THEN
    906    
    907        canopy_height = pch_index * dz
    908 
    909        WRITE ( io, 280 )  canopy_mode, canopy_height, pch_index,               &
    910                           canopy_drag_coeff
    911        IF ( passive_scalar )  THEN
    912           WRITE ( io, 281 )  leaf_scalar_exch_coeff,                           &
    913                              leaf_surface_conc
    914        ENDIF
    915 
    916 !
    917 !--    Heat flux at the top of vegetation
    918        WRITE ( io, 282 )  cthf
    919 
    920 !
    921 !--    Leaf area density profile, calculated either from given vertical
    922 !--    gradients or from beta probability density function.
    923        IF (  .NOT.  calc_beta_lad_profile )  THEN
    924 
    925 !--       Building output strings, starting with surface value
    926           WRITE ( leaf_area_density, '(F7.4)' )  lad_surface
    927           gradients = '------'
    928           slices = '     0'
    929           coordinates = '   0.0'
    930           i = 1
    931           DO  WHILE ( i < 11  .AND.  lad_vertical_gradient_level_ind(i) /= -9999 )
    932 
    933              WRITE (coor_chr,'(F7.2)')  lad(lad_vertical_gradient_level_ind(i))
    934              leaf_area_density = TRIM( leaf_area_density ) // ' ' // TRIM( coor_chr )
    935  
    936              WRITE (coor_chr,'(F7.2)')  lad_vertical_gradient(i)
    937              gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
    938 
    939              WRITE (coor_chr,'(I7)')  lad_vertical_gradient_level_ind(i)
    940              slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
    941 
    942              WRITE (coor_chr,'(F7.1)')  lad_vertical_gradient_level(i)
    943              coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
    944 
    945              i = i + 1
    946           ENDDO
    947 
    948           WRITE ( io, 283 )  TRIM( coordinates ), TRIM( leaf_area_density ),              &
    949                              TRIM( gradients ), TRIM( slices )
    950 
    951        ELSE
    952        
    953           WRITE ( leaf_area_density, '(F7.4)' )  lad_surface
    954           coordinates = '   0.0'
    955          
    956           DO  k = 1, pch_index
    957 
    958              WRITE (coor_chr,'(F7.2)')  lad(k)
    959              leaf_area_density = TRIM( leaf_area_density ) // ' ' // TRIM( coor_chr )
    960  
    961              WRITE (coor_chr,'(F7.1)')  zu(k)
    962              coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
    963 
    964           ENDDO       
    965 
    966           WRITE ( io, 284 ) TRIM( coordinates ), TRIM( leaf_area_density ), alpha_lad,    &
    967                             beta_lad, lai_beta
    968 
    969        ENDIF 
    970 
    971     ENDIF
     898    IF ( plant_canopy )  CALL pcm_header ( io )
    972899
    973900    IF ( land_surface )  CALL lsm_header ( io )
    974901
    975     IF ( radiation )  THEN
    976 !
    977 !--    Write radiation model header
    978        WRITE( io, 444 )
    979 
    980        IF ( radiation_scheme == "constant" )  THEN
    981           WRITE( io, 445 ) net_radiation
    982        ELSEIF ( radiation_scheme == "clear-sky" )  THEN
    983           WRITE( io, 446 )
    984        ELSEIF ( radiation_scheme == "rrtmg" )  THEN
    985           WRITE( io, 447 )
    986           IF ( .NOT. lw_radiation )  WRITE( io, 458 )
    987           IF ( .NOT. sw_radiation )  WRITE( io, 459 )
    988        ENDIF
    989 
    990        IF ( albedo_type == 0 )  THEN
    991           WRITE( io, 448 ) albedo
    992        ELSE
    993           WRITE( io, 456 ) TRIM( albedo_type_name(albedo_type) )
    994        ENDIF
    995        IF ( constant_albedo )  THEN
    996           WRITE( io, 457 )
    997        ENDIF
    998        WRITE( io, 449 ) dt_radiation
    999     ENDIF
    1000 
     902    IF ( radiation )  CALL radiation_header ( io )
    1001903
    1002904!
    1003905!-- Boundary conditions
    1004906    IF ( ibc_p_b == 0 )  THEN
    1005        runten = 'p(0)     = 0      |'
     907       r_lower = 'p(0)     = 0      |'
    1006908    ELSEIF ( ibc_p_b == 1 )  THEN
    1007        runten = 'p(0)     = p(1)   |'
     909       r_lower = 'p(0)     = p(1)   |'
    1008910    ENDIF
    1009911    IF ( ibc_p_t == 0 )  THEN
    1010        roben  = 'p(nzt+1) = 0      |'
     912       r_upper  = 'p(nzt+1) = 0      |'
    1011913    ELSE
    1012        roben  = 'p(nzt+1) = p(nzt) |'
     914       r_upper  = 'p(nzt+1) = p(nzt) |'
    1013915    ENDIF
    1014916
    1015917    IF ( ibc_uv_b == 0 )  THEN
    1016        runten = TRIM( runten ) // ' uv(0)     = -uv(1)                |'
     918       r_lower = TRIM( r_lower ) // ' uv(0)     = -uv(1)                |'
    1017919    ELSE
    1018        runten = TRIM( runten ) // ' uv(0)     = uv(1)                 |'
     920       r_lower = TRIM( r_lower ) // ' uv(0)     = uv(1)                 |'
    1019921    ENDIF
    1020922    IF ( TRIM( bc_uv_t ) == 'dirichlet_0' )  THEN
    1021        roben  = TRIM( roben  ) // ' uv(nzt+1) = 0                     |'
     923       r_upper  = TRIM( r_upper  ) // ' uv(nzt+1) = 0                     |'
    1022924    ELSEIF ( ibc_uv_t == 0 )  THEN
    1023        roben  = TRIM( roben  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
     925       r_upper  = TRIM( r_upper  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
    1024926    ELSE
    1025        roben  = TRIM( roben  ) // ' uv(nzt+1) = uv(nzt)               |'
     927       r_upper  = TRIM( r_upper  ) // ' uv(nzt+1) = uv(nzt)               |'
    1026928    ENDIF
    1027929
    1028930    IF ( ibc_pt_b == 0 )  THEN
    1029931       IF ( land_surface )  THEN
    1030           runten = TRIM( runten ) // ' pt(0)     = from soil model'
    1031        ELSE
    1032           runten = TRIM( runten ) // ' pt(0)     = pt_surface'
     932          r_lower = TRIM( r_lower ) // ' pt(0)     = from soil model'
     933       ELSE
     934          r_lower = TRIM( r_lower ) // ' pt(0)     = pt_surface'
    1033935       ENDIF
    1034936    ELSEIF ( ibc_pt_b == 1 )  THEN
    1035        runten = TRIM( runten ) // ' pt(0)     = pt(1)'
     937       r_lower = TRIM( r_lower ) // ' pt(0)     = pt(1)'
    1036938    ELSEIF ( ibc_pt_b == 2 )  THEN
    1037        runten = TRIM( runten ) // ' pt(0)     = from coupled model'
     939       r_lower = TRIM( r_lower ) // ' pt(0)     = from coupled model'
    1038940    ENDIF
    1039941    IF ( ibc_pt_t == 0 )  THEN
    1040        roben  = TRIM( roben  ) // ' pt(nzt+1) = pt_top'
     942       r_upper  = TRIM( r_upper  ) // ' pt(nzt+1) = pt_top'
    1041943    ELSEIF( ibc_pt_t == 1 )  THEN
    1042        roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt)'
     944       r_upper  = TRIM( r_upper  ) // ' pt(nzt+1) = pt(nzt)'
    1043945    ELSEIF( ibc_pt_t == 2 )  THEN
    1044        roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
    1045 
    1046     ENDIF
    1047 
    1048     WRITE ( io, 300 )  runten, roben
     946       r_upper  = TRIM( r_upper  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
     947
     948    ENDIF
     949
     950    WRITE ( io, 300 )  r_lower, r_upper
    1049951
    1050952    IF ( .NOT. constant_diffusion )  THEN
    1051953       IF ( ibc_e_b == 1 )  THEN
    1052           runten = 'e(0)     = e(1)'
    1053        ELSE
    1054           runten = 'e(0)     = e(1) = (u*/0.1)**2'
    1055        ENDIF
    1056        roben = 'e(nzt+1) = e(nzt) = e(nzt-1)'
    1057 
    1058        WRITE ( io, 301 )  'e', runten, roben       
     954          r_lower = 'e(0)     = e(1)'
     955       ELSE
     956          r_lower = 'e(0)     = e(1) = (u*/0.1)**2'
     957       ENDIF
     958       r_upper = 'e(nzt+1) = e(nzt) = e(nzt-1)'
     959
     960       WRITE ( io, 301 )  'e', r_lower, r_upper       
    1059961
    1060962    ENDIF
    1061963
    1062964    IF ( ocean )  THEN
    1063        runten = 'sa(0)    = sa(1)'
     965       r_lower = 'sa(0)    = sa(1)'
    1064966       IF ( ibc_sa_t == 0 )  THEN
    1065           roben =  'sa(nzt+1) = sa_surface'
    1066        ELSE
    1067           roben =  'sa(nzt+1) = sa(nzt)'
    1068        ENDIF
    1069        WRITE ( io, 301 ) 'sa', runten, roben
     967          r_upper =  'sa(nzt+1) = sa_surface'
     968       ELSE
     969          r_upper =  'sa(nzt+1) = sa(nzt)'
     970       ENDIF
     971       WRITE ( io, 301 ) 'sa', r_lower, r_upper
    1070972    ENDIF
    1071973
     
    1073975       IF ( ibc_q_b == 0 )  THEN
    1074976          IF ( land_surface )  THEN
    1075              runten = 'q(0)     = from soil model'
     977             r_lower = 'q(0)     = from soil model'
    1076978          ELSE
    1077              runten = 'q(0)     = q_surface'
    1078           ENDIF
    1079 
    1080        ELSE
    1081           runten = 'q(0)     = q(1)'
     979             r_lower = 'q(0)     = q_surface'
     980          ENDIF
     981
     982       ELSE
     983          r_lower = 'q(0)     = q(1)'
    1082984       ENDIF
    1083985       IF ( ibc_q_t == 0 )  THEN
    1084           roben =  'q(nzt)   = q_top'
    1085        ELSE
    1086           roben =  'q(nzt)   = q(nzt-1) + dq/dz'
    1087        ENDIF
    1088        WRITE ( io, 301 ) 'q', runten, roben
     986          r_upper =  'q(nzt)   = q_top'
     987       ELSE
     988          r_upper =  'q(nzt)   = q(nzt-1) + dq/dz'
     989       ENDIF
     990       WRITE ( io, 301 ) 'q', r_lower, r_upper
    1089991    ENDIF
    1090992
    1091993    IF ( passive_scalar )  THEN
    1092994       IF ( ibc_q_b == 0 )  THEN
    1093           runten = 's(0)     = s_surface'
    1094        ELSE
    1095           runten = 's(0)     = s(1)'
     995          r_lower = 's(0)     = s_surface'
     996       ELSE
     997          r_lower = 's(0)     = s(1)'
    1096998       ENDIF
    1097999       IF ( ibc_q_t == 0 )  THEN
    1098           roben =  's(nzt)   = s_top'
    1099        ELSE
    1100           roben =  's(nzt)   = s(nzt-1) + ds/dz'
    1101        ENDIF
    1102        WRITE ( io, 301 ) 's', runten, roben
     1000          r_upper =  's(nzt)   = s_top'
     1001       ELSE
     1002          r_upper =  's(nzt)   = s(nzt-1) + ds/dz'
     1003       ENDIF
     1004       WRITE ( io, 301 ) 's', r_lower, r_upper
    11031005    ENDIF
    11041006
     
    17471649!
    17481650!-- Geostrophic parameters
    1749     IF ( radiation .AND. radiation_scheme /= 'constant' )  THEN
    1750        WRITE ( io, 417 )  lambda
    1751     ENDIF
    17521651    WRITE ( io, 410 )  phi, omega, f, fs
    17531652
     
    17551654!-- Other quantities
    17561655    WRITE ( io, 411 )  g
    1757     IF ( radiation .AND. radiation_scheme /= 'constant' )  THEN
    1758        WRITE ( io, 418 )  day_init, time_utc_init
    1759     ENDIF
    17601656
    17611657    WRITE ( io, 412 )  TRIM( reference_state )
     
    20601956279 FORMAT (' Topography grid definition convention:'/ &
    20611957            ' cell center (scalar grid points)' /)
    2062 280 FORMAT (//' Vegetation canopy (drag) model:'/ &
    2063               ' ------------------------------'// &
    2064               ' Canopy mode: ', A / &
    2065               ' Canopy height: ',F6.2,'m (',I4,' grid points)' / &
    2066               ' Leaf drag coefficient: ',F6.2 /)
    2067 281 FORMAT (/ ' Scalar exchange coefficient: ',F6.2 / &
    2068               ' Scalar concentration at leaf surfaces in kg/m**3: ',F6.2 /)
    2069 282 FORMAT (' Predefined constant heatflux at the top of the vegetation: ',F6.2,' K m/s')
    2070 283 FORMAT (/ ' Characteristic levels of the leaf area density:'// &
    2071               ' Height:              ',A,'  m'/ &
    2072               ' Leaf area density:   ',A,'  m**2/m**3'/ &
    2073               ' Gradient:            ',A,'  m**2/m**4'/ &
    2074               ' Gridpoint:           ',A)
    2075 284 FORMAT (//' Characteristic levels of the leaf area density and coefficients:'// &
    2076               ' Height:              ',A,'  m'/ &
    2077               ' Leaf area density:   ',A,'  m**2/m**3'/ &
    2078               ' Coefficient alpha: ',F6.2 / &
    2079               ' Coefficient beta: ',F6.2 / &
    2080               ' Leaf area index: ',F6.2,'  m**2/m**2' /)
    2081                
    20821958300 FORMAT (//' Boundary conditions:'/ &
    20831959             ' -------------------'// &
     
    23002176                       '[0,1000] cm**2/s**3')
    23012177437 FORMAT ('    Droplet collision is switched off')
    2302 444 FORMAT (//' Radiation model information:'/                                 &
    2303               ' ----------------------------'/)
    2304 445 FORMAT (' --> Using constant net radiation: net_radiation = ', F6.2, '  W/m**2')
    2305 446 FORMAT (' --> Simple radiation scheme for clear sky is used (no clouds,',  &
    2306                    ' default)')
    2307 447 FORMAT (' --> RRTMG scheme is used')
    2308 448 FORMAT (/'     User-specific surface albedo: albedo =', F6.3)
    2309 449 FORMAT  ('     Timestep: dt_radiation = ', F5.2, '  s')
    2310 
    23112178450 FORMAT (//' LES / Turbulence quantities:'/ &
    23122179              ' ---------------------------'/)
     
    23162183454 FORMAT ('    TKE is not allowed to fall below ',E9.2,' (m/s)**2')
    23172184455 FORMAT ('    initial TKE is prescribed as ',E9.2,' (m/s)**2')
    2318 456 FORMAT (/'    Albedo is set for land surface type: ', A)
    2319 457 FORMAT (/'    --> Albedo is fixed during the run')
    2320 458 FORMAT (/'    --> Longwave radiation is disabled')
    2321 459 FORMAT (/'    --> Shortwave radiation is disabled.')
    23222185470 FORMAT (//' Actions during the simulation:'/ &
    23232186              ' -----------------------------'/)
  • palm/trunk/SOURCE/init_3d_model.f90

    r1823 r1826  
    1919! Current revisions:
    2020! ------------------
    21 !
     21! Renamed radiation calls.
     22! Renamed canopy model calls.
    2223!
    2324! Former revisions:
     
    288289   
    289290    USE plant_canopy_model_mod,                                                &
    290         ONLY:  init_plant_canopy, plant_canopy
     291        ONLY:  pcm_init, plant_canopy
    291292
    292293    USE radiation_model_mod,                                                   &
    293         ONLY:  init_radiation, radiation
     294        ONLY:  radiation_init, radiation
    294295   
    295296    USE random_function_mod
     
    16311632!
    16321633!-- If required, initialize quantities needed for the plant canopy model
    1633     IF ( plant_canopy )  CALL init_plant_canopy
     1634    CALL location_message( 'initializing plant canopy model', .FALSE. )
     1635    IF ( plant_canopy )  CALL pcm_init
     1636    CALL location_message( 'finished', .TRUE. )
    16341637
    16351638!
     
    16761679    IF ( radiation )  THEN
    16771680       CALL location_message( 'initializing radiation model', .FALSE. )
    1678        CALL init_radiation
     1681       CALL radiation_init
    16791682       CALL location_message( 'finished', .TRUE. )
    16801683    ENDIF
  • palm/trunk/SOURCE/land_surface_model_mod.f90

    r1818 r1826  
    1919! Current revisions:
    2020! -----------------
    21 !
     21! Cleanup after modularization
    2222!
    2323! Former revisions:
     
    532532    PUBLIC lsm_check_data_output, lsm_check_data_output_pr,                    &
    533533           lsm_check_parameters, lsm_energy_balance, lsm_header, lsm_init,     &
    534            lsm_init_arrays, lsm_parin, lsm_soil_model
     534           lsm_init_arrays, lsm_parin, lsm_soil_model, lsm_swap_timelevel
    535535!
    536536!-- Public parameters, constants and initial values
    537     PUBLIC alpha_vangenuchten, c_surface, canopy_resistance_coefficient,       &
    538            conserve_water_content, field_capacity,                             &
    539            f_shortwave_incoming, hydraulic_conductivity,                       &
    540            lambda_surface_stable, lambda_surface_unstable,                     &
    541            land_surface, leaf_area_index,                                      &
    542            lsm_swap_timelevel, l_vangenuchten,                                 &
    543            min_canopy_resistance, min_soil_resistance, n_vangenuchten,         &
    544            pave_heat_capacity, pave_depth, pave_heat_conductivity,             &
    545            residual_moisture, rho_cp, rho_lv, root_fraction,                   &
    546            saturation_moisture, skip_time_do_lsm, soil_moisture,               &
    547            soil_temperature, soil_type, soil_type_name, vegetation_coverage,   &
    548            veg_type, veg_type_name, wilting_point, z0_eb, z0h_eb, z0q_eb
     537    PUBLIC land_surface, skip_time_do_lsm
    549538
    550539!
     
    644633             unit = 'K'   
    645634             
    646           CASE ( 'c_liq*', 'c_soil*', 'c_veg*', 'ghf_eb*',      &
    647                  'm_liq_eb*', 'qsws_eb*',      &
    648                  'qsws_liq_eb*', 'qsws_soil_eb*', 'qsws_veg_eb*', &
     635          CASE ( 'lai*', 'c_liq*', 'c_soil*', 'c_veg*', 'ghf_eb*', 'm_liq_eb*',&
     636                 'qsws_eb*', 'qsws_liq_eb*', 'qsws_soil_eb*', 'qsws_veg_eb*',  &
    649637                 'r_a*', 'r_s*', 'shf_eb*' )
    650638             IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
     
    654642                CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 )
    655643             ENDIF
    656 
     644             IF ( TRIM( var ) == 'lai*'  .AND.  .NOT.  land_surface )  THEN
     645                message_string = 'output of "' // TRIM( var ) // '" requi' //  &
     646                                 'res land_surface = .TRUE.'
     647                CALL message( 'check_parameters', 'PA0404', 1, 2, 0, 6, 0 )
     648             ENDIF
    657649             IF ( TRIM( var ) == 'c_liq*'  .AND.  .NOT.  land_surface )  THEN
    658650                message_string = 'output of "' // TRIM( var ) // '" requi' //  &
     
    716708             ENDIF
    717709
     710             IF ( TRIM( var ) == 'lai*'   )  unit = 'none'
    718711             IF ( TRIM( var ) == 'c_liq*' )  unit = 'none'
    719712             IF ( TRIM( var ) == 'c_soil*')  unit = 'none'
     
    156415571   FORMAT (//' Land surface model information:'/                              &
    15651558              ' ------------------------------'/)
    1566 2   FORMAT (' --> Soil bottom is closed (water content is conserved, default)')
    1567 3   FORMAT (' --> Soil bottom is open (water content is not conserved)')         
    1568 4   FORMAT (' --> Land surface type  : ',A,/                                   &
    1569             ' --> Soil porosity type : ',A)
     15592   FORMAT ('    --> Soil bottom is closed (water content is conserved',       &
     1560            ', default)')
     15613   FORMAT ('    --> Soil bottom is open (water content is not conserved)')         
     15624   FORMAT ('    --> Land surface type  : ',A,/                                &
     1563            '    --> Soil porosity type : ',A)
    157015645   FORMAT (/'    Initial soil temperature and moisture profile:'//            &
    15711565            '       Height:        ',A,'  m'/                                  &
     
    15731567            '       Moisture:      ',A,'  m**3/m**3'/                          &
    15741568            '       Root fraction: ',A,'  '/                                   &
    1575             '       Gridpoint:     ',A)
    1576 
    1577 
     1569            '       Grid point:    ',A)
    15781570
    15791571    END SUBROUTINE lsm_header
     
    16271619
    16281620       IF ( humidity )  THEN
    1629           qsws_eb = rho_l * l_v * qsws
     1621          qsws_eb = rho_lv * qsws
    16301622       ELSE
    16311623          qsws_eb = 0.0_wp
  • palm/trunk/SOURCE/package_parin.f90

    r1823 r1826  
    1919! Current revisions:
    2020! -----------------
    21 !
     21! Reading of &radiation_par moved to radiation_model_mod.
     22! Reading of &canopy_par moved to plant_canopy_model_mod.
    2223!
    2324! Former revisions:
     
    3031!
    3132! 1817 2016-04-06 15:44:20Z maronga
    32 ! Reading of &lsmpar moved to land_surface_model_mod.
     33! Reading of &lsm_par moved to land_surface_model_mod.
    3334!
    3435! 1788 2016-03-10 11:01:04Z maronga
     
    152153               vertical_particle_advection, write_particle_statistics
    153154
    154     USE plant_canopy_model_mod,                                                &
    155         ONLY:  alpha_lad, beta_lad, calc_beta_lad_profile, canopy_drag_coeff,  &
    156                canopy_mode, cthf, lad_surface,                                 &
    157                lad_vertical_gradient, lad_vertical_gradient_level, lai_beta,   &
    158                leaf_scalar_exch_coeff, leaf_surface_conc, pch_index,           &
    159                plant_canopy
    160 
    161     USE radiation_model_mod,                                                   &
    162         ONLY: albedo, albedo_type, albedo_lw_dif, albedo_lw_dir, albedo_sw_dif,&
    163               albedo_sw_dir, constant_albedo, day_init, dt_radiation,          &
    164               emissivity, lambda, lw_radiation, net_radiation, radiation,      &
    165               radiation_scheme, skip_time_do_radiation, sw_radiation,          &
    166               time_utc_init, unscheduled_radiation_calls
    167                
    168 
    169155    USE spectrum,                                                              &
    170156        ONLY:  comp_spectra_level, data_output_sp, plot_spectra_level,         &
     
    175161    CHARACTER (LEN=80) ::  line  !<
    176162
    177     NAMELIST /canopy_par/         alpha_lad, beta_lad, canopy_drag_coeff,      &
    178                                   canopy_mode, cthf,                           &
    179                                   lad_surface,                                 &
    180                                   lad_vertical_gradient,                       &
    181                                   lad_vertical_gradient_level,                 &
    182                                   lai_beta,                                    &
    183                                   leaf_scalar_exch_coeff,                      &
    184                                   leaf_surface_conc, pch_index
     163
    185164
    186165    NAMELIST /dvrp_graphics_par/  clip_dvrp_l, clip_dvrp_n, clip_dvrp_r,       &
     
    220199                                  write_particle_statistics
    221200
    222     NAMELIST /radiation_par/      albedo, albedo_type, albedo_lw_dir,          &
    223                                   albedo_lw_dif, albedo_sw_dir, albedo_sw_dif, &
    224                                   constant_albedo, day_init, dt_radiation,     &
    225                                   lambda, lw_radiation, net_radiation,         &
    226                                   radiation_scheme, skip_time_do_radiation,    &
    227                                   sw_radiation, time_utc_init,                 &
    228                                   unscheduled_radiation_calls
    229 
    230201    NAMELIST /spectra_par/        averaging_interval_sp, comp_spectra_level,   &
    231202                                  data_output_sp, dt_dosp, plot_spectra_level, &
     
    237208!-- file at this line. Do the same for each optionally used package.
    238209    line = ' '
    239 
    240 !
    241 !-- Try to find canopy package
    242     REWIND ( 11 )
    243     line = ' '
    244     DO   WHILE ( INDEX( line, '&canopy_par' ) == 0 )
    245        READ ( 11, '(A)', END=10 )  line
    246     ENDDO
    247     BACKSPACE ( 11 )
    248 
    249 !
    250 !-- Read user-defined namelist
    251     READ ( 11, canopy_par )
    252 
    253 !
    254 !-- Set flag that indicates that canopy model is switched on
    255     plant_canopy = .TRUE.
    256 
    257 !
    258 !-- Set flag that indicates that the lad-profile shall be calculated by using
    259 !-- a beta probability density function
    260     IF ( alpha_lad /= 9999999.9_wp  .AND.  beta_lad /= 9999999.9_wp )          &
    261        calc_beta_lad_profile = .TRUE.
    262 
    263  10 CONTINUE
    264210
    265211
     
    317263
    318264
    319 !
    320 !-- Try to find radiation package
    321     REWIND ( 11 )
    322     line = ' '
    323     DO   WHILE ( INDEX( line, '&radiation_par' ) == 0 )
    324        READ ( 11, '(A)', END=51 )  line
    325     ENDDO
    326     BACKSPACE ( 11 )
    327 
    328 !
    329 !-- Read user-defined namelist
    330     READ ( 11, radiation_par )
    331 
    332 !
    333 !-- Set flag that indicates that the radiation scheme is switched on
    334     radiation = .TRUE.
    335 
    336  51 CONTINUE
    337265
    338266
  • palm/trunk/SOURCE/parin.f90

    r1818 r1826  
    1919! Current revisions:
    2020! -----------------
    21 !
     21! Added call to radiation model for reading of &radiation_par.
     22! Added call to plant canopy model for reading of &canopy_par.
    2223!
    2324! Former revisions:
     
    2627!
    2728! 1817 2016-04-06 15:44:20Z maronga
    28 ! Added call to land surface model for reading of &lsmpar
     29! Added call to land surface model for reading of &lsm_par
    2930!
    3031! 1804 2016-04-05 16:30:18Z maronga
     
    191192               vg
    192193
     194    USE plant_canopy_model_mod,                                                &
     195         ONLY: pcm_parin 
     196 
    193197    USE cloud_parameters,                                                      &
    194198        ONLY:  c_sedimentation, curvature_solution_effects,                    &
     
    232236        ONLY :  batch_job
    233237
     238     USE radiation_model_mod,                                                  &
     239         ONLY: radiation_parin 
     240       
    234241    USE statistics,                                                            &
    235242        ONLY:  hom, hom_sum, pr_palm, region, statistic_regions
     
    458465         
    459466!
    460 !--       Check if land surface model is used and read &lsmpar if required
     467!--       Check if land surface model is used and read &lsm_par if required
    461468          CALL lsm_parin
    462          
    463          
     469 
     470!
     471!--       Check if radiation model is used and read &radiation_par if required
     472          CALL radiation_parin
     473 
     474 
     475!--       Check if plant canopy model is used and read &canopy_par if required
     476          CALL pcm_parin
     477 
    464478!
    465479!--       Read control parameters for optionally used model software packages
  • palm/trunk/SOURCE/plant_canopy_model_mod.f90

    r1823 r1826  
    1 !> @file plant_canopy_model.f90
     1!> @file plant_canopy_model_mod.f90
    22!--------------------------------------------------------------------------------!
    33! This file is part of PALM.
     
    1919! Current revisions:
    2020! -----------------
    21 !
     21! Further modularization
    2222!
    2323! Former revisions:
     
    3535! Changes due to new module structure of the plant canopy model:
    3636!   module plant_canopy_model_mod now contains a subroutine for the
    37 !   initialization of the canopy model (init_plant_canopy),
     37!   initialization of the canopy model (pcm_init),
    3838!   limitation of the canopy drag (previously accounted for by calculation of
    3939!   a limiting canopy timestep for the determination of the maximum LES timestep
    4040!   in subroutine timestep) is now realized by the calculation of pre-tendencies
    41 !   and preliminary velocities in subroutine plant_canopy_model,
    42 !   some redundant MPI communication removed in subroutine init_plant_canopy
     41!   and preliminary velocities in subroutine pcm_tendency,
     42!   some redundant MPI communication removed in subroutine pcm_init
    4343!   (was previously in init_3d_model),
    4444!   unnecessary 3d-arrays lad_u, lad_v, lad_w removed - lad information on the
     
    7373! ------------
    7474!> 1) Initialization of the canopy model, e.g. construction of leaf area density
    75 !> profile (subroutine init_plant_canopy).
     75!> profile (subroutine pcm_init).
    7676!> 2) Calculation of sinks and sources of momentum, heat and scalar concentration
    77 !> due to canopy elements (subroutine plant_canopy_model).
     77!> due to canopy elements (subroutine pcm_tendency).
    7878!------------------------------------------------------------------------------!
    7979 MODULE plant_canopy_model_mod
     
    134134
    135135    PRIVATE
    136     PUBLIC alpha_lad, beta_lad, calc_beta_lad_profile, canopy_drag_coeff,      &
    137            canopy_mode, cdc, cthf, dt_plant_canopy, init_plant_canopy, lad,    &
    138            lad_s, lad_surface, lad_vertical_gradient,                          &
    139            lad_vertical_gradient_level, lad_vertical_gradient_level_ind,       &
    140            lai_beta, leaf_scalar_exch_coeff, leaf_surface_conc, lsc, lsec,     &
    141            pch_index, plant_canopy, plant_canopy_model
    142 
    143 
    144     INTERFACE init_plant_canopy
    145        MODULE PROCEDURE init_plant_canopy
    146     END INTERFACE init_plant_canopy
    147 
    148     INTERFACE plant_canopy_model
    149        MODULE PROCEDURE plant_canopy_model
    150        MODULE PROCEDURE plant_canopy_model_ij
    151     END INTERFACE plant_canopy_model
    152 
    153 
     136 
     137!
     138!-- Public functions
     139    PUBLIC pcm_check_parameters, pcm_header, pcm_init, pcm_parin, pcm_tendency
     140
     141!
     142!-- Public variables and constants
     143    PUBLIC canopy_mode, cthf, dt_plant_canopy, plant_canopy
     144
     145
     146    INTERFACE pcm_check_parameters
     147       MODULE PROCEDURE pcm_check_parameters
     148    END INTERFACE pcm_check_parameters     
     149   
     150     INTERFACE pcm_header
     151       MODULE PROCEDURE pcm_header
     152    END INTERFACE pcm_header       
     153   
     154    INTERFACE pcm_init
     155       MODULE PROCEDURE pcm_init
     156    END INTERFACE pcm_init
     157
     158    INTERFACE pcm_parin
     159       MODULE PROCEDURE pcm_parin
     160    END INTERFACE pcm_parin 
     161   
     162    INTERFACE pcm_tendency
     163       MODULE PROCEDURE pcm_tendency
     164       MODULE PROCEDURE pcm_tendency_ij
     165    END INTERFACE pcm_tendency
    154166
    155167
    156168 CONTAINS
    157169
    158 
     170 
     171!------------------------------------------------------------------------------!
     172! Description:
     173! ------------
     174!> Check parameters routine for plant canopy model
     175!------------------------------------------------------------------------------!
     176    SUBROUTINE pcm_check_parameters
     177
     178       USE control_parameters,                                                 &
     179           ONLY: cloud_physics, message_string, microphysics_seifert
     180                 
     181   
     182       IMPLICIT NONE
     183
     184   
     185       IF ( canopy_drag_coeff == 0.0_wp )  THEN
     186          message_string = 'plant_canopy = .TRUE. requires a non-zero drag '// &
     187                           'coefficient & given value is canopy_drag_coeff = 0.0'
     188          CALL message( 'check_parameters', 'PA0041', 1, 2, 0, 6, 0 )
     189       ENDIF
     190   
     191       IF ( ( alpha_lad /= 9999999.9_wp  .AND.  beta_lad == 9999999.9_wp )  .OR.&
     192              beta_lad /= 9999999.9_wp   .AND.  alpha_lad == 9999999.9_wp )  THEN
     193          message_string = 'using the beta function for the construction ' //  &
     194                           'of the leaf area density profile requires '    //  &
     195                           'both alpha_lad and beta_lad to be /= 9999999.9'
     196          CALL message( 'check_parameters', 'PA0118', 1, 2, 0, 6, 0 )
     197       ENDIF
     198   
     199       IF ( calc_beta_lad_profile  .AND.  lai_beta == 0.0_wp )  THEN
     200          message_string = 'using the beta function for the construction ' //  &
     201                           'of the leaf area density profile requires '    //  &
     202                           'a non-zero lai_beta, but given value is '      //  &
     203                           'lai_beta = 0.0'
     204          CALL message( 'check_parameters', 'PA0119', 1, 2, 0, 6, 0 )
     205       ENDIF
     206
     207       IF ( calc_beta_lad_profile  .AND.  lad_surface /= 0.0_wp )  THEN
     208          message_string = 'simultaneous setting of alpha_lad /= 9999999.9' // &
     209                           'and lad_surface /= 0.0 is not possible, '       // &
     210                           'use either vertical gradients or the beta '     // &
     211                           'function for the construction of the leaf area '// &
     212                           'density profile'
     213          CALL message( 'check_parameters', 'PA0120', 1, 2, 0, 6, 0 )
     214       ENDIF
     215
     216       IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
     217          message_string = 'plant_canopy = .TRUE. requires cloud_scheme /=' // &
     218                          ' seifert_beheng'
     219          CALL message( 'check_parameters', 'PA0360', 1, 2, 0, 6, 0 )
     220       ENDIF
     221
     222 
     223    END SUBROUTINE pcm_check_parameters
     224 
     225
     226!------------------------------------------------------------------------------!
     227! Description:
     228! ------------
     229!> Header output for plant canopy model
     230!------------------------------------------------------------------------------!
     231    SUBROUTINE pcm_header ( io )
     232
     233       USE control_parameters,                                                 &
     234           ONLY: dz, passive_scalar
     235
     236
     237       IMPLICIT NONE
     238 
     239       CHARACTER (LEN=10) ::  coor_chr            !<
     240
     241       CHARACTER (LEN=86) ::  coordinates         !<
     242       CHARACTER (LEN=86) ::  gradients           !<
     243       CHARACTER (LEN=86) ::  leaf_area_density   !<
     244       CHARACTER (LEN=86) ::  slices              !<
     245 
     246       INTEGER(iwp) :: i                !<
     247       INTEGER(iwp),  INTENT(IN) ::  io !< Unit of the output file
     248       INTEGER(iwp) :: k                !<       
     249   
     250       REAL(wp) ::  canopy_height       !< canopy height (in m)
     251       
     252       canopy_height = pch_index * dz
     253
     254       WRITE ( io, 1 )  canopy_mode, canopy_height, pch_index,                 &
     255                          canopy_drag_coeff
     256       IF ( passive_scalar )  THEN
     257          WRITE ( io, 2 )  leaf_scalar_exch_coeff,                             &
     258                             leaf_surface_conc
     259       ENDIF
     260
     261!
     262!--    Heat flux at the top of vegetation
     263       WRITE ( io, 3 )  cthf
     264
     265!
     266!--    Leaf area density profile, calculated either from given vertical
     267!--    gradients or from beta probability density function.
     268       IF (  .NOT.  calc_beta_lad_profile )  THEN
     269
     270!--       Building output strings, starting with surface value
     271          WRITE ( leaf_area_density, '(F7.4)' )  lad_surface
     272          gradients = '------'
     273          slices = '     0'
     274          coordinates = '   0.0'
     275          i = 1
     276          DO  WHILE ( i < 11  .AND.  lad_vertical_gradient_level_ind(i)        &
     277                      /= -9999 )
     278
     279             WRITE (coor_chr,'(F7.2)')  lad(lad_vertical_gradient_level_ind(i))
     280             leaf_area_density = TRIM( leaf_area_density ) // ' ' //           &
     281                                 TRIM( coor_chr )
     282 
     283             WRITE (coor_chr,'(F7.2)')  lad_vertical_gradient(i)
     284             gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
     285
     286             WRITE (coor_chr,'(I7)')  lad_vertical_gradient_level_ind(i)
     287             slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
     288
     289             WRITE (coor_chr,'(F7.1)')  lad_vertical_gradient_level(i)
     290             coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
     291
     292             i = i + 1
     293          ENDDO
     294
     295          WRITE ( io, 4 )  TRIM( coordinates ), TRIM( leaf_area_density ),     &
     296                             TRIM( gradients ), TRIM( slices )
     297
     298       ELSE
     299       
     300          WRITE ( leaf_area_density, '(F7.4)' )  lad_surface
     301          coordinates = '   0.0'
     302         
     303          DO  k = 1, pch_index
     304
     305             WRITE (coor_chr,'(F7.2)')  lad(k)
     306             leaf_area_density = TRIM( leaf_area_density ) // ' ' //           &
     307                                 TRIM( coor_chr )
     308 
     309             WRITE (coor_chr,'(F7.1)')  zu(k)
     310             coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
     311
     312          ENDDO       
     313
     314          WRITE ( io, 5 ) TRIM( coordinates ), TRIM( leaf_area_density ),      &
     315                          alpha_lad, beta_lad, lai_beta
     316
     317       ENDIF 
     318
     3191 FORMAT (//' Vegetation canopy (drag) model:'/                                &
     320              ' ------------------------------'//                              &
     321              ' Canopy mode: ', A /                                            &
     322              ' Canopy height: ',F6.2,'m (',I4,' grid points)' /               &
     323              ' Leaf drag coefficient: ',F6.2 /)
     3242 FORMAT (/ ' Scalar exchange coefficient: ',F6.2 /                            &
     325              ' Scalar concentration at leaf surfaces in kg/m**3: ',F6.2 /)
     3263 FORMAT (' Predefined constant heatflux at the top of the vegetation: ',F6.2, &
     327          ' K m/s')
     3284 FORMAT (/ ' Characteristic levels of the leaf area density:'//               &
     329              ' Height:              ',A,'  m'/                                &
     330              ' Leaf area density:   ',A,'  m**2/m**3'/                        &
     331              ' Gradient:            ',A,'  m**2/m**4'/                        &
     332              ' Gridpoint:           ',A)
     3335 FORMAT (//' Characteristic levels of the leaf area density and coefficients:'&
     334          //  ' Height:              ',A,'  m'/                                &
     335              ' Leaf area density:   ',A,'  m**2/m**3'/                        &
     336              ' Coefficient alpha: ',F6.2 /                                    &
     337              ' Coefficient beta: ',F6.2 /                                     &
     338              ' Leaf area index: ',F6.2,'  m**2/m**2' /)   
     339       
     340    END SUBROUTINE pcm_header
     341 
     342 
    159343!------------------------------------------------------------------------------!
    160344! Description:
     
    162346!> Initialization of the plant canopy model
    163347!------------------------------------------------------------------------------!
    164     SUBROUTINE init_plant_canopy
     348    SUBROUTINE pcm_init
    165349   
    166350
     
    187371       pre_lad = 0.0_wp
    188372
     373!
     374!--    Set flag that indicates that the lad-profile shall be calculated by using
     375!--    a beta probability density function
     376       IF ( alpha_lad /= 9999999.9_wp  .AND.  beta_lad /= 9999999.9_wp )  THEN
     377          calc_beta_lad_profile = .TRUE.
     378       ENDIF
     379       
     380       
    189381!
    190382!--    Compute the profile of leaf area density used in the plant
     
    244436          DO k = nzb, pch_index
    245437             int_bpdf = int_bpdf +                                             &
    246                            ( ( ( zw(k) / canopy_height )**( alpha_lad-1.0_wp ) ) * &
    247                            ( ( 1.0_wp - ( zw(k) / canopy_height ) )**( beta_lad-1.0_wp ) ) *   &
    248                            ( ( zw(k+1)-zw(k) ) / canopy_height ) )
     438                      ( ( ( zw(k) / canopy_height )**( alpha_lad-1.0_wp ) ) *  &
     439                      ( ( 1.0_wp - ( zw(k) / canopy_height ) )**(              &
     440                          beta_lad-1.0_wp ) )                                  &
     441                      * ( ( zw(k+1)-zw(k) ) / canopy_height ) )
    249442          ENDDO
    250443
     
    252445!--       Preliminary lad profile (defined on w-grid)
    253446          DO k = nzb, pch_index
    254              pre_lad(k) =  lai_beta *                                              &
    255                            (   ( ( zw(k) / canopy_height )**( alpha_lad-1.0_wp ) ) *          &
    256                                ( ( 1.0_wp - ( zw(k) / canopy_height ) )**( beta_lad-1.0_wp ) ) /   &
    257                                int_bpdf                                            &
    258                            ) / canopy_height
     447             pre_lad(k) =  lai_beta *                                          &
     448                        ( ( ( zw(k) / canopy_height )**( alpha_lad-1.0_wp ) )  &
     449                        * ( ( 1.0_wp - ( zw(k) / canopy_height ) )**(          &
     450                              beta_lad-1.0_wp ) ) / int_bpdf                   &
     451                        ) / canopy_height
    259452          ENDDO
    260453
     
    376569
    377570
    378     END SUBROUTINE init_plant_canopy
     571    END SUBROUTINE pcm_init
    379572
    380573
     
    387580!>
    388581!> The canopy is located where the leaf area density lad_s(k,j,i) > 0.0
    389 !> (defined on scalar grid), as initialized in subroutine init_plant_canopy.
     582!> (defined on scalar grid), as initialized in subroutine pcm_init.
    390583!> The lad on the w-grid is vertically interpolated from the surrounding
    391584!> lad_s. The upper boundary of the canopy is defined on the w-grid at
     
    404597!> Call for all grid points
    405598!------------------------------------------------------------------------------!
    406     SUBROUTINE plant_canopy_model( component )
     599    SUBROUTINE pcm_tendency( component )
    407600
    408601
     
    672865
    673866             WRITE( message_string, * ) 'wrong component: ', component
    674              CALL message( 'plant_canopy_model', 'PA0279', 1, 2, 0, 6, 0 )
     867             CALL message( 'pcm_tendency', 'PA0279', 1, 2, 0, 6, 0 )
    675868
    676869       END SELECT
    677870
    678     END SUBROUTINE plant_canopy_model
     871    END SUBROUTINE pcm_tendency
     872
     873
     874!------------------------------------------------------------------------------!
     875! Description:
     876! ------------
     877!> Parin for &canopy_par for plant canopy model
     878!------------------------------------------------------------------------------!
     879    SUBROUTINE pcm_parin
     880
     881
     882       IMPLICIT NONE
     883
     884       CHARACTER (LEN=80) ::  line  !< dummy string that contains the current line of the parameter file
     885       
     886        NAMELIST /canopy_par/     alpha_lad, beta_lad, canopy_drag_coeff,      &
     887                                  canopy_mode, cthf,                           &
     888                                  lad_surface,                                 &
     889                                  lad_vertical_gradient,                       &
     890                                  lad_vertical_gradient_level,                 &
     891                                  lai_beta,                                    &
     892                                  leaf_scalar_exch_coeff,                      &
     893                                  leaf_surface_conc, pch_index
     894       
     895       line = ' '
     896       
     897!
     898!--    Try to find radiation model package
     899       REWIND ( 11 )
     900       line = ' '
     901       DO   WHILE ( INDEX( line, '&canopy_par' ) == 0 )
     902          READ ( 11, '(A)', END=10 )  line
     903       ENDDO
     904       BACKSPACE ( 11 )
     905
     906!
     907!--    Read user-defined namelist
     908       READ ( 11, canopy_par )
     909
     910!
     911!--    Set flag that indicates that the radiation model is switched on
     912       plant_canopy = .TRUE.
     913
     914 10    CONTINUE
     915       
     916
     917    END SUBROUTINE pcm_parin   
     918   
    679919
    680920
     
    686926!>
    687927!> The canopy is located where the leaf area density lad_s(k,j,i) > 0.0
    688 !> (defined on scalar grid), as initialized in subroutine init_plant_canopy.
     928!> (defined on scalar grid), as initialized in subroutine pcm_init.
    689929!> The lad on the w-grid is vertically interpolated from the surrounding
    690930!> lad_s. The upper boundary of the canopy is defined on the w-grid at
     
    703943!> Call for grid point i,j
    704944!------------------------------------------------------------------------------!
    705     SUBROUTINE plant_canopy_model_ij( i, j, component )
     945    SUBROUTINE pcm_tendency_ij( i, j, component )
    706946
    707947
     
    9441184
    9451185          WRITE( message_string, * ) 'wrong component: ', component
    946           CALL message( 'plant_canopy_model', 'PA0279', 1, 2, 0, 6, 0 )
     1186          CALL message( 'pcm_tendency', 'PA0279', 1, 2, 0, 6, 0 )
    9471187
    9481188       END SELECT
    9491189
    950     END SUBROUTINE plant_canopy_model_ij
     1190    END SUBROUTINE pcm_tendency_ij
    9511191
    9521192 END MODULE plant_canopy_model_mod
  • palm/trunk/SOURCE/prognostic_equations.f90

    r1823 r1826  
    1919! Current revisions:
    2020! ------------------
    21 !
     21! Renamed canopy model calls.
    2222!
    2323! Former revisions:
     
    284284
    285285    USE plant_canopy_model_mod,                                                &
    286         ONLY:  cthf, plant_canopy, plant_canopy_model
     286        ONLY:  cthf, plant_canopy, pcm_tendency
    287287
    288288    USE production_e_mod,                                                      &
     
    403403!
    404404!--          Drag by plant canopy
    405              IF ( plant_canopy )  CALL plant_canopy_model( i, j, 1 )
     405             IF ( plant_canopy )  CALL pcm_tendency( i, j, 1 )
    406406
    407407!
     
    462462!
    463463!--          Drag by plant canopy
    464              IF ( plant_canopy )  CALL plant_canopy_model( i, j, 2 )       
     464             IF ( plant_canopy )  CALL pcm_tendency( i, j, 2 )       
    465465
    466466!
     
    531531!
    532532!--       Drag by plant canopy
    533           IF ( plant_canopy )  CALL plant_canopy_model( i, j, 3 )
     533          IF ( plant_canopy )  CALL pcm_tendency( i, j, 3 )
    534534
    535535          CALL user_actions( i, j, 'w-tendency' )
     
    586586!--          Consideration of heat sources within the plant canopy
    587587             IF ( plant_canopy  .AND.  cthf /= 0.0_wp )  THEN
    588                 CALL plant_canopy_model( i, j, 4 )
     588                CALL pcm_tendency( i, j, 4 )
    589589             ENDIF
    590590
     
    720720!
    721721!--          Sink or source of scalar concentration due to canopy elements
    722              IF ( plant_canopy )  CALL plant_canopy_model( i, j, 5 )
     722             IF ( plant_canopy )  CALL pcm_tendency( i, j, 5 )
    723723
    724724!
     
    888888!
    889889!--          Additional sink term for flows through plant canopies
    890              IF ( plant_canopy )  CALL plant_canopy_model( i, j, 6 )
     890             IF ( plant_canopy )  CALL pcm_tendency( i, j, 6 )
    891891
    892892             CALL user_actions( i, j, 'e-tendency' )
     
    982982!
    983983!-- Drag by plant canopy
    984     IF ( plant_canopy )  CALL plant_canopy_model( 1 )
     984    IF ( plant_canopy )  CALL pcm_tendency( 1 )
    985985
    986986!
     
    10581058!
    10591059!-- Drag by plant canopy
    1060     IF ( plant_canopy )  CALL plant_canopy_model( 2 )
     1060    IF ( plant_canopy )  CALL pcm_tendency( 2 )
    10611061
    10621062!
     
    11461146!
    11471147!-- Drag by plant canopy
    1148     IF ( plant_canopy )  CALL plant_canopy_model( 3 )
     1148    IF ( plant_canopy )  CALL pcm_tendency( 3 )
    11491149
    11501150    CALL user_actions( 'w-tendency' )
     
    12351235!--    Consideration of heat sources within the plant canopy
    12361236       IF ( plant_canopy .AND. ( cthf /= 0.0_wp ) ) THEN
    1237           CALL plant_canopy_model( 4 )
     1237          CALL pcm_tendency( 4 )
    12381238       ENDIF
    12391239
     
    14331433!
    14341434!--    Sink or source of scalar concentration due to canopy elements
    1435        IF ( plant_canopy ) CALL plant_canopy_model( 5 )
     1435       IF ( plant_canopy ) CALL pcm_tendency( 5 )
    14361436
    14371437!
     
    15311531
    15321532          CALL diffusion_s( qr, qrsws, qrswst, wall_qrflux )
     1533
     1534          CALL user_actions( 'qr-tendency' )
    15331535
    15341536!
     
    17031705!
    17041706!--    Additional sink term for flows through plant canopies
    1705        IF ( plant_canopy )  CALL plant_canopy_model( 6 )
     1707       IF ( plant_canopy )  CALL pcm_tendency( 6 )
    17061708       CALL user_actions( 'e-tendency' )
    17071709
     
    18161818!
    18171819!-- Drag by plant canopy
    1818     IF ( plant_canopy )  CALL plant_canopy_model( 1 )
     1820    IF ( plant_canopy )  CALL pcm_tendency( 1 )
    18191821
    18201822!
     
    18831885!
    18841886!-- Drag by plant canopy
    1885     IF ( plant_canopy )  CALL plant_canopy_model( 2 )
     1887    IF ( plant_canopy )  CALL pcm_tendency( 2 )
    18861888
    18871889!
     
    19621964!
    19631965!-- Drag by plant canopy
    1964     IF ( plant_canopy )  CALL plant_canopy_model( 3 )
     1966    IF ( plant_canopy )  CALL pcm_tendency( 3 )
    19651967
    19661968    CALL user_actions( 'w-tendency' )
     
    20432045!--    Consideration of heat sources within the plant canopy
    20442046       IF ( plant_canopy .AND. ( cthf /= 0.0_wp ) ) THEN
    2045           CALL plant_canopy_model( 4 )
     2047          CALL pcm_tendency( 4 )
    20462048       ENDIF
    20472049
     
    22132215!
    22142216!--    Sink or source of scalar concentration due to canopy elements
    2215        IF ( plant_canopy ) CALL plant_canopy_model( 5 )
     2217       IF ( plant_canopy ) CALL pcm_tendency( 5 )
    22162218
    22172219!
     
    24352437!
    24362438!--    Additional sink term for flows through plant canopies
    2437        IF ( plant_canopy )  CALL plant_canopy_model( 6 )
     2439       IF ( plant_canopy )  CALL pcm_tendency( 6 )
    24382440       CALL user_actions( 'e-tendency' )
    24392441
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r1818 r1826  
    1 !> @file radiation_model.f90
     1!> @file radiation_model_mod.f90
    22!--------------------------------------------------------------------------------!
    33! This file is part of PALM.
     
    1919! Current revisions:
    2020! -----------------
    21 !
     21! Further modularization.
    2222!
    2323! Former revisions:
     
    8080! ------------
    8181!> Radiation models and interfaces
    82 !> @todo move variable definitions used in init_radiation only to the subroutine
     82!> @todo move variable definitions used in radiation_init only to the subroutine
    8383!>       as they are no longer required after initialization.
    8484!> @todo Output of full column vertical profiles used in RRTMG
     
    115115
    116116#if defined ( __rrtmg )
    117 
    118 !     USE netcdf_interface,                                                      &
    119 !         ONLY:  nc_stat, netcdf_handle_error
    120117
    121118    USE parrrsw,                                                               &
     
    353350#endif
    354351
    355     INTERFACE init_radiation
    356        MODULE PROCEDURE init_radiation
    357     END INTERFACE init_radiation
    358 
     352    INTERFACE radiation_check_data_output
     353       MODULE PROCEDURE radiation_check_data_output
     354    END INTERFACE radiation_check_data_output
     355
     356    INTERFACE radiation_check_data_output_pr
     357       MODULE PROCEDURE radiation_check_data_output_pr
     358    END INTERFACE radiation_check_data_output_pr
     359 
     360    INTERFACE radiation_check_parameters
     361       MODULE PROCEDURE radiation_check_parameters
     362    END INTERFACE radiation_check_parameters
     363 
    359364    INTERFACE radiation_clearsky
    360365       MODULE PROCEDURE radiation_clearsky
    361366    END INTERFACE radiation_clearsky
    362 
     367 
     368    INTERFACE radiation_header
     369       MODULE PROCEDURE radiation_header
     370    END INTERFACE radiation_header
     371 
     372    INTERFACE radiation_init
     373       MODULE PROCEDURE radiation_init
     374    END INTERFACE radiation_init
     375
     376    INTERFACE radiation_parin
     377       MODULE PROCEDURE radiation_parin
     378    END INTERFACE radiation_parin
     379   
    363380    INTERFACE radiation_rrtmg
    364381       MODULE PROCEDURE radiation_rrtmg
     
    374391    PRIVATE
    375392
    376     PUBLIC albedo, albedo_type, albedo_type_name, albedo_lw_dif, albedo_lw_dir,&
    377            albedo_sw_dif, albedo_sw_dir, constant_albedo, day_init, dots_rad,  &
    378            dt_radiation, emissivity, force_radiation_call, init_radiation,     &
    379            lambda, lw_radiation, net_radiation, rad_net, rad_net_av, radiation,&
    380            radiation_clearsky, radiation_rrtmg, radiation_scheme,              &
    381            radiation_tendency, rad_lw_in, rad_lw_in_av, rad_lw_out,            &
    382            rad_lw_out_av, rad_lw_out_change_0, rad_lw_cs_hr, rad_lw_cs_hr_av,  &
    383            rad_lw_hr, rad_lw_hr_av, rad_sw_in, rad_sw_in_av, rad_sw_out,       &
    384            rad_sw_out_av, rad_sw_cs_hr, rad_sw_cs_hr_av, rad_sw_hr,            &
    385            rad_sw_hr_av, sigma_sb, skip_time_do_radiation, sw_radiation,       &
    386            time_radiation, time_utc_init, unscheduled_radiation_calls
     393!
     394!-- Public functions
     395    PUBLIC radiation_check_data_output, radiation_check_data_output_pr,        &
     396           radiation_check_parameters, radiation_clearsky, radiation_header,   &
     397           radiation_init, radiation_parin, radiation_rrtmg, radiation_tendency
     398   
     399!
     400!-- Public variables and constants
     401    PUBLIC dots_rad, dt_radiation, force_radiation_call,                       &
     402           rad_net, rad_net_av, radiation, radiation_scheme, rad_lw_in,        &
     403           rad_lw_in_av, rad_lw_out, rad_lw_out_av, rad_lw_out_change_0,       &
     404           rad_lw_cs_hr, rad_lw_cs_hr_av, rad_lw_hr, rad_lw_hr_av, rad_sw_in,  &
     405           rad_sw_in_av, rad_sw_out, rad_sw_out_av, rad_sw_cs_hr,              &
     406           rad_sw_cs_hr_av, rad_sw_hr, rad_sw_hr_av, sigma_sb,                 &
     407           skip_time_do_radiation, time_radiation, unscheduled_radiation_calls
    387408
    388409
     
    396417! Description:
    397418! ------------
     419!> Check data output for radiation model
     420!------------------------------------------------------------------------------!
     421    SUBROUTINE radiation_check_data_output( var, unit, i, ilen, k )
     422 
     423 
     424       USE control_parameters,                                                 &
     425           ONLY: data_output, message_string
     426
     427       IMPLICIT NONE
     428
     429       CHARACTER (LEN=*) ::  unit     !<
     430       CHARACTER (LEN=*) ::  var      !<
     431
     432       INTEGER(iwp) :: i
     433       INTEGER(iwp) :: ilen
     434       INTEGER(iwp) :: k
     435
     436       SELECT CASE ( TRIM( var ) )
     437
     438         CASE ( 'rad_lw_in', 'rad_lw_out', 'rad_lw_cs_hr', 'rad_lw_hr',       &
     439                 'rad_sw_in', 'rad_sw_out', 'rad_sw_cs_hr', 'rad_sw_hr' )
     440             IF (  .NOT.  radiation  .OR.  radiation_scheme /= 'rrtmg' )  THEN
     441                message_string = '"output of "' // TRIM( var ) // '" requi' // &
     442                                 'res radiation = .TRUE. and ' //              &
     443                                 'radiation_scheme = "rrtmg"'
     444                CALL message( 'check_parameters', 'PA0406', 1, 2, 0, 6, 0 )
     445             ENDIF
     446             unit = 'W/m2'     
     447
     448          CASE ( 'rad_net*', 'rrtm_aldif*', 'rrtm_aldir*', 'rrtm_asdif*',      &
     449                 'rrtm_asdir*' )
     450             IF ( k == 0  .OR.  data_output(i)(ilen-2:ilen) /= '_xy' )  THEN
     451                message_string = 'illegal value for data_output: "' //         &
     452                                 TRIM( var ) // '" & only 2d-horizontal ' //   &
     453                                 'cross sections are allowed for this value'
     454                CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 )
     455             ENDIF
     456             IF (  .NOT.  radiation  .OR.  radiation_scheme /= "rrtmg" )  THEN
     457                IF ( TRIM( var ) == 'rrtm_aldif*'  .OR.                        &
     458                     TRIM( var ) == 'rrtm_aldir*'  .OR.                        &
     459                     TRIM( var ) == 'rrtm_asdif*'  .OR.                        &
     460                     TRIM( var ) == 'rrtm_asdir*'      )                       &
     461                THEN
     462                   message_string = 'output of "' // TRIM( var ) // '" require'&
     463                                    // 's radiation = .TRUE. and radiation_sch'&
     464                                    // 'eme = "rrtmg"'
     465                   CALL message( 'check_parameters', 'PA0409', 1, 2, 0, 6, 0 )
     466                ENDIF
     467             ENDIF
     468
     469             IF ( TRIM( var ) == 'rad_net*'      ) unit = 'W/m2'   
     470             IF ( TRIM( var ) == 'rrtm_aldif*'   ) unit = ''   
     471             IF ( TRIM( var ) == 'rrtm_aldir*'   ) unit = ''
     472             IF ( TRIM( var ) == 'rrtm_asdif*'   ) unit = ''
     473             IF ( TRIM( var ) == 'rrtm_asdir*'   ) unit = ''
     474
     475          CASE DEFAULT
     476             unit = 'illegal'
     477
     478       END SELECT
     479
     480
     481    END SUBROUTINE radiation_check_data_output
     482
     483!------------------------------------------------------------------------------!
     484! Description:
     485! ------------
     486!> Check data output of profiles for radiation model
     487!------------------------------------------------------------------------------! 
     488    SUBROUTINE radiation_check_data_output_pr( variable, var_count, unit, dopr_unit )
     489 
     490       USE arrays_3d,                                                          &
     491           ONLY: zu
     492
     493       USE control_parameters,                                                 &
     494           ONLY: data_output_pr, message_string
     495
     496       USE indices
     497
     498       USE profil_parameter
     499
     500       USE statistics
     501
     502       IMPLICIT NONE
     503   
     504       CHARACTER (LEN=*) ::  unit      !<
     505       CHARACTER (LEN=*) ::  variable  !<
     506       CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
     507 
     508       INTEGER(iwp) ::  user_pr_index !<
     509       INTEGER(iwp) ::  var_count     !<
     510
     511       SELECT CASE ( TRIM( variable ) )
     512       
     513         CASE ( 'rad_net' )
     514             IF ( (  .NOT.  radiation )  .OR.  radiation_scheme == 'constant' )&
     515             THEN
     516                message_string = 'data_output_pr = ' //                        &
     517                                 TRIM( data_output_pr(var_count) ) // ' is' // &
     518                                 'not available for radiation = .FALSE. or ' //&
     519                                 'radiation_scheme = "constant"'
     520                CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
     521             ELSE
     522                dopr_index(var_count) = 101
     523                dopr_unit  = 'W/m2'
     524                hom(:,2,101,:)  = SPREAD( zw, 2, statistic_regions+1 )
     525                unit = dopr_unit
     526             ENDIF
     527
     528          CASE ( 'rad_lw_in' )
     529             IF ( (  .NOT.  radiation)  .OR.  radiation_scheme == 'constant' ) &
     530             THEN
     531                message_string = 'data_output_pr = ' //                        &
     532                                 TRIM( data_output_pr(var_count) ) // ' is' // &
     533                                 'not available for radiation = .FALSE. or ' //&
     534                                 'radiation_scheme = "constant"'
     535                CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
     536             ELSE
     537                dopr_index(var_count) = 102
     538                dopr_unit  = 'W/m2'
     539                hom(:,2,102,:)  = SPREAD( zw, 2, statistic_regions+1 )
     540                unit = dopr_unit
     541             ENDIF
     542
     543          CASE ( 'rad_lw_out' )
     544             IF ( (  .NOT. radiation )  .OR.  radiation_scheme == 'constant' ) &
     545             THEN
     546                message_string = 'data_output_pr = ' //                        &
     547                                 TRIM( data_output_pr(var_count) ) // ' is' // &
     548                                 'not available for radiation = .FALSE. or ' //&
     549                                 'radiation_scheme = "constant"'
     550                CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
     551             ELSE
     552                dopr_index(var_count) = 103
     553                dopr_unit  = 'W/m2'
     554                hom(:,2,103,:)  = SPREAD( zw, 2, statistic_regions+1 )
     555                unit = dopr_unit   
     556             ENDIF
     557
     558          CASE ( 'rad_sw_in' )
     559             IF ( (  .NOT. radiation )  .OR.  radiation_scheme == 'constant' ) &
     560             THEN
     561                message_string = 'data_output_pr = ' //                        &
     562                                 TRIM( data_output_pr(var_count) ) // ' is' // &
     563                                 'not available for radiation = .FALSE. or ' //&
     564                                 'radiation_scheme = "constant"'
     565                CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
     566             ELSE
     567                dopr_index(var_count) = 104
     568                dopr_unit  = 'W/m2'
     569                hom(:,2,104,:)  = SPREAD( zw, 2, statistic_regions+1 )
     570                unit = dopr_unit
     571             ENDIF
     572
     573          CASE ( 'rad_sw_out')
     574             IF ( (  .NOT.  radiation )  .OR.  radiation_scheme == 'constant' )&
     575             THEN
     576                message_string = 'data_output_pr = ' //                        &
     577                                 TRIM( data_output_pr(var_count) ) // ' is' // &
     578                                 'not available for radiation = .FALSE. or ' //&
     579                                 'radiation_scheme = "constant"'
     580                CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 )
     581             ELSE
     582                dopr_index(var_count) = 105
     583                dopr_unit  = 'W/m2'
     584                hom(:,2,105,:)  = SPREAD( zw, 2, statistic_regions+1 )
     585                unit = dopr_unit
     586             ENDIF
     587
     588          CASE ( 'rad_lw_cs_hr' )
     589             IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )   &
     590             THEN
     591                message_string = 'data_output_pr = ' //                        &
     592                                 TRIM( data_output_pr(var_count) ) // ' is' // &
     593                                 'not available for radiation = .FALSE. or ' //&
     594                                 'radiation_scheme /= "rrtmg"'
     595                CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
     596             ELSE
     597                dopr_index(var_count) = 106
     598                dopr_unit  = 'K/h'
     599                hom(:,2,106,:)  = SPREAD( zu, 2, statistic_regions+1 )
     600                unit = dopr_unit
     601             ENDIF
     602
     603          CASE ( 'rad_lw_hr' )
     604             IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )   &
     605             THEN
     606                message_string = 'data_output_pr = ' //                        &
     607                                 TRIM( data_output_pr(var_count) ) // ' is' // &
     608                                 'not available for radiation = .FALSE. or ' //&
     609                                 'radiation_scheme /= "rrtmg"'
     610                CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
     611             ELSE
     612                dopr_index(var_count) = 107
     613                dopr_unit  = 'K/h'
     614                hom(:,2,107,:)  = SPREAD( zu, 2, statistic_regions+1 )
     615                unit = dopr_unit
     616             ENDIF
     617
     618          CASE ( 'rad_sw_cs_hr' )
     619             IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )   &
     620             THEN
     621                message_string = 'data_output_pr = ' //                        &
     622                                 TRIM( data_output_pr(var_count) ) // ' is' // &
     623                                 'not available for radiation = .FALSE. or ' //&
     624                                 'radiation_scheme /= "rrtmg"'
     625                CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
     626             ELSE
     627                dopr_index(var_count) = 108
     628                dopr_unit  = 'K/h'
     629                hom(:,2,108,:)  = SPREAD( zu, 2, statistic_regions+1 )
     630                unit = dopr_unit
     631             ENDIF
     632
     633          CASE ( 'rad_sw_hr' )
     634             IF ( (  .NOT.  radiation )  .OR.  radiation_scheme /= 'rrtmg' )   &
     635             THEN
     636                message_string = 'data_output_pr = ' //                        &
     637                                 TRIM( data_output_pr(var_count) ) // ' is' // &
     638                                 'not available for radiation = .FALSE. or ' //&
     639                                 'radiation_scheme /= "rrtmg"'
     640                CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 )
     641             ELSE
     642                dopr_index(var_count) = 109
     643                dopr_unit  = 'K/h'
     644                hom(:,2,109,:)  = SPREAD( zu, 2, statistic_regions+1 )
     645                unit = dopr_unit
     646             ENDIF
     647
     648
     649          CASE DEFAULT
     650             unit = 'illegal'
     651
     652       END SELECT
     653
     654
     655    END SUBROUTINE radiation_check_data_output_pr
     656 
     657 
     658!------------------------------------------------------------------------------!
     659! Description:
     660! ------------
     661!> Check parameters routine for radiation model
     662!------------------------------------------------------------------------------!
     663    SUBROUTINE radiation_check_parameters
     664
     665       USE control_parameters,                                                 &
     666           ONLY: message_string, topography
     667                 
     668   
     669       IMPLICIT NONE
     670
     671       IF ( radiation_scheme /= 'constant'   .AND.                             &
     672            radiation_scheme /= 'clear-sky'  .AND.                             &
     673            radiation_scheme /= 'rrtmg' )  THEN
     674          message_string = 'unknown radiation_scheme = '//                     &
     675                           TRIM( radiation_scheme )
     676          CALL message( 'check_parameters', 'PA0405', 1, 2, 0, 6, 0 )
     677       ELSEIF ( radiation_scheme == 'rrtmg' )  THEN
     678#if ! defined ( __rrtmg )
     679          message_string = 'radiation_scheme = "rrtmg" requires ' //           &
     680                           'compilation of PALM with pre-processor ' //        &
     681                           'directive -D__rrtmg'
     682          CALL message( 'check_parameters', 'PA0407', 1, 2, 0, 6, 0 )
     683#endif
     684#if defined ( __rrtmg ) && ! defined( __netcdf )
     685          message_string = 'radiation_scheme = "rrtmg" requires ' //           &
     686                           'the use of NetCDF (preprocessor directive ' //     &
     687                           '-D__netcdf'
     688          CALL message( 'check_parameters', 'PA0412', 1, 2, 0, 6, 0 )
     689#endif
     690
     691       ENDIF
     692
     693       IF ( albedo_type == 0  .AND.  albedo == 9999999.9_wp  .AND.             &
     694            radiation_scheme == 'clear-sky')  THEN
     695          message_string = 'radiation_scheme = "clear-sky" in combination' //  &
     696                           'with albedo_type = 0 requires setting of albedo'// &
     697                           ' /= 9999999.9'
     698          CALL message( 'check_parameters', 'PA0410', 1, 2, 0, 6, 0 )
     699       ENDIF
     700
     701       IF ( albedo_type == 0  .AND.  radiation_scheme == 'rrtmg'  .AND.        &
     702          (    albedo_lw_dif == 9999999.9_wp .OR. albedo_lw_dir == 9999999.9_wp&
     703          .OR. albedo_sw_dif == 9999999.9_wp .OR. albedo_sw_dir == 9999999.9_wp&
     704          ) ) THEN
     705          message_string = 'radiation_scheme = "rrtmg" in combination' //      &
     706                           'with albedo_type = 0 requires setting of ' //      &
     707                           'albedo_lw_dif /= 9999999.9' //                     &
     708                           'albedo_lw_dir /= 9999999.9' //                     &
     709                           'albedo_sw_dif /= 9999999.9 and' //                 &
     710                           'albedo_sw_dir /= 9999999.9'
     711          CALL message( 'check_parameters', 'PA0411', 1, 2, 0, 6, 0 )
     712       ENDIF
     713
     714       IF ( topography /= 'flat' )  THEN
     715          message_string = 'radiation scheme cannot be used ' //               &
     716                           'in combination with  topography /= "flat"'
     717          CALL message( 'check_parameters', 'PA0414', 1, 2, 0, 6, 0 )
     718       ENDIF
     719 
     720    END SUBROUTINE radiation_check_parameters
     721 
     722 
     723!------------------------------------------------------------------------------!
     724! Description:
     725! ------------
    398726!> Initialization of the radiation model
    399727!------------------------------------------------------------------------------!
    400     SUBROUTINE init_radiation
     728    SUBROUTINE radiation_init
    401729   
    402730       IMPLICIT NONE
     
    661989       RETURN
    662990
    663     END SUBROUTINE init_radiation
     991    END SUBROUTINE radiation_init
    664992
    665993
     
    7191047
    7201048    END SUBROUTINE radiation_clearsky
     1049
     1050
     1051!------------------------------------------------------------------------------!
     1052! Description:
     1053! ------------
     1054!> Header output for radiation model
     1055!------------------------------------------------------------------------------!
     1056    SUBROUTINE radiation_header ( io )
     1057
     1058
     1059       IMPLICIT NONE
     1060 
     1061       INTEGER(iwp), INTENT(IN) ::  io            !< Unit of the output file
     1062   
     1063
     1064       
     1065!
     1066!--    Write radiation model header
     1067       WRITE( io, 3 )
     1068
     1069       IF ( radiation_scheme == "constant" )  THEN
     1070          WRITE( io, 4 ) net_radiation
     1071       ELSEIF ( radiation_scheme == "clear-sky" )  THEN
     1072          WRITE( io, 5 )
     1073       ELSEIF ( radiation_scheme == "rrtmg" )  THEN
     1074          WRITE( io, 6 )
     1075          IF ( .NOT. lw_radiation )  WRITE( io, 10 )
     1076          IF ( .NOT. sw_radiation )  WRITE( io, 11 )
     1077       ENDIF
     1078
     1079       IF ( albedo_type == 0 )  THEN
     1080          WRITE( io, 7 ) albedo
     1081       ELSE
     1082          WRITE( io, 8 ) TRIM( albedo_type_name(albedo_type) )
     1083       ENDIF
     1084       IF ( constant_albedo )  THEN
     1085          WRITE( io, 9 )
     1086       ENDIF
     1087       
     1088       IF ( radiation .AND. radiation_scheme /= 'constant' )  THEN
     1089          WRITE ( io, 1 )  lambda
     1090          WRITE ( io, 2 )  day_init, time_utc_init
     1091       ENDIF
     1092
     1093       WRITE( io, 12 ) dt_radiation
     1094 
     1095
     1096 1 FORMAT ('    Geograph. longitude            :   lambda = ',F4.1,' degr')
     1097 2 FORMAT ('    Day of the year at model start :   day_init = ',I3   &
     1098            /'    UTC time at model start        :   time_utc_init = ',F7.1' s')
     1099 3 FORMAT (//' Radiation model information:'/                                  &
     1100              ' ----------------------------'/)
     1101 4 FORMAT ('    --> Using constant net radiation: net_radiation = ', F6.2,        &
     1102           // 'W/m**2')
     1103 5 FORMAT ('    --> Simple radiation scheme for clear sky is used (no clouds,',   &
     1104                   ' default)')
     1105 6 FORMAT ('    --> RRTMG scheme is used')
     1106 7 FORMAT (/'    User-specific surface albedo: albedo =', F6.3)
     1107 8 FORMAT (/'    Albedo is set for land surface type: ', A)
     1108 9 FORMAT (/'    --> Albedo is fixed during the run')
     110910 FORMAT (/'    --> Longwave radiation is disabled')
     111011 FORMAT (/'    --> Shortwave radiation is disabled.')
     111112 FORMAT  ('    Timestep: dt_radiation = ', F6.2, '  s')
     1112
     1113
     1114    END SUBROUTINE radiation_header
     1115   
     1116
     1117!------------------------------------------------------------------------------!
     1118! Description:
     1119! ------------
     1120!> Parin for &radiation_par for radiation model
     1121!------------------------------------------------------------------------------!
     1122    SUBROUTINE radiation_parin
     1123
     1124
     1125       IMPLICIT NONE
     1126
     1127       CHARACTER (LEN=80) ::  line  !< dummy string that contains the current line of the parameter file
     1128       
     1129       NAMELIST /radiation_par/   albedo, albedo_type, albedo_lw_dir,          &
     1130                                  albedo_lw_dif, albedo_sw_dir, albedo_sw_dif, &
     1131                                  constant_albedo, day_init, dt_radiation,     &
     1132                                  lambda, lw_radiation, net_radiation,         &
     1133                                  radiation_scheme, skip_time_do_radiation,    &
     1134                                  sw_radiation, time_utc_init,                 &
     1135                                  unscheduled_radiation_calls
     1136       
     1137       line = ' '
     1138       
     1139!
     1140!--    Try to find radiation model package
     1141       REWIND ( 11 )
     1142       line = ' '
     1143       DO   WHILE ( INDEX( line, '&radiation_par' ) == 0 )
     1144          READ ( 11, '(A)', END=10 )  line
     1145       ENDDO
     1146       BACKSPACE ( 11 )
     1147
     1148!
     1149!--    Read user-defined namelist
     1150       READ ( 11, radiation_par )
     1151
     1152!
     1153!--    Set flag that indicates that the radiation model is switched on
     1154       radiation = .TRUE.
     1155
     1156 10    CONTINUE
     1157       
     1158
     1159    END SUBROUTINE radiation_parin
    7211160
    7221161
     
    16082047    END SUBROUTINE read_trace_gas_data
    16092048
     2049
    16102050    SUBROUTINE netcdf_handle_error_rad( routine_name, errno )
    16112051
Note: See TracChangeset for help on using the changeset viewer.