Changeset 1826
- Timestamp:
- Apr 7, 2016 12:01:39 PM (8 years ago)
- Location:
- palm/trunk
- Files:
-
- 9 edited
- 2 moved
-
SCRIPTS/mbuild (modified) (2 diffs)
-
SOURCE/Makefile (modified) (13 diffs)
-
SOURCE/check_parameters.f90 (modified) (13 diffs)
-
SOURCE/header.f90 (modified) (12 diffs)
-
SOURCE/init_3d_model.f90 (modified) (4 diffs)
-
SOURCE/land_surface_model_mod.f90 (modified) (8 diffs)
-
SOURCE/package_parin.f90 (modified) (7 diffs)
-
SOURCE/parin.f90 (modified) (5 diffs)
-
SOURCE/plant_canopy_model_mod.f90 (moved) (moved from palm/trunk/SOURCE/plant_canopy_model.f90) (16 diffs)
-
SOURCE/prognostic_equations.f90 (modified) (21 diffs)
-
SOURCE/radiation_model_mod.f90 (moved) (moved from palm/trunk/SOURCE/radiation_model.f90) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SCRIPTS/mbuild
r1818 r1826 22 22 # Current revisions: 23 23 # ------------------ 24 # 24 # Added note that the script does not work on MAC OS 25 25 # 26 26 # Former revisions: … … 119 119 # Procedure to compile code on local and remote hosts using the 120 120 # make-mechanism. The source code must be provided on the local host. 121 # 122 # @note This script does not work on MAC OS 121 123 #--------------------------------------------------------------------------------# 122 124 -
palm/trunk/SOURCE/Makefile
r1823 r1826 20 20 # Current revisions: 21 21 # ------------------ 22 # 22 # Renamed radiation_model to radiation_model_mod. 23 # Renamed plant_canopy_model to plant_canopy_model_mod. 23 24 # 24 25 # Former revisions: … … 278 279 ls_forcing.f90 message.f90 microphysics.f90 modules.f90 mod_kinds.f90 \ 279 280 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 \ 281 282 pmc_client.f90 pmc_general.f90 pmc_handle_communicator.f90 pmc_mpi_wrapper.f90 \ 282 283 pmc_server.f90 \ 283 284 poisfft.f90 poismg.f90 \ 284 285 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 \ 286 287 random_function.f90 random_gauss.f90 random_generator_parallel.f90 \ 287 288 read_3d_binary.f90 read_var_list.f90 run_control.f90 \ … … 347 348 advec_w_up.o: modules.o mod_kinds.o 348 349 average_3d_data.o: modules.o cpulog.o mod_kinds.o land_surface_model_mod.o\ 349 radiation_model .o350 radiation_model_mod.o 350 351 boundary_conds.o: modules.o mod_kinds.o 351 352 buoyancy.o: modules.o mod_kinds.o … … 356 357 check_open.o: modules.o mod_kinds.o mod_particle_attributes.o netcdf_interface.o 357 358 check_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 \ 359 360 subsidence.o 360 361 close_file.o: modules.o mod_kinds.o netcdf_interface.o … … 375 376 data_output_tseries.o: modules.o cpulog.o mod_kinds.o netcdf_interface.o 376 377 data_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 .o378 netcdf_interface.o land_surface_model_mod.o radiation_model_mod.o 378 379 data_output_3d.o: modules.o cpulog.o mod_kinds.o mod_particle_attributes.o\ 379 380 netcdf_interface.o land_surface_model_mod.o … … 392 393 fft_xy.o: cuda_fft_interfaces.o modules.o mod_kinds.o singleton.o temperton_fft.o 393 394 flow_statistics.o: modules.o cpulog.o mod_kinds.o land_surface_model_mod.o\ 394 netcdf_interface.o radiation_model .o395 netcdf_interface.o radiation_model_mod.o 395 396 global_min_max.o: modules.o mod_kinds.o 396 397 header.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.o398 plant_canopy_model_mod.o pmc_handle_communicator.o pmc_interface.o \ 399 radiation_model_mod.o spectrum.o subsidence.o 399 400 inflow_turbulence.o: modules.o cpulog.o mod_kinds.o 400 401 init_1d_model.o: modules.o mod_kinds.o 401 402 init_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 \ 404 405 surface_layer_fluxes.o 405 406 init_advec.o: modules.o mod_kinds.o … … 415 416 init_slope.o: modules.o mod_kinds.o 416 417 interaction_droplets_ptq.o: modules.o mod_kinds.o 417 land_surface_model_mod.o: modules.o mod_kinds.o radiation_model .o418 land_surface_model_mod.o: modules.o mod_kinds.o radiation_model_mod.o 418 419 local_stop.o: modules.o mod_kinds.o pmc_interface.o 419 420 local_tremain.o: modules.o cpulog.o mod_kinds.o … … 454 455 land_surface_model_mod.o spectrum.o 455 456 nudging.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 457 package_parin.o: modules.o mod_kinds.o spectrum.o 458 458 palm.o: modules.o cpulog.o ls_forcing.o mod_kinds.o nudging.o\ 459 459 pmc_interface.o surface_layer_fluxes.o 460 460 parin.o: modules.o cpulog.o land_surface_model_mod.o mod_kinds.o netcdf_interface.o \ 461 p mc_interface.o progress_bar.o462 plant_canopy_model .o: modules.o mod_kinds.o461 plant_canopy_model_mod.o pmc_interface.o progress_bar.o radiation_model_mod.o 462 plant_canopy_model_mod.o: modules.o mod_kinds.o 463 463 pmc_interface.o: modules.o mod_kinds.o pmc_client.o pmc_general.o\ 464 464 pmc_handle_communicator.o pmc_mpi_wrapper.o pmc_server.o … … 480 480 cpulog.o diffusion_e.o diffusion_s.o diffusion_u.o diffusion_v.o diffusion_w.o \ 481 481 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 \ 483 483 subsidence.o user_actions.o 484 484 progress_bar.o: modules.o mod_kinds.o 485 radiation_model .o : modules.o mod_particle_attributes.o485 radiation_model_mod.o : modules.o mod_particle_attributes.o 486 486 random_function.o: mod_kinds.o 487 487 random_gauss.o: mod_kinds.o random_function.o random_generator_parallel.o 488 488 random_generator_parallel.o: mod_kinds.o 489 489 read_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\ 491 491 random_generator_parallel.o 492 read_var_list.o: modules.o mod_kinds.o netcdf_interface.o plant_canopy_model .o492 read_var_list.o: modules.o mod_kinds.o netcdf_interface.o plant_canopy_model_mod.o 493 493 run_control.o: modules.o cpulog.o mod_kinds.o 494 494 set_slicer_attributes_dvrp.o: modules.o mod_kinds.o … … 498 498 subsidence.o: modules.o mod_kinds.o 499 499 sum_up_3d_data.o: modules.o cpulog.o mod_kinds.o land_surface_model_mod.o\ 500 radiation_model .o500 radiation_model_mod.o 501 501 surface_coupler.o: modules.o cpulog.o mod_kinds.o 502 502 surface_layer_fluxes.o: modules.o mod_kinds.o land_surface_model_mod.o … … 507 507 cpulog.o interaction_droplets_ptq.o land_surface_model_mod.o \ 508 508 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 \ 510 510 spectrum.o user_actions.o surface_layer_fluxes.o 511 511 time_to_string.o: mod_kinds.o … … 532 532 user_init_grid.o: modules.o mod_kinds.o user_module.o 533 533 user_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 .o535 user_init_radiation.o: modules.o mod_kinds.o user_module.o radiation_model .o534 user_init_plant_canopy.o: modules.o mod_kinds.o user_module.o plant_canopy_model_mod.o 535 user_init_radiation.o: modules.o mod_kinds.o user_module.o radiation_model_mod.o 536 536 user_last_actions.o: modules.o mod_kinds.o user_module.o 537 537 user_lpm_advec.o: modules.o mod_kinds.o user_module.o … … 545 545 wall_fluxes.o: modules.o mod_kinds.o 546 546 write_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\ 548 548 random_generator_parallel.o 549 write_var_list.o: modules.o mod_kinds.o netcdf_interface.o plant_canopy_model .o549 write_var_list.o: modules.o mod_kinds.o netcdf_interface.o plant_canopy_model_mod.o -
palm/trunk/SOURCE/check_parameters.f90
r1825 r1826 19 19 ! Current revisions: 20 20 ! ----------------- 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 ! 23 25 ! Former revisions: 24 26 ! ----------------- … … 349 351 USE land_surface_model_mod, & 350 352 ONLY: land_surface, lsm_check_data_output, lsm_check_data_output_pr, & 351 lsm_check_parameters, nzs, zs 353 lsm_check_parameters 354 352 355 USE kinds 353 356 USE model_1d … … 355 358 ONLY: dopr_unit, do2d_unit, do3d_unit, netcdf_data_format, & 356 359 netcdf_data_format_string 360 357 361 USE particle_attributes 358 362 USE pegrid 359 USE plant_canopy_model_mod 363 USE plant_canopy_model_mod, & 364 ONLY: pcm_check_parameters, plant_canopy 365 360 366 USE pmc_interface, & 361 367 ONLY: cpl_id, nested_run 368 362 369 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 364 373 USE statistics 365 374 USE subsidence_mod … … 1022 1031 ENDIF 1023 1032 1024 IF ( plant_canopy ) THEN 1033 ! 1034 !-- When plant canopy model is used, peform addtional checks 1035 IF ( plant_canopy ) CALL pcm_check_parameters 1025 1036 1026 IF ( canopy_drag_coeff == 0.0_wp ) THEN1027 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 ENDIF1031 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 ) THEN1034 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 ENDIF1039 1040 IF ( calc_beta_lad_profile .AND. lai_beta == 0.0_wp ) THEN1041 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 ENDIF1047 1048 IF ( calc_beta_lad_profile .AND. lad_surface /= 0.0_wp ) THEN1049 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 ENDIF1056 1057 IF ( cloud_physics .AND. microphysics_seifert ) THEN1058 message_string = 'plant_canopy = .TRUE. requires cloud_scheme /=' // &1059 ' seifert_beheng'1060 CALL message( 'check_parameters', 'PA0360', 1, 2, 0, 6, 0 )1061 ENDIF1062 1063 ENDIF1064 1065 1037 ! 1066 1038 !-- When land surface model is used, peform addtional checks 1067 1039 IF ( land_surface ) CALL lsm_check_parameters 1068 1040 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 1117 1044 1118 1045 IF ( .NOT. ( loop_optimization == 'cache' .OR. & … … 2980 2907 ENDIF 2981 2908 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 3107 2910 3108 2911 CASE DEFAULT 3109 2912 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 3112 2921 IF ( unit == 'illegal' ) THEN 3113 2922 CALL user_check_data_output_pr( data_output_pr(i), i, unit ) … … 3288 3097 unit = 'kg/kg' 3289 3098 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' ) THEN3293 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 ENDIF3298 unit = 'W/m2'3299 3300 3099 CASE ( 'rho' ) 3301 3100 IF ( .NOT. ocean ) THEN … … 3330 3129 CONTINUE 3331 3130 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*' ) 3335 3133 IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN 3336 3134 message_string = 'illegal value for data_output: "' // & … … 3339 3137 CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 ) 3340 3138 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 3358 3140 IF ( TRIM( var ) == 'lwp*' .AND. .NOT. cloud_physics ) THEN 3359 3141 message_string = 'output of "' // TRIM( var ) // '" requi' // & … … 3384 3166 ENDIF 3385 3167 3386 IF ( TRIM( var ) == 'lai*' ) unit = 'none'3387 3168 IF ( TRIM( var ) == 'lwp*' ) unit = 'kg/m2' 3388 3169 IF ( TRIM( var ) == 'ol*' ) unit = 'm' … … 3390 3171 IF ( TRIM( var ) == 'prr*' ) unit = 'mm/s' 3391 3172 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 = ''3397 3173 IF ( TRIM( var ) == 'shf*' ) unit = 'K*m/s' 3398 3174 IF ( TRIM( var ) == 't*' ) unit = 'K' … … 3404 3180 3405 3181 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 3407 3187 IF ( unit == 'illegal' ) THEN 3408 3188 CALL user_check_data_output( var, unit ) … … 4073 3853 ENDIF 4074 3854 3855 CALL location_message( 'finished', .TRUE. ) 3856 4075 3857 ! 4076 3858 !-- Prevent empty time records in volume, cross-section and masked data in case of … … 4100 3882 IF ( ( constant_flux_layer .OR. & 4101 3883 INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 ) & 4102 .AND. roughness_length <=0.5 * dz ) THEN3884 .AND. roughness_length > 0.5 * dz ) THEN 4103 3885 message_string = 'roughness_length must be smaller than dz/2' 4104 3886 CALL message( 'check_parameters', 'PA0424', 1, 2, 0, 6, 0 ) -
palm/trunk/SOURCE/header.f90
r1823 r1826 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! Moved radiation model header output to the respective module. 22 ! Moved canopy model header output to the respective module. 22 23 ! 23 24 ! Former revisions: … … 289 290 290 291 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 296 293 297 294 USE pmc_handle_communicator, & … … 302 299 303 300 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 307 302 308 303 USE spectrum, & … … 339 334 CHARACTER (LEN=70) :: run_classification !< 340 335 341 CHARACTER (LEN=85) :: r oben!<342 CHARACTER (LEN=85) :: r unten!<336 CHARACTER (LEN=85) :: r_upper !< 337 CHARACTER (LEN=85) :: r_lower !< 343 338 344 339 CHARACTER (LEN=86) :: coordinates !< 345 340 CHARACTER (LEN=86) :: gradients !< 346 CHARACTER (LEN=86) :: leaf_area_density !<347 CHARACTER (LEN=86) :: roots !<348 341 CHARACTER (LEN=86) :: slices !< 349 342 CHARACTER (LEN=86) :: temperatures !< … … 383 376 INTEGER(iwp) :: npe_total !< 384 377 385 REAL(wp) :: canopy_height !< canopy height (in m) 378 386 379 REAL(wp) :: cpuseconds_per_simulated_second !< 387 380 REAL(wp) :: lower_left_coord_x !< x-coordinate of nest domain … … 903 896 ENDIF 904 897 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 ) 972 899 973 900 IF ( land_surface ) CALL lsm_header ( io ) 974 901 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 ) 1001 903 1002 904 ! 1003 905 !-- Boundary conditions 1004 906 IF ( ibc_p_b == 0 ) THEN 1005 r unten= 'p(0) = 0 |'907 r_lower = 'p(0) = 0 |' 1006 908 ELSEIF ( ibc_p_b == 1 ) THEN 1007 r unten= 'p(0) = p(1) |'909 r_lower = 'p(0) = p(1) |' 1008 910 ENDIF 1009 911 IF ( ibc_p_t == 0 ) THEN 1010 r oben= 'p(nzt+1) = 0 |'912 r_upper = 'p(nzt+1) = 0 |' 1011 913 ELSE 1012 r oben= 'p(nzt+1) = p(nzt) |'914 r_upper = 'p(nzt+1) = p(nzt) |' 1013 915 ENDIF 1014 916 1015 917 IF ( ibc_uv_b == 0 ) THEN 1016 r unten = TRIM( runten) // ' uv(0) = -uv(1) |'918 r_lower = TRIM( r_lower ) // ' uv(0) = -uv(1) |' 1017 919 ELSE 1018 r unten = TRIM( runten) // ' uv(0) = uv(1) |'920 r_lower = TRIM( r_lower ) // ' uv(0) = uv(1) |' 1019 921 ENDIF 1020 922 IF ( TRIM( bc_uv_t ) == 'dirichlet_0' ) THEN 1021 r oben = TRIM( roben) // ' uv(nzt+1) = 0 |'923 r_upper = TRIM( r_upper ) // ' uv(nzt+1) = 0 |' 1022 924 ELSEIF ( ibc_uv_t == 0 ) THEN 1023 r oben = 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) |' 1024 926 ELSE 1025 r oben = TRIM( roben) // ' uv(nzt+1) = uv(nzt) |'927 r_upper = TRIM( r_upper ) // ' uv(nzt+1) = uv(nzt) |' 1026 928 ENDIF 1027 929 1028 930 IF ( ibc_pt_b == 0 ) THEN 1029 931 IF ( land_surface ) THEN 1030 r unten = TRIM( runten) // ' pt(0) = from soil model'1031 ELSE 1032 r unten = 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' 1033 935 ENDIF 1034 936 ELSEIF ( ibc_pt_b == 1 ) THEN 1035 r unten = TRIM( runten) // ' pt(0) = pt(1)'937 r_lower = TRIM( r_lower ) // ' pt(0) = pt(1)' 1036 938 ELSEIF ( ibc_pt_b == 2 ) THEN 1037 r unten = TRIM( runten) // ' pt(0) = from coupled model'939 r_lower = TRIM( r_lower ) // ' pt(0) = from coupled model' 1038 940 ENDIF 1039 941 IF ( ibc_pt_t == 0 ) THEN 1040 r oben = TRIM( roben) // ' pt(nzt+1) = pt_top'942 r_upper = TRIM( r_upper ) // ' pt(nzt+1) = pt_top' 1041 943 ELSEIF( ibc_pt_t == 1 ) THEN 1042 r oben = TRIM( roben) // ' pt(nzt+1) = pt(nzt)'944 r_upper = TRIM( r_upper ) // ' pt(nzt+1) = pt(nzt)' 1043 945 ELSEIF( ibc_pt_t == 2 ) THEN 1044 r oben = TRIM( roben) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'1045 1046 ENDIF 1047 1048 WRITE ( io, 300 ) r unten, roben946 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 1049 951 1050 952 IF ( .NOT. constant_diffusion ) THEN 1051 953 IF ( ibc_e_b == 1 ) THEN 1052 r unten= 'e(0) = e(1)'1053 ELSE 1054 r unten= 'e(0) = e(1) = (u*/0.1)**2'1055 ENDIF 1056 r oben= 'e(nzt+1) = e(nzt) = e(nzt-1)'1057 1058 WRITE ( io, 301 ) 'e', r unten, roben954 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 1059 961 1060 962 ENDIF 1061 963 1062 964 IF ( ocean ) THEN 1063 r unten= 'sa(0) = sa(1)'965 r_lower = 'sa(0) = sa(1)' 1064 966 IF ( ibc_sa_t == 0 ) THEN 1065 r oben= 'sa(nzt+1) = sa_surface'1066 ELSE 1067 r oben= 'sa(nzt+1) = sa(nzt)'1068 ENDIF 1069 WRITE ( io, 301 ) 'sa', r unten, roben967 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 1070 972 ENDIF 1071 973 … … 1073 975 IF ( ibc_q_b == 0 ) THEN 1074 976 IF ( land_surface ) THEN 1075 r unten= 'q(0) = from soil model'977 r_lower = 'q(0) = from soil model' 1076 978 ELSE 1077 r unten= 'q(0) = q_surface'1078 ENDIF 1079 1080 ELSE 1081 r unten= 'q(0) = q(1)'979 r_lower = 'q(0) = q_surface' 980 ENDIF 981 982 ELSE 983 r_lower = 'q(0) = q(1)' 1082 984 ENDIF 1083 985 IF ( ibc_q_t == 0 ) THEN 1084 r oben= 'q(nzt) = q_top'1085 ELSE 1086 r oben= 'q(nzt) = q(nzt-1) + dq/dz'1087 ENDIF 1088 WRITE ( io, 301 ) 'q', r unten, roben986 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 1089 991 ENDIF 1090 992 1091 993 IF ( passive_scalar ) THEN 1092 994 IF ( ibc_q_b == 0 ) THEN 1093 r unten= 's(0) = s_surface'1094 ELSE 1095 r unten= 's(0) = s(1)'995 r_lower = 's(0) = s_surface' 996 ELSE 997 r_lower = 's(0) = s(1)' 1096 998 ENDIF 1097 999 IF ( ibc_q_t == 0 ) THEN 1098 r oben= 's(nzt) = s_top'1099 ELSE 1100 r oben= 's(nzt) = s(nzt-1) + ds/dz'1101 ENDIF 1102 WRITE ( io, 301 ) 's', r unten, roben1000 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 1103 1005 ENDIF 1104 1006 … … 1747 1649 ! 1748 1650 !-- Geostrophic parameters 1749 IF ( radiation .AND. radiation_scheme /= 'constant' ) THEN1750 WRITE ( io, 417 ) lambda1751 ENDIF1752 1651 WRITE ( io, 410 ) phi, omega, f, fs 1753 1652 … … 1755 1654 !-- Other quantities 1756 1655 WRITE ( io, 411 ) g 1757 IF ( radiation .AND. radiation_scheme /= 'constant' ) THEN1758 WRITE ( io, 418 ) day_init, time_utc_init1759 ENDIF1760 1656 1761 1657 WRITE ( io, 412 ) TRIM( reference_state ) … … 2060 1956 279 FORMAT (' Topography grid definition convention:'/ & 2061 1957 ' 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 2082 1958 300 FORMAT (//' Boundary conditions:'/ & 2083 1959 ' -------------------'// & … … 2300 2176 '[0,1000] cm**2/s**3') 2301 2177 437 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 2311 2178 450 FORMAT (//' LES / Turbulence quantities:'/ & 2312 2179 ' ---------------------------'/) … … 2316 2183 454 FORMAT (' TKE is not allowed to fall below ',E9.2,' (m/s)**2') 2317 2184 455 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.')2322 2185 470 FORMAT (//' Actions during the simulation:'/ & 2323 2186 ' -----------------------------'/) -
palm/trunk/SOURCE/init_3d_model.f90
r1823 r1826 19 19 ! Current revisions: 20 20 ! ------------------ 21 ! 21 ! Renamed radiation calls. 22 ! Renamed canopy model calls. 22 23 ! 23 24 ! Former revisions: … … 288 289 289 290 USE plant_canopy_model_mod, & 290 ONLY: init_plant_canopy, plant_canopy291 ONLY: pcm_init, plant_canopy 291 292 292 293 USE radiation_model_mod, & 293 ONLY: init_radiation, radiation294 ONLY: radiation_init, radiation 294 295 295 296 USE random_function_mod … … 1631 1632 ! 1632 1633 !-- 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. ) 1634 1637 1635 1638 ! … … 1676 1679 IF ( radiation ) THEN 1677 1680 CALL location_message( 'initializing radiation model', .FALSE. ) 1678 CALL init_radiation1681 CALL radiation_init 1679 1682 CALL location_message( 'finished', .TRUE. ) 1680 1683 ENDIF -
palm/trunk/SOURCE/land_surface_model_mod.f90
r1818 r1826 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! Cleanup after modularization 22 22 ! 23 23 ! Former revisions: … … 532 532 PUBLIC lsm_check_data_output, lsm_check_data_output_pr, & 533 533 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 535 535 ! 536 536 !-- 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 549 538 550 539 ! … … 644 633 unit = 'K' 645 634 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*', & 649 637 'r_a*', 'r_s*', 'shf_eb*' ) 650 638 IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN … … 654 642 CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 ) 655 643 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 657 649 IF ( TRIM( var ) == 'c_liq*' .AND. .NOT. land_surface ) THEN 658 650 message_string = 'output of "' // TRIM( var ) // '" requi' // & … … 716 708 ENDIF 717 709 710 IF ( TRIM( var ) == 'lai*' ) unit = 'none' 718 711 IF ( TRIM( var ) == 'c_liq*' ) unit = 'none' 719 712 IF ( TRIM( var ) == 'c_soil*') unit = 'none' … … 1564 1557 1 FORMAT (//' Land surface model information:'/ & 1565 1558 ' ------------------------------'/) 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) 1559 2 FORMAT (' --> Soil bottom is closed (water content is conserved', & 1560 ', default)') 1561 3 FORMAT (' --> Soil bottom is open (water content is not conserved)') 1562 4 FORMAT (' --> Land surface type : ',A,/ & 1563 ' --> Soil porosity type : ',A) 1570 1564 5 FORMAT (/' Initial soil temperature and moisture profile:'// & 1571 1565 ' Height: ',A,' m'/ & … … 1573 1567 ' Moisture: ',A,' m**3/m**3'/ & 1574 1568 ' Root fraction: ',A,' '/ & 1575 ' Gridpoint: ',A) 1576 1577 1569 ' Grid point: ',A) 1578 1570 1579 1571 END SUBROUTINE lsm_header … … 1627 1619 1628 1620 IF ( humidity ) THEN 1629 qsws_eb = rho_l * l_v * qsws1621 qsws_eb = rho_lv * qsws 1630 1622 ELSE 1631 1623 qsws_eb = 0.0_wp -
palm/trunk/SOURCE/package_parin.f90
r1823 r1826 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! Reading of &radiation_par moved to radiation_model_mod. 22 ! Reading of &canopy_par moved to plant_canopy_model_mod. 22 23 ! 23 24 ! Former revisions: … … 30 31 ! 31 32 ! 1817 2016-04-06 15:44:20Z maronga 32 ! Reading of &lsm par moved to land_surface_model_mod.33 ! Reading of &lsm_par moved to land_surface_model_mod. 33 34 ! 34 35 ! 1788 2016-03-10 11:01:04Z maronga … … 152 153 vertical_particle_advection, write_particle_statistics 153 154 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_canopy160 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_calls167 168 169 155 USE spectrum, & 170 156 ONLY: comp_spectra_level, data_output_sp, plot_spectra_level, & … … 175 161 CHARACTER (LEN=80) :: line !< 176 162 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 185 164 186 165 NAMELIST /dvrp_graphics_par/ clip_dvrp_l, clip_dvrp_n, clip_dvrp_r, & … … 220 199 write_particle_statistics 221 200 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_calls229 230 201 NAMELIST /spectra_par/ averaging_interval_sp, comp_spectra_level, & 231 202 data_output_sp, dt_dosp, plot_spectra_level, & … … 237 208 !-- file at this line. Do the same for each optionally used package. 238 209 line = ' ' 239 240 !241 !-- Try to find canopy package242 REWIND ( 11 )243 line = ' '244 DO WHILE ( INDEX( line, '&canopy_par' ) == 0 )245 READ ( 11, '(A)', END=10 ) line246 ENDDO247 BACKSPACE ( 11 )248 249 !250 !-- Read user-defined namelist251 READ ( 11, canopy_par )252 253 !254 !-- Set flag that indicates that canopy model is switched on255 plant_canopy = .TRUE.256 257 !258 !-- Set flag that indicates that the lad-profile shall be calculated by using259 !-- a beta probability density function260 IF ( alpha_lad /= 9999999.9_wp .AND. beta_lad /= 9999999.9_wp ) &261 calc_beta_lad_profile = .TRUE.262 263 10 CONTINUE264 210 265 211 … … 317 263 318 264 319 !320 !-- Try to find radiation package321 REWIND ( 11 )322 line = ' '323 DO WHILE ( INDEX( line, '&radiation_par' ) == 0 )324 READ ( 11, '(A)', END=51 ) line325 ENDDO326 BACKSPACE ( 11 )327 328 !329 !-- Read user-defined namelist330 READ ( 11, radiation_par )331 332 !333 !-- Set flag that indicates that the radiation scheme is switched on334 radiation = .TRUE.335 336 51 CONTINUE337 265 338 266 -
palm/trunk/SOURCE/parin.f90
r1818 r1826 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! Added call to radiation model for reading of &radiation_par. 22 ! Added call to plant canopy model for reading of &canopy_par. 22 23 ! 23 24 ! Former revisions: … … 26 27 ! 27 28 ! 1817 2016-04-06 15:44:20Z maronga 28 ! Added call to land surface model for reading of &lsm par29 ! Added call to land surface model for reading of &lsm_par 29 30 ! 30 31 ! 1804 2016-04-05 16:30:18Z maronga … … 191 192 vg 192 193 194 USE plant_canopy_model_mod, & 195 ONLY: pcm_parin 196 193 197 USE cloud_parameters, & 194 198 ONLY: c_sedimentation, curvature_solution_effects, & … … 232 236 ONLY : batch_job 233 237 238 USE radiation_model_mod, & 239 ONLY: radiation_parin 240 234 241 USE statistics, & 235 242 ONLY: hom, hom_sum, pr_palm, region, statistic_regions … … 458 465 459 466 ! 460 !-- Check if land surface model is used and read &lsm par if required467 !-- Check if land surface model is used and read &lsm_par if required 461 468 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 464 478 ! 465 479 !-- Read control parameters for optionally used model software packages -
palm/trunk/SOURCE/plant_canopy_model_mod.f90
r1823 r1826 1 !> @file plant_canopy_model .f901 !> @file plant_canopy_model_mod.f90 2 2 !--------------------------------------------------------------------------------! 3 3 ! This file is part of PALM. … … 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! Further modularization 22 22 ! 23 23 ! Former revisions: … … 35 35 ! Changes due to new module structure of the plant canopy model: 36 36 ! 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), 38 38 ! limitation of the canopy drag (previously accounted for by calculation of 39 39 ! a limiting canopy timestep for the determination of the maximum LES timestep 40 40 ! in subroutine timestep) is now realized by the calculation of pre-tendencies 41 ! and preliminary velocities in subroutine p lant_canopy_model,42 ! some redundant MPI communication removed in subroutine init_plant_canopy41 ! and preliminary velocities in subroutine pcm_tendency, 42 ! some redundant MPI communication removed in subroutine pcm_init 43 43 ! (was previously in init_3d_model), 44 44 ! unnecessary 3d-arrays lad_u, lad_v, lad_w removed - lad information on the … … 73 73 ! ------------ 74 74 !> 1) Initialization of the canopy model, e.g. construction of leaf area density 75 !> profile (subroutine init_plant_canopy).75 !> profile (subroutine pcm_init). 76 76 !> 2) Calculation of sinks and sources of momentum, heat and scalar concentration 77 !> due to canopy elements (subroutine p lant_canopy_model).77 !> due to canopy elements (subroutine pcm_tendency). 78 78 !------------------------------------------------------------------------------! 79 79 MODULE plant_canopy_model_mod … … 134 134 135 135 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 154 166 155 167 156 168 CONTAINS 157 169 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 319 1 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 /) 324 2 FORMAT (/ ' Scalar exchange coefficient: ',F6.2 / & 325 ' Scalar concentration at leaf surfaces in kg/m**3: ',F6.2 /) 326 3 FORMAT (' Predefined constant heatflux at the top of the vegetation: ',F6.2, & 327 ' K m/s') 328 4 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) 333 5 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 159 343 !------------------------------------------------------------------------------! 160 344 ! Description: … … 162 346 !> Initialization of the plant canopy model 163 347 !------------------------------------------------------------------------------! 164 SUBROUTINE init_plant_canopy348 SUBROUTINE pcm_init 165 349 166 350 … … 187 371 pre_lad = 0.0_wp 188 372 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 189 381 ! 190 382 !-- Compute the profile of leaf area density used in the plant … … 244 436 DO k = nzb, pch_index 245 437 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 ) ) 249 442 ENDDO 250 443 … … 252 445 !-- Preliminary lad profile (defined on w-grid) 253 446 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 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 259 452 ENDDO 260 453 … … 376 569 377 570 378 END SUBROUTINE init_plant_canopy571 END SUBROUTINE pcm_init 379 572 380 573 … … 387 580 !> 388 581 !> 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. 390 583 !> The lad on the w-grid is vertically interpolated from the surrounding 391 584 !> lad_s. The upper boundary of the canopy is defined on the w-grid at … … 404 597 !> Call for all grid points 405 598 !------------------------------------------------------------------------------! 406 SUBROUTINE p lant_canopy_model( component )599 SUBROUTINE pcm_tendency( component ) 407 600 408 601 … … 672 865 673 866 WRITE( message_string, * ) 'wrong component: ', component 674 CALL message( 'p lant_canopy_model', 'PA0279', 1, 2, 0, 6, 0 )867 CALL message( 'pcm_tendency', 'PA0279', 1, 2, 0, 6, 0 ) 675 868 676 869 END SELECT 677 870 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 679 919 680 920 … … 686 926 !> 687 927 !> 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. 689 929 !> The lad on the w-grid is vertically interpolated from the surrounding 690 930 !> lad_s. The upper boundary of the canopy is defined on the w-grid at … … 703 943 !> Call for grid point i,j 704 944 !------------------------------------------------------------------------------! 705 SUBROUTINE p lant_canopy_model_ij( i, j, component )945 SUBROUTINE pcm_tendency_ij( i, j, component ) 706 946 707 947 … … 944 1184 945 1185 WRITE( message_string, * ) 'wrong component: ', component 946 CALL message( 'p lant_canopy_model', 'PA0279', 1, 2, 0, 6, 0 )1186 CALL message( 'pcm_tendency', 'PA0279', 1, 2, 0, 6, 0 ) 947 1187 948 1188 END SELECT 949 1189 950 END SUBROUTINE p lant_canopy_model_ij1190 END SUBROUTINE pcm_tendency_ij 951 1191 952 1192 END MODULE plant_canopy_model_mod -
palm/trunk/SOURCE/prognostic_equations.f90
r1823 r1826 19 19 ! Current revisions: 20 20 ! ------------------ 21 ! 21 ! Renamed canopy model calls. 22 22 ! 23 23 ! Former revisions: … … 284 284 285 285 USE plant_canopy_model_mod, & 286 ONLY: cthf, plant_canopy, p lant_canopy_model286 ONLY: cthf, plant_canopy, pcm_tendency 287 287 288 288 USE production_e_mod, & … … 403 403 ! 404 404 !-- Drag by plant canopy 405 IF ( plant_canopy ) CALL p lant_canopy_model( i, j, 1 )405 IF ( plant_canopy ) CALL pcm_tendency( i, j, 1 ) 406 406 407 407 ! … … 462 462 ! 463 463 !-- Drag by plant canopy 464 IF ( plant_canopy ) CALL p lant_canopy_model( i, j, 2 )464 IF ( plant_canopy ) CALL pcm_tendency( i, j, 2 ) 465 465 466 466 ! … … 531 531 ! 532 532 !-- Drag by plant canopy 533 IF ( plant_canopy ) CALL p lant_canopy_model( i, j, 3 )533 IF ( plant_canopy ) CALL pcm_tendency( i, j, 3 ) 534 534 535 535 CALL user_actions( i, j, 'w-tendency' ) … … 586 586 !-- Consideration of heat sources within the plant canopy 587 587 IF ( plant_canopy .AND. cthf /= 0.0_wp ) THEN 588 CALL p lant_canopy_model( i, j, 4 )588 CALL pcm_tendency( i, j, 4 ) 589 589 ENDIF 590 590 … … 720 720 ! 721 721 !-- Sink or source of scalar concentration due to canopy elements 722 IF ( plant_canopy ) CALL p lant_canopy_model( i, j, 5 )722 IF ( plant_canopy ) CALL pcm_tendency( i, j, 5 ) 723 723 724 724 ! … … 888 888 ! 889 889 !-- Additional sink term for flows through plant canopies 890 IF ( plant_canopy ) CALL p lant_canopy_model( i, j, 6 )890 IF ( plant_canopy ) CALL pcm_tendency( i, j, 6 ) 891 891 892 892 CALL user_actions( i, j, 'e-tendency' ) … … 982 982 ! 983 983 !-- Drag by plant canopy 984 IF ( plant_canopy ) CALL p lant_canopy_model( 1 )984 IF ( plant_canopy ) CALL pcm_tendency( 1 ) 985 985 986 986 ! … … 1058 1058 ! 1059 1059 !-- Drag by plant canopy 1060 IF ( plant_canopy ) CALL p lant_canopy_model( 2 )1060 IF ( plant_canopy ) CALL pcm_tendency( 2 ) 1061 1061 1062 1062 ! … … 1146 1146 ! 1147 1147 !-- Drag by plant canopy 1148 IF ( plant_canopy ) CALL p lant_canopy_model( 3 )1148 IF ( plant_canopy ) CALL pcm_tendency( 3 ) 1149 1149 1150 1150 CALL user_actions( 'w-tendency' ) … … 1235 1235 !-- Consideration of heat sources within the plant canopy 1236 1236 IF ( plant_canopy .AND. ( cthf /= 0.0_wp ) ) THEN 1237 CALL p lant_canopy_model( 4 )1237 CALL pcm_tendency( 4 ) 1238 1238 ENDIF 1239 1239 … … 1433 1433 ! 1434 1434 !-- Sink or source of scalar concentration due to canopy elements 1435 IF ( plant_canopy ) CALL p lant_canopy_model( 5 )1435 IF ( plant_canopy ) CALL pcm_tendency( 5 ) 1436 1436 1437 1437 ! … … 1531 1531 1532 1532 CALL diffusion_s( qr, qrsws, qrswst, wall_qrflux ) 1533 1534 CALL user_actions( 'qr-tendency' ) 1533 1535 1534 1536 ! … … 1703 1705 ! 1704 1706 !-- Additional sink term for flows through plant canopies 1705 IF ( plant_canopy ) CALL p lant_canopy_model( 6 )1707 IF ( plant_canopy ) CALL pcm_tendency( 6 ) 1706 1708 CALL user_actions( 'e-tendency' ) 1707 1709 … … 1816 1818 ! 1817 1819 !-- Drag by plant canopy 1818 IF ( plant_canopy ) CALL p lant_canopy_model( 1 )1820 IF ( plant_canopy ) CALL pcm_tendency( 1 ) 1819 1821 1820 1822 ! … … 1883 1885 ! 1884 1886 !-- Drag by plant canopy 1885 IF ( plant_canopy ) CALL p lant_canopy_model( 2 )1887 IF ( plant_canopy ) CALL pcm_tendency( 2 ) 1886 1888 1887 1889 ! … … 1962 1964 ! 1963 1965 !-- Drag by plant canopy 1964 IF ( plant_canopy ) CALL p lant_canopy_model( 3 )1966 IF ( plant_canopy ) CALL pcm_tendency( 3 ) 1965 1967 1966 1968 CALL user_actions( 'w-tendency' ) … … 2043 2045 !-- Consideration of heat sources within the plant canopy 2044 2046 IF ( plant_canopy .AND. ( cthf /= 0.0_wp ) ) THEN 2045 CALL p lant_canopy_model( 4 )2047 CALL pcm_tendency( 4 ) 2046 2048 ENDIF 2047 2049 … … 2213 2215 ! 2214 2216 !-- Sink or source of scalar concentration due to canopy elements 2215 IF ( plant_canopy ) CALL p lant_canopy_model( 5 )2217 IF ( plant_canopy ) CALL pcm_tendency( 5 ) 2216 2218 2217 2219 ! … … 2435 2437 ! 2436 2438 !-- Additional sink term for flows through plant canopies 2437 IF ( plant_canopy ) CALL p lant_canopy_model( 6 )2439 IF ( plant_canopy ) CALL pcm_tendency( 6 ) 2438 2440 CALL user_actions( 'e-tendency' ) 2439 2441 -
palm/trunk/SOURCE/radiation_model_mod.f90
r1818 r1826 1 !> @file radiation_model .f901 !> @file radiation_model_mod.f90 2 2 !--------------------------------------------------------------------------------! 3 3 ! This file is part of PALM. … … 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! Further modularization. 22 22 ! 23 23 ! Former revisions: … … 80 80 ! ------------ 81 81 !> Radiation models and interfaces 82 !> @todo move variable definitions used in init_radiationonly to the subroutine82 !> @todo move variable definitions used in radiation_init only to the subroutine 83 83 !> as they are no longer required after initialization. 84 84 !> @todo Output of full column vertical profiles used in RRTMG … … 115 115 116 116 #if defined ( __rrtmg ) 117 118 ! USE netcdf_interface, &119 ! ONLY: nc_stat, netcdf_handle_error120 117 121 118 USE parrrsw, & … … 353 350 #endif 354 351 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 359 364 INTERFACE radiation_clearsky 360 365 MODULE PROCEDURE radiation_clearsky 361 366 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 363 380 INTERFACE radiation_rrtmg 364 381 MODULE PROCEDURE radiation_rrtmg … … 374 391 PRIVATE 375 392 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 387 408 388 409 … … 396 417 ! Description: 397 418 ! ------------ 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 ! ------------ 398 726 !> Initialization of the radiation model 399 727 !------------------------------------------------------------------------------! 400 SUBROUTINE init_radiation728 SUBROUTINE radiation_init 401 729 402 730 IMPLICIT NONE … … 661 989 RETURN 662 990 663 END SUBROUTINE init_radiation991 END SUBROUTINE radiation_init 664 992 665 993 … … 719 1047 720 1048 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') 1109 10 FORMAT (/' --> Longwave radiation is disabled') 1110 11 FORMAT (/' --> Shortwave radiation is disabled.') 1111 12 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 721 1160 722 1161 … … 1608 2047 END SUBROUTINE read_trace_gas_data 1609 2048 2049 1610 2050 SUBROUTINE netcdf_handle_error_rad( routine_name, errno ) 1611 2051
Note: See TracChangeset
for help on using the changeset viewer.
