- Timestamp:
- Oct 30, 2018 9:07:39 PM (6 years ago)
- Location:
- palm/trunk
- Files:
-
- 4 edited
-
SCRIPTS/.palm.iofiles (modified) (1 diff)
-
SOURCE/Makefile (modified) (1 diff)
-
SOURCE/netcdf_data_input_mod.f90 (modified) (13 diffs)
-
SOURCE/uv_exposure_model_mod.f90 (modified) (27 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SCRIPTS/.palm.iofiles
r3472 r3474 13 13 PIDS_SALSA inopt:tr d3#:d3r $base_data/$run_identifier/INPUT _salsa* 14 14 PIDS_CHEM inopt:tr d3#:d3r $base_data/$run_identifier/INPUT _chemistry* 15 PIDS_UVEM inopt:tr d3#:d3r $base_data/$run_identifier/INPUT _uvlookup* 15 16 PIDS_VM inopt:tr d3#:d3r $base_data/$run_identifier/INPUT _vmeas* 16 17 rrtmg_lw.nc inopt:tr d3#:d3r $base_data/$run_identifier/INPUT _rlw -
palm/trunk/SOURCE/Makefile
r3473 r3474 1960 1960 mod_kinds.o \ 1961 1961 modules.o \ 1962 netcdf_data_input_mod.o \ 1962 1963 radiation_model_mod.o 1963 1964 vertical_nesting_mod.o: \ -
palm/trunk/SOURCE/netcdf_data_input_mod.f90
r3472 r3474 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Add UV exposure model input (Schrempf) 28 ! 29 ! 3472 2018-10-30 20:43:50Z suehring 27 30 ! Salsa implemented 28 31 ! … … 446 449 END TYPE int_2d_8bit 447 450 ! 451 !-- 8-bit Integer 3D 452 TYPE int_3d_8bit 453 INTEGER(KIND=1) :: fill = -127 !< fill value 454 INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: var_3d !< respective variable 455 456 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used 457 END TYPE int_3d_8bit 458 ! 448 459 !-- 32-bit Integer 2D 449 460 TYPE int_2d_32bit … … 464 475 465 476 ! 466 !-- Define data type to read 2D real variables477 !-- Define data type to read 3D real variables 467 478 TYPE real_3d 468 479 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used … … 629 640 TYPE(int_2d_8bit) :: vegetation_type_f !< input variable for vegetation type 630 641 TYPE(int_2d_8bit) :: water_type_f !< input variable for water type 631 642 ! 643 !-- Define 3D variables of type NC_BYTE 644 TYPE(int_3d_8bit) :: building_obstruction_f !< input variable for building obstruction 645 TYPE(int_3d_8bit) :: building_obstruction_full !< input variable for building obstruction 632 646 ! 633 647 !-- Define 2D variables of type NC_INT … … 636 650 !-- Define 2D variables of type NC_FLOAT 637 651 TYPE(real_2d) :: terrain_height_f !< input variable for terrain height 652 TYPE(real_2d) :: uvem_irradiance_f !< input variable for uvem irradiance lookup table 653 TYPE(real_2d) :: uvem_integration_f !< input variable for uvem integration 638 654 ! 639 655 !-- Define 3D variables of type NC_FLOAT … … 642 658 TYPE(real_3d) :: root_area_density_lad_f !< input variable for root area density - resolved vegetation 643 659 TYPE(real_3d) :: root_area_density_lsm_f !< input variable for root area density - parametrized vegetation 644 660 TYPE(real_3d) :: uvem_radiance_f !< input variable for uvem radiance lookup table 661 TYPE(real_3d) :: uvem_projarea_f !< input variable for uvem projection area lookup table 645 662 ! 646 663 !-- Define input variable for buildings … … 670 687 CHARACTER(LEN=100) :: input_file_dynamic = 'PIDS_DYNAMIC' !< Name of file which comprises dynamic input data 671 688 CHARACTER(LEN=100) :: input_file_chem = 'PIDS_CHEM' !< Name of file which comprises chemistry input data 689 CHARACTER(LEN=100) :: input_file_uvem = 'PIDS_UVEM' !< Name of file which comprises static uv_exposure model input data 672 690 CHARACTER(LEN=100) :: input_file_vm = 'PIDS_VM' !< Name of file which comprises virtual measurement data 673 691 674 692 CHARACTER (LEN=25), ALLOCATABLE, DIMENSION(:) :: string_values !< output of string variables read from netcdf input files 675 693 676 694 INTEGER(iwp) :: id_emis !< NetCDF id of input file for chemistry emissions: TBD: It has to be removed 677 695 … … 681 699 LOGICAL :: input_pids_dynamic = .FALSE. !< Flag indicating whether Palm-input-data-standard file containing dynamic information exists 682 700 LOGICAL :: input_pids_chem = .FALSE. !< Flag indicating whether Palm-input-data-standard file containing chemistry information exists 701 LOGICAL :: input_pids_uvem = .FALSE. !< Flag indicating whether uv-expoure-model input file containing static information exists 683 702 LOGICAL :: input_pids_vm = .FALSE. !< Flag indicating whether input file for virtual measurements exist 684 703 685 704 LOGICAL :: collective_read = .FALSE. !< Enable NetCDF collective read 686 705 … … 749 768 MODULE PROCEDURE netcdf_data_input_var_real_2d 750 769 END INTERFACE netcdf_data_input_var 770 771 INTERFACE netcdf_data_input_uvem 772 MODULE PROCEDURE netcdf_data_input_uvem 773 END INTERFACE netcdf_data_input_uvem 751 774 752 775 INTERFACE get_variable … … 791 814 terrain_height_f, vegetation_pars_f, vegetation_type_f, & 792 815 water_pars_f, water_type_f 816 ! 817 !-- Public uv exposure variables 818 PUBLIC building_obstruction_f, input_file_uvem, input_pids_uvem, & 819 netcdf_data_input_uvem, & 820 uvem_integration_f, uvem_irradiance_f, & 821 uvem_projarea_f, uvem_radiance_f 793 822 794 823 ! … … 804 833 netcdf_data_input_var, get_attribute, get_variable, open_read_file 805 834 835 806 836 CONTAINS 807 837 … … 826 856 INQUIRE( FILE = TRIM( input_file_chem ) // TRIM( coupling_char ), & 827 857 EXIST = input_pids_chem ) 858 INQUIRE( FILE = TRIM( input_file_uvem ) // TRIM( coupling_char ), & 859 EXIST = input_pids_uvem ) 828 860 INQUIRE( FILE = TRIM( input_file_vm ) // TRIM( coupling_char ), & 829 861 EXIST = input_pids_vm ) … … 2497 2529 ! Description: 2498 2530 ! ------------ 2531 !> Reads uvem lookup table information. 2532 !------------------------------------------------------------------------------! 2533 SUBROUTINE netcdf_data_input_uvem 2534 2535 USE indices, & 2536 ONLY: nxl, nxr, nyn, nys 2537 2538 IMPLICIT NONE 2539 2540 CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in static input file 2541 2542 2543 INTEGER(iwp) :: id_uvem !< NetCDF id of uvem lookup table input file 2544 INTEGER(iwp) :: nli = 35 !< dimension length of lookup table in x 2545 INTEGER(iwp) :: nlj = 9 !< dimension length of lookup table in y 2546 INTEGER(iwp) :: nlk = 90 !< dimension length of lookup table in z 2547 INTEGER(iwp) :: num_vars !< number of variables in netcdf input file 2548 ! 2549 !-- Input via uv exposure model lookup table input 2550 IF ( input_pids_uvem ) THEN 2551 2552 #if defined ( __netcdf ) 2553 ! 2554 !-- Open file in read-only mode 2555 CALL open_read_file( TRIM( input_file_uvem ) // & 2556 TRIM( coupling_char ), id_uvem ) 2557 ! 2558 !-- At first, inquire all variable names. 2559 !-- This will be used to check whether an input variable exist or not. 2560 CALL inquire_num_variables( id_uvem, num_vars ) 2561 ! 2562 !-- Allocate memory to store variable names and inquire them. 2563 ALLOCATE( var_names(1:num_vars) ) 2564 CALL inquire_variable_names( id_uvem, var_names ) 2565 ! 2566 ! 2567 !-- uvem integration 2568 IF ( check_existence( var_names, 'int_factors' ) ) THEN 2569 uvem_integration_f%from_file = .TRUE. 2570 ! 2571 !-- Input 2D uvem integration. 2572 ALLOCATE ( uvem_integration_f%var(0:nlj,0:nli) ) 2573 2574 CALL get_variable( id_uvem, 'int_factors', uvem_integration_f%var, 0, nli, 0, nlj ) 2575 ELSE 2576 uvem_integration_f%from_file = .FALSE. 2577 ENDIF 2578 ! 2579 ! 2580 ! 2581 !-- uvem irradiance 2582 IF ( check_existence( var_names, 'irradiance' ) ) THEN 2583 uvem_irradiance_f%from_file = .TRUE. 2584 ! 2585 !-- Input 2D uvem irradiance. 2586 ALLOCATE ( uvem_irradiance_f%var(0:nlk, 0:2) ) 2587 2588 CALL get_variable( id_uvem, 'irradiance', uvem_irradiance_f%var, 0, 2, 0, nlk ) 2589 ELSE 2590 uvem_irradiance_f%from_file = .FALSE. 2591 ENDIF 2592 ! 2593 ! 2594 ! 2595 !-- uvem porjection areas 2596 IF ( check_existence( var_names, 'projarea' ) ) THEN 2597 uvem_projarea_f%from_file = .TRUE. 2598 ! 2599 !-- Input 3D uvem projection area (human geometgry) 2600 ALLOCATE ( uvem_projarea_f%var(0:2,0:nlj,0:nli) ) 2601 2602 CALL get_variable( id_uvem, 'projarea', uvem_projarea_f%var, 0, nli, 0, nlj, 0, 2 ) 2603 ELSE 2604 uvem_projarea_f%from_file = .FALSE. 2605 ENDIF 2606 ! 2607 ! 2608 ! 2609 !-- uvem radiance 2610 IF ( check_existence( var_names, 'radiance' ) ) THEN 2611 uvem_radiance_f%from_file = .TRUE. 2612 ! 2613 !-- Input 3D uvem radiance 2614 ALLOCATE ( uvem_radiance_f%var(0:nlk,0:nlj,0:nli) ) 2615 2616 CALL get_variable( id_uvem, 'radiance', uvem_radiance_f%var, 0, nli, 0, nlj, 0, nlk ) 2617 ELSE 2618 uvem_radiance_f%from_file = .FALSE. 2619 ENDIF 2620 ! 2621 ! 2622 ! 2623 !-- Read building obstruction 2624 IF ( check_existence( var_names, 'obstruction' ) ) THEN 2625 building_obstruction_full%from_file = .TRUE. 2626 !-- Input 3D uvem building obstruction 2627 ALLOCATE ( building_obstruction_full%var_3d(0:44,0:2,0:2) ) 2628 CALL get_variable( id_uvem, 'obstruction', building_obstruction_full%var_3d,0, 2, 0, 2, 0, 44 ) 2629 ELSE 2630 building_obstruction_full%from_file = .FALSE. 2631 ENDIF 2632 ! 2633 IF ( check_existence( var_names, 'obstruction' ) ) THEN 2634 building_obstruction_f%from_file = .TRUE. 2635 ! 2636 !-- Input 3D uvem building obstruction 2637 ALLOCATE ( building_obstruction_f%var_3d(0:44,nys:nyn,nxl:nxr) ) 2638 ! 2639 CALL get_variable( id_uvem, 'obstruction', building_obstruction_f%var_3d, & 2640 nxl, nxr, nys, nyn, 0, 44 ) 2641 ELSE 2642 building_obstruction_f%from_file = .FALSE. 2643 ENDIF 2644 ! 2645 ! 2646 ! 2647 ! 2648 !-- Close uvem lookup table input file 2649 CALL close_input_file( id_uvem ) 2650 #else 2651 CONTINUE 2652 #endif 2653 ENDIF 2654 END SUBROUTINE netcdf_data_input_uvem 2655 2656 !------------------------------------------------------------------------------! 2657 ! Description: 2658 ! ------------ 2499 2659 !> Reads orography and building information. 2500 2660 !------------------------------------------------------------------------------! -
palm/trunk/SOURCE/uv_exposure_model_mod.f90
r3448 r3474 19 19 ! 20 20 ! Current revisions: 21 ! ----------------- 21 ! ------------------ 22 22 ! 23 23 ! … … 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Schrempf: 28 ! Bugfix in rotate 3D-Model human to desired direction 29 ! Bugfix in interpolate to accurate Solar Azimuth Angle 30 ! Further changes in variables 31 ! 32 ! 3448 2018-10-29 18:14:31Z kanani 27 33 ! Temporary rename of namelist until uv model moves to biometeorology module 28 34 ! … … 90 96 USE kinds 91 97 92 ! 93 !-- Load required variables from existing modules 94 !-- USE modulename, & 95 !-- ONLY: ... 98 USE date_and_time_mod, & 99 ONLY: calc_date_and_time, day_of_year, time_utc 100 101 USE netcdf_data_input_mod, & 102 ONLY: netcdf_data_input_uvem, uvem_projarea_f, uvem_radiance_f, & 103 uvem_irradiance_f, uvem_integration_f, building_obstruction_f 104 96 105 97 106 … … 102 111 !-- Declare all global variables within the module (alphabetical order) 103 112 INTEGER(iwp) :: ai = 0 !< running index 104 INTEGER(iwp) :: clothing = 3 !< clothing (0=unclothed, 1=Arms,Hands Face free, 3=Hand, Face free) 105 INTEGER(iwp) :: consider_obstructions = 1 !< 0 = unobstructed scenario, 106 !< 1 = scenario where obstrcutions are considered 107 INTEGER(iwp) :: orientation_angle = 0 !< orientation of front/face of the human model 108 INTEGER(iwp) :: saa_in_south = 1 !< 0 = sun always in south direction, 1 = actual sun position 109 INTEGER(iwp) :: obstruction_direct_beam = 0 !< Obstruction information for direct beam 110 INTEGER(iwp) :: turn_to_sun = 1 !< 0 = orientation of human as in orientation_angle, 111 !< 1 = human is always orientated towards the sun 113 INTEGER(iwp) :: clothing = 1 !< clothing (0=unclothed, 1=Arms,Hands Face free, 3=Hand, Face free) 114 INTEGER(iwp) :: obstruction_direct_beam = 0 !< Obstruction information for direct beam 112 115 INTEGER(iwp) :: zi = 0 !< running index 113 116 114 INTEGER( iwp), DIMENSION(0:44) :: obstruction_temp1 = 0 !< temporary obstruction information117 INTEGER(KIND=1), DIMENSION(0:44) :: obstruction_temp1 = 0 !< temporary obstruction information 115 118 !< stored with ibset as logical information 116 119 INTEGER(iwp), DIMENSION(0:359) :: obstruction_temp2 = 0 !< temporary obstruction information restored values 117 120 !< from logical information, which where stored by ibset 118 121 119 INTEGER(iwp), DIMENSION(0:35,0:9) :: obstruction = 0!< final obstruction information array for all122 INTEGER(iwp), DIMENSION(0:35,0:9) :: obstruction = 1 !< final obstruction information array for all 120 123 !< hemispherical directions 121 124 122 INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: obstruction_lookup_table !< lookup table of obstruction 123 !< information of entire domain 124 125 REAL(wp) :: diffuse_exposure = 0.0_wp !< calculated exposure by diffuse radiation 126 REAL(wp) :: direct_exposure = 0.0_wp !< calculated exposure by direct beam 127 REAL(wp) :: projection_area_direct_beam = 0.0_wp !< projection area for by direct beam 125 LOGICAL :: consider_obstructions = .TRUE. !< namelist parameter (see documentation) 126 LOGICAL :: sun_in_south = .FALSE. !< namelist parameter (see documentation) 127 LOGICAL :: turn_to_sun = .TRUE. !< namelist parameter (see documentation) 128 129 REAL(wp) :: diffuse_exposure = 0.0_wp !< calculated exposure by diffuse radiation 130 REAL(wp) :: direct_exposure = 0.0_wp !< calculated exposure by direct beam 131 REAL(wp) :: orientation_angle = 0.0_wp !< orientation of front/face of the human model 132 REAL(wp) :: projection_area_direct_beam = 0.0_wp !< projection area for by direct beam 128 133 REAL(wp) :: saa = 180.0_wp !< solar azimuth angle 129 REAL(wp) :: startpos_human = 0.0_wp !< start position in azimuth direction for the 130 !< interpolation of the projection area 131 REAL(wp) :: startpos_saa_float = 0.0_wp !< start position in azimuth direction for the 132 !< interpolation of the radiance field 133 REAL(wp) :: sza = 20.0_wp !< solar zenith angle 134 REAL(wp) :: xfactor = 0.0_wp !< relative x-position used for interpolation 135 REAL(wp) :: yfactor = 0.0_wp !< relative y-position used for interpolation 136 137 REAL(wp), DIMENSION(0:2) :: irradiance = 0.0_wp !< iradiance values extracted from irradiance lookup table 138 134 REAL(wp) :: startpos_human = 0.0_wp !< start position in azimuth direction for the 135 !< interpolation of the projection area 136 REAL(wp) :: startpos_saa_float = 0.0_wp !< start position in azimuth direction for the 137 !< interpolation of the radiance field 138 REAL(wp) :: sza = 20.0_wp !< solar zenith angle 139 REAL(wp) :: xfactor = 0.0_wp !< relative x-position used for interpolation 140 REAL(wp) :: yfactor = 0.0_wp !< relative y-position used for interpolation 141 142 REAL(wp), DIMENSION(0:2) :: irradiance = 0.0_wp !< iradiance values extracted from irradiance lookup table 139 143 REAL(wp), DIMENSION(0:2,0:90) :: irradiance_lookup_table = 0.0_wp !< irradiance lookup table contains values 140 144 !< for direct, diffuse and global component 145 141 146 REAL(wp), DIMENSION(0:35,0:9) :: integration_array = 0.0_wp 142 147 REAL(wp), DIMENSION(0:35,0:9) :: projection_area = 0.0_wp 143 148 REAL(wp), DIMENSION(0:35,0:9) :: projection_area_lookup_table = 0.0_wp 149 REAL(wp), DIMENSION(0:71,0:9) :: projection_area_direct_temp = 0.0_wp 144 150 REAL(wp), DIMENSION(0:71,0:9) :: projection_area_temp = 0.0_wp 145 151 REAL(wp), DIMENSION(0:35,0:9) :: radiance_array = 0.0_wp … … 181 187 MODULE PROCEDURE uvem_check_data_output 182 188 END INTERFACE uvem_check_data_output 183 184 ! !185 ! !-- Data output checks for profile data to be done in check_parameters186 ! INTERFACE uvem_check_data_output_pr187 ! MODULE PROCEDURE uvem_check_data_output_pr188 ! END INTERFACE uvem_check_data_output_pr189 !190 ! !191 ! !-- Input parameter checks to be done in check_parameters192 ! INTERFACE uvem_check_parameters193 ! MODULE PROCEDURE uvem_check_parameters194 ! END INTERFACE uvem_check_parameters195 189 ! 196 190 ! … … 200 194 END INTERFACE uvem_3d_data_averaging 201 195 ! 202 ! !196 ! 203 197 !-- Data output of 2D quantities 204 198 INTERFACE uvem_data_output_2d … … 206 200 END INTERFACE uvem_data_output_2d 207 201 ! 208 ! ! 209 ! !-- Data output of 3D data 210 ! INTERFACE uvem_data_output_3d 211 ! MODULE PROCEDURE uvem_data_output_3d 212 ! END INTERFACE uvem_data_output_3d 213 ! 214 ! ! 202 ! 215 203 ! !-- Definition of data output quantities 216 204 INTERFACE uvem_define_netcdf_grid 217 205 MODULE PROCEDURE uvem_define_netcdf_grid 218 206 END INTERFACE uvem_define_netcdf_grid 219 ! 220 ! ! 221 ! !-- Output of information to the header file 222 ! INTERFACE uvem_header 223 ! MODULE PROCEDURE uvem_header 224 ! END INTERFACE uvem_header 225 207 ! 226 208 ! 227 209 !-- Initialization actions … … 229 211 MODULE PROCEDURE uvem_init 230 212 END INTERFACE uvem_init 231 232 ! 233 ! -- Initialization of arrays213 ! 214 ! 215 ! !-- Initialization of arrays 234 216 INTERFACE uvem_init_arrays 235 217 MODULE PROCEDURE uvem_init_arrays 236 218 END INTERFACE uvem_init_arrays 237 !238 ! !239 ! !-- Writing of binary output for restart runs !!! renaming?!240 ! INTERFACE uvem_wrd_global241 ! MODULE PROCEDURE uvem_wrd_global242 ! END INTERFACE uvem_wrd_global243 219 ! 244 220 ! 245 ! -- Reading of NAMELIST parameters221 ! !-- Reading of NAMELIST parameters 246 222 INTERFACE uvem_parin 247 223 MODULE PROCEDURE uvem_parin 248 224 END INTERFACE uvem_parin 249 !250 ! !251 ! !-- Reading of parameters for restart runs252 ! INTERFACE uvem_rrd_global253 ! MODULE PROCEDURE uvem_rrd_global254 ! END INTERFACE uvem_rrd_global255 !256 ! !257 ! !-- Swapping of time levels (required for prognostic variables)258 ! INTERFACE uvem_swap_timelevel259 ! MODULE PROCEDURE uvem_swap_timelevel260 ! END INTERFACE uvem_swap_timelevel261 !262 ! !263 ! !-- New module-specific procedure(s) (alphabetical order):264 ! INTERFACE uvem_newprocedure265 ! MODULE PROCEDURE uvem_newprocedure266 ! END INTERFACE uvem_newprocedure267 225 268 226 CONTAINS … … 457 415 CHARACTER (LEN=80) :: line !< dummy string for current line in parameter file 458 416 459 NAMELIST /biometeorology_parameters_uv/ clothing 460 461 line = ' ' 462 417 NAMELIST /biometeorology_parameters_uv/ clothing, & 418 consider_obstructions, & 419 orientation_angle, & 420 sun_in_south, & 421 turn_to_sun 422 423 ! line = ' ' 463 424 ! 464 425 !-- Try to find uv exposure model namelist … … 477 438 !-- Set flag that indicates that the uv exposure model is switched on 478 439 uv_exposure = .TRUE. 440 GOTO 20 479 441 480 442 10 BACKSPACE( 11 ) … … 570 532 ONLY: initializing_actions 571 533 572 IMPLICIT NONE 573 574 ! 575 !-- Actions for initial runs 576 IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN 577 OPEN(90, STATUS='old',FILE=& 578 'RADIANCE', FORM='UNFORMATTED') 579 READ(90) radiance_lookup_table 580 CLOSE(90) 581 OPEN(90, STATUS='old',FILE=& 582 'IRRADIANCE', FORM='UNFORMATTED') 583 READ(90) irradiance_lookup_table 584 CLOSE(90) 585 586 !________________________LOAD Obstruction information _______________________________ 587 IF ( consider_obstructions == 1 ) THEN 588 OPEN(90, STATUS='old',FILE=& 589 'OBSTRUCTION', FORM='UNFORMATTED') 590 READ(90) obstruction_lookup_table 591 CLOSE(90) 592 ELSEIF( consider_obstructions == 0 ) THEN 593 obstruction(:,:) = 1 594 ENDIF 595 596 !________________________LOAD integration_array ________________________________________________________________________ 597 OPEN(90, STATUS='old',FILE=& 598 'SOLIDANGLE', FORM='UNFORMATTED') 599 READ(90) integration_array 600 CLOSE(90) 601 602 IF (clothing==1) THEN 603 OPEN(90, STATUS='old',FILE='HUMAN', FORM='UNFORMATTED') 604 ENDIF 605 READ(90) projection_area_lookup_table 606 CLOSE(90) 607 608 ! 609 !-- Actions for restart runs 610 ELSE 611 ! .... 612 613 ENDIF 534 USE netcdf_data_input_mod, & 535 ONLY: netcdf_data_input_uvem, uvem_projarea_f, uvem_radiance_f, & 536 uvem_irradiance_f, uvem_integration_f, building_obstruction_f 537 538 IMPLICIT NONE 539 540 CALL netcdf_data_input_uvem 614 541 615 542 END SUBROUTINE uvem_init … … 627 554 628 555 556 629 557 IMPLICIT NONE 630 558 … … 633 561 ALLOCATE ( vitd3_exposure(nysg:nyng,nxlg:nxrg) ) 634 562 ALLOCATE ( vitd3_exposure_av(nysg:nyng,nxlg:nxrg) ) 635 ALLOCATE ( obstruction_lookup_table(nxlg:nxrg,nysg:nyng,0:44) )636 563 637 564 ! … … 639 566 vitd3_exposure = 0.0_wp 640 567 vitd3_exposure_av = 0.0_wp 641 obstruction_lookup_table = 0642 568 643 569 … … 660 586 661 587 662 REAL(wp) :: alpha = 0.0_wp !< solar azimuth angle in radiant 588 REAL(wp) :: alpha = 0.0_wp !< solar azimuth angle in radiant 589 REAL(wp) :: doy_r = 0.0_wp !< real format of day_of_year 663 590 REAL(wp) :: declination = 0.0_wp !< declination 664 591 REAL(wp) :: dtor = 0.0_wp !< factor to convert degree to radiant … … 674 601 675 602 CALL calc_date_and_time 676 603 doy_r = real(day_of_year) 677 604 dtor = pi / 180.0_wp 678 605 lat = latitude … … 680 607 ! 681 608 !-- calculation of js : 682 js= 72.0_wp * ( d ay_of_year + ( time_utc / 86400.0_wp ) ) / 73.0_wp609 js= 72.0_wp * ( doy_r + ( time_utc / 86400.0_wp ) ) / 73.0_wp 683 610 ! 684 611 !-- calculation of equation of time (zgl): … … 704 631 ! 705 632 !-- calculation of solar azimuth angle 706 IF (woz .LE. 12.0_wp) alpha = pi - acos( sin(thetasr) * sin(lat * dtor) -&707 sin( declination * dtor ) / ( cos(thetasr) * cos( lat * dtor ) ) )708 IF (woz .GT. 12.0_wp) alpha = pi + acos( sin(thetasr) * sin(lat * dtor) -&709 sin( declination * dtor ) / ( cos(thetasr) * cos( lat * dtor ) ) )633 IF (woz .LE. 12.0_wp) alpha = pi - acos( (sin(thetasr) * sin(lat * dtor) - & 634 sin( declination * dtor )) / ( cos(thetasr) * cos( lat * dtor ) ) ) 635 IF (woz .GT. 12.0_wp) alpha = pi + acos( (sin(thetasr) * sin(lat * dtor) - & 636 sin( declination * dtor )) / ( cos(thetasr) * cos( lat * dtor ) ) ) 710 637 saa = alpha / dtor 711 638 … … 721 648 722 649 USE indices, & 723 ONLY: nxlg, nxrg, nyng, nysg 650 ONLY: nxlg, nxrg, nyng, nysg, nys, nyn, nxl, nxr 724 651 725 652 … … 728 655 INTEGER(iwp) :: i !< running index 729 656 INTEGER(iwp) :: j !< running index 730 657 INTEGER(iwp) :: k !< running index 731 658 732 659 CALL uvem_solar_position … … 736 663 ELSE 737 664 738 ! 665 DO i = 0, 35 666 DO j = 0, 9 667 projection_area_lookup_table(i,j) = uvem_projarea_f%var(clothing,j,i) 668 ENDDO 669 ENDDO 670 DO i = 0, 35 671 DO j = 0, 9 672 integration_array(i,j) = uvem_integration_f%var(j,i) 673 ENDDO 674 ENDDO 675 DO i = 0, 2 676 DO j = 0, 90 677 irradiance_lookup_table(i,j) = uvem_irradiance_f%var(j,i) 678 ENDDO 679 ENDDO 680 DO i = 0, 35 681 DO j = 0, 9 682 DO k = 0, 90 683 radiance_lookup_table(i,j,k) = uvem_radiance_f%var(k,j,i) 684 ENDDO 685 ENDDO 686 ENDDO 687 688 689 739 690 !-- rotate 3D-Model human to desired direction ----------------------------- 740 691 projection_area_temp( 0:35,:) = projection_area_lookup_table 741 692 projection_area_temp(36:71,:) = projection_area_lookup_table 742 IF ( Turn_to_Sun .EQ. 0) startpos_human = orientation_angle / 10.0_wp743 IF ( Turn_to_Sun .EQ. 1 ) startpos_human = startpos_saa_float693 IF ( .NOT. turn_to_sun ) startpos_human = orientation_angle / 10.0_wp 694 IF ( turn_to_sun ) startpos_human = saa / 10.0_wp 744 695 DO ai = 0, 35 745 696 xfactor = ( startpos_human ) - INT( startpos_human ) 746 697 DO zi = 0, 9 747 projection_area(ai,zi) = ( projection_area_temp( ai + INT( startpos_human ), zi) * &748 ( 1.0_wp -xfactor ) ) &749 +( projection_area_temp( ai + 1 + INT( startpos_human ), zi) * &750 xfactor)698 projection_area(ai,zi) = ( projection_area_temp( 36 - INT( startpos_human ) - 1 + ai , zi) * & 699 ( xfactor ) ) & 700 +( projection_area_temp( 36 - INT( startpos_human ) + ai , zi) * & 701 ( 1.0_wp - xfactor ) ) 751 702 ENDDO 752 ENDDO 753 ! 754 !-- calculate Projectionarea for direct beam -----------------------------' 755 projection_area_temp( 0:35,:) = projection_area 756 projection_area_temp(36:71,:) = projection_area 757 yfactor = ( sza / 10.0_wp ) - INT( sza / 10.0_wp ) 758 xfactor = ( startpos_saa_float ) - INT( startpos_saa_float ) 759 projection_area_direct_beam = ( projection_area_temp( INT(startpos_saa_float) ,INT( sza / 10.0_wp ) ) * & 760 ( 1.0_wp - xfactor ) * ( 1.0_wp - yfactor ) ) + & 761 ( projection_area_temp( INT(startpos_saa_float) + 1,INT(sza/10.0_wp)) *& 762 ( xfactor ) * ( 1.0_wp - yfactor ) ) + & 763 ( projection_area_temp( INT(startpos_saa_float) ,INT(sza/10.0_wp)+1)*& 764 ( 1.0_wp - xfactor ) * ( yfactor ) ) + & 765 ( projection_area_temp( INT(startpos_saa_float) + 1,INT(sza/10.0_wp)+1)*& 766 ( xfactor ) * ( yfactor ) ) 767 768 703 ENDDO 704 ! 769 705 ! 770 706 !-- interpolate to accurate Solar Zenith Angle ------------------ … … 776 712 ENDDO 777 713 ENDDO 778 Do ai = 0, 2 714 Do ai = 0, 2 779 715 irradiance(ai) = ( irradiance_lookup_table(ai, INT(sza) ) * ( 1.0_wp - xfactor)) + & 780 716 (irradiance_lookup_table(ai, INT(sza) + 1) * xfactor ) … … 782 718 ! 783 719 !-- interpolate to accurate Solar Azimuth Angle ------------------ 784 IF ( s aa_in_south .EQ. 0) THEN720 IF ( sun_in_south ) THEN 785 721 startpos_saa_float = 180.0_wp / 10.0_wp 786 722 ELSE … … 790 726 radiance_array_temp(36:71,:) = radiance_array 791 727 xfactor = (startpos_saa_float) - INT(startpos_saa_float) 792 DO ai = 0, 35728 DO ai = 0, 35 793 729 DO zi = 0, 9 794 radiance_array(ai,zi) = ( radiance_array_temp( ai + INT( startpos_saa_float ), zi ) * &795 ( 1.0_wp - xfactor)) &796 + ( radiance_array_temp( ai + 1 + INT( startpos_saa_float ), zi ) &797 * xfactor)730 radiance_array(ai,zi) = ( radiance_array_temp( 36 - INT( startpos_saa_float ) - 1 + ai , zi ) * & 731 ( xfactor ) ) & 732 + ( radiance_array_temp( 36 - INT( startpos_saa_float ) + ai , zi ) & 733 * ( 1.0_wp - xfactor ) ) 798 734 ENDDO 799 735 ENDDO 800 801 802 803 804 DO i = nxlg, nxrg 805 DO j = nysg, nyng 806 ! 807 !-- extract obstrcution from IBSET-Integer_Array ------------------' 808 IF (consider_obstructions == 1) THEN 809 obstruction_temp1 = obstruction_lookup_table(i,j,:) 736 ! 737 ! 738 !-- calculate Projectionarea for direct beam -----------------------------' 739 projection_area_direct_temp( 0:35,:) = projection_area 740 projection_area_direct_temp(36:71,:) = projection_area 741 yfactor = ( sza / 10.0_wp ) - INT( sza / 10.0_wp ) 742 xfactor = ( startpos_saa_float ) - INT( startpos_saa_float ) 743 projection_area_direct_beam = ( projection_area_direct_temp( INT(startpos_saa_float) ,INT(sza/10.0_wp) ) *& 744 ( 1.0_wp - xfactor ) * ( 1.0_wp - yfactor ) ) + & 745 ( projection_area_direct_temp( INT(startpos_saa_float) + 1,INT(sza/10.0_wp) ) *& 746 ( xfactor ) * ( 1.0_wp - yfactor ) ) + & 747 ( projection_area_direct_temp( INT(startpos_saa_float) ,INT(sza/10.0_wp)+1) *& 748 ( 1.0_wp - xfactor ) * ( yfactor ) ) + & 749 ( projection_area_direct_temp( INT(startpos_saa_float) + 1,INT(sza/10.0_wp)+1) *& 750 ( xfactor ) * ( yfactor ) ) 751 ! 752 ! 753 ! 754 DO i = nxl, nxr !nxlg, nxrg 755 DO j = nys, nyn !nysg, nyng 756 ! 757 ! !-- extract obstruction from IBSET-Integer_Array ------------------' 758 IF (consider_obstructions ) THEN 759 obstruction_temp1 = building_obstruction_f%var_3d(:,j,i) 810 760 IF (obstruction_temp1(0) .NE. 9) THEN 811 761 DO zi = 0, 44 … … 826 776 ENDIF 827 777 ! 828 ! --calculated human exposure ------------------'778 ! !-- calculated human exposure ------------------' 829 779 diffuse_exposure = SUM( radiance_array * projection_area * integration_array * obstruction ) 830 780 … … 834 784 ENDIF 835 785 ! 836 ! --calculate direct normal irradiance (direct beam) ------------------'786 ! !-- calculate direct normal irradiance (direct beam) ------------------' 837 787 direct_exposure = ( irradiance(1) / cos( pi * sza / 180.0_wp ) ) * & 838 788 projection_area_direct_beam * obstruction_direct_beam … … 846 796 END SUBROUTINE uvem_calc_exposure 847 797 848 849 850 851 852 ! ------------------------------------------------------------------------------!853 ! Description:854 ! ------------855 ! > Check parameters routine856 ! ------------------------------------------------------------------------------!857 ! SUBROUTINE uvem_check_parameters858 !859 ! USE control_parameters, &860 ! ONLY: message_string861 !862 !863 ! IMPLICIT NONE864 !865 !866 ! -- Checks go here (cf. check_parameters.f90).867 !868 ! END SUBROUTINE uvem_check_parameters869 870 871 872 ! !------------------------------------------------------------------------------!873 ! ! Description:874 ! ! ------------875 ! !> Header output876 ! !------------------------------------------------------------------------------!877 ! SUBROUTINE uvem_header ( io )878 !879 !880 ! IMPLICIT NONE881 !882 !883 ! INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file884 !885 ! !886 ! !-- Header output goes here887 ! !-- ...888 !889 ! END SUBROUTINE uvem_header890 891 892 893 ! !------------------------------------------------------------------------------!894 ! ! Description:895 ! ! ------------896 ! !> This routine reads the global restart data.897 ! !------------------------------------------------------------------------------!898 ! SUBROUTINE uvem_rrd_global899 !900 !901 ! USE control_parameters, &902 ! ONLY: length, restart_string903 !904 !905 ! IMPLICIT NONE906 !907 ! LOGICAL, INTENT(OUT) :: found908 !909 !910 ! found = .TRUE.911 !912 !913 ! SELECT CASE ( restart_string(1:length) )914 !915 ! CASE ( 'param1' )916 ! READ ( 13 ) param1917 !918 ! CASE DEFAULT919 !920 ! found = .FALSE.921 !922 ! END SELECT923 !924 ! END SUBROUTINE uvem_rrd_global925 926 927 ! !------------------------------------------------------------------------------!928 ! ! Description:929 ! ! ------------930 ! !> This routine writes the global restart data.931 ! !------------------------------------------------------------------------------!932 ! SUBROUTINE uvem_wrd_global933 !934 !935 ! IMPLICIT NONE936 !937 !938 ! CALL wrd_write_string( 'param1' )939 ! WRITE ( 14 ) param1940 !941 !942 !943 ! END SUBROUTINE uvem_wrd_global944 945 946 798 END MODULE uv_exposure_model_mod
Note: See TracChangeset
for help on using the changeset viewer.
