Changeset 3474


Ignore:
Timestamp:
Oct 30, 2018 9:07:39 PM (6 years ago)
Author:
kanani
Message:

Add netcdf input for uv exposure model (netcdf_data_input_mod, Makefile, .palm.iofiles), plus bugfixes (uv_exposure_model_mod)

Location:
palm/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SCRIPTS/.palm.iofiles

    r3472 r3474  
    1313PIDS_SALSA               inopt:tr   d3#:d3r  $base_data/$run_identifier/INPUT          _salsa*
    1414PIDS_CHEM                inopt:tr   d3#:d3r  $base_data/$run_identifier/INPUT          _chemistry*
     15PIDS_UVEM                inopt:tr   d3#:d3r  $base_data/$run_identifier/INPUT          _uvlookup*
    1516PIDS_VM                  inopt:tr   d3#:d3r  $base_data/$run_identifier/INPUT          _vmeas*
    1617rrtmg_lw.nc              inopt:tr   d3#:d3r  $base_data/$run_identifier/INPUT          _rlw
  • palm/trunk/SOURCE/Makefile

    r3473 r3474  
    19601960        mod_kinds.o \
    19611961        modules.o \
     1962        netcdf_data_input_mod.o \
    19621963        radiation_model_mod.o
    19631964vertical_nesting_mod.o: \
  • palm/trunk/SOURCE/netcdf_data_input_mod.f90

    r3472 r3474  
    2525! -----------------
    2626! $Id$
     27! Add UV exposure model input (Schrempf)
     28!
     29! 3472 2018-10-30 20:43:50Z suehring
    2730! Salsa implemented
    2831!
     
    446449    END TYPE int_2d_8bit
    447450!
     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!
    448459!-- 32-bit Integer 2D
    449460    TYPE int_2d_32bit
     
    464475
    465476!
    466 !-- Define data type to read 2D real variables
     477!-- Define data type to read 3D real variables
    467478    TYPE real_3d
    468479       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default values are used
     
    629640    TYPE(int_2d_8bit)  ::  vegetation_type_f !< input variable for vegetation type
    630641    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
    632646!
    633647!-- Define 2D variables of type NC_INT
     
    636650!-- Define 2D variables of type NC_FLOAT
    637651    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
    638654!
    639655!-- Define 3D variables of type NC_FLOAT
     
    642658    TYPE(real_3d) ::  root_area_density_lad_f !< input variable for root area density - resolved vegetation
    643659    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
    645662!
    646663!-- Define input variable for buildings
     
    670687    CHARACTER(LEN=100) ::  input_file_dynamic = 'PIDS_DYNAMIC' !< Name of file which comprises dynamic input data
    671688    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
    672690    CHARACTER(LEN=100) ::  input_file_vm      = 'PIDS_VM'      !< Name of file which comprises virtual measurement data
    673691
    674692    CHARACTER (LEN=25), ALLOCATABLE, DIMENSION(:)    ::  string_values  !< output of string variables read from netcdf input files
    675  
     693
    676694    INTEGER(iwp)                                     ::  id_emis        !< NetCDF id of input file for chemistry emissions: TBD: It has to be removed
    677695
     
    681699    LOGICAL ::  input_pids_dynamic = .FALSE.   !< Flag indicating whether Palm-input-data-standard file containing dynamic information exists
    682700    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
    683702    LOGICAL ::  input_pids_vm      = .FALSE.   !< Flag indicating whether input file for virtual measurements exist
    684    
     703
    685704    LOGICAL ::  collective_read = .FALSE.      !< Enable NetCDF collective read
    686705
     
    749768       MODULE PROCEDURE netcdf_data_input_var_real_2d
    750769    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
    751774
    752775    INTERFACE get_variable
     
    791814           terrain_height_f, vegetation_pars_f, vegetation_type_f,             &
    792815           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
    793822
    794823!
     
    804833           netcdf_data_input_var, get_attribute, get_variable, open_read_file
    805834
     835
    806836 CONTAINS
    807837
     
    826856       INQUIRE( FILE = TRIM( input_file_chem )    // TRIM( coupling_char ),    &
    827857                EXIST = input_pids_chem )
     858       INQUIRE( FILE = TRIM( input_file_uvem ) // TRIM( coupling_char ),       &
     859                EXIST = input_pids_uvem  )
    828860       INQUIRE( FILE = TRIM( input_file_vm )      // TRIM( coupling_char ),    &
    829861                EXIST = input_pids_vm )
     
    24972529! Description:
    24982530! ------------
     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! ------------
    24992659!> Reads orography and building information.
    25002660!------------------------------------------------------------------------------!
  • palm/trunk/SOURCE/uv_exposure_model_mod.f90

    r3448 r3474  
    1919!
    2020! Current revisions:
    21 ! -----------------
     21! ------------------
    2222!
    2323!
     
    2525! -----------------
    2626! $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
    2733! Temporary rename of namelist until uv model moves to biometeorology module
    2834!
     
    9096    USE kinds
    9197
    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
    96105
    97106
     
    102111!-- Declare all global variables within the module (alphabetical order)
    103112    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   
    112115    INTEGER(iwp) ::  zi                      = 0 !< running index
    113116
    114     INTEGER(iwp), DIMENSION(0:44)  ::  obstruction_temp1 = 0 !< temporary obstruction information
     117    INTEGER(KIND=1), DIMENSION(0:44)  ::  obstruction_temp1 = 0 !< temporary obstruction information
    115118                                                             !< stored with ibset as logical information
    116119    INTEGER(iwp), DIMENSION(0:359) ::  obstruction_temp2 = 0 !< temporary obstruction information restored values
    117120                                                             !< from logical information, which where stored by ibset 
    118121   
    119     INTEGER(iwp), DIMENSION(0:35,0:9) ::  obstruction = 0 !< final obstruction information array for all
     122    INTEGER(iwp), DIMENSION(0:35,0:9) ::  obstruction = 1 !< final obstruction information array for all
    120123                                                          !< hemispherical directions
    121124   
    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
    128133    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   
    139143    REAL(wp), DIMENSION(0:2,0:90) ::  irradiance_lookup_table = 0.0_wp !< irradiance lookup table contains values
    140144                                                                       !< for direct, diffuse and global component
     145
    141146    REAL(wp), DIMENSION(0:35,0:9) ::  integration_array            = 0.0_wp
    142147    REAL(wp), DIMENSION(0:35,0:9) ::  projection_area              = 0.0_wp
    143148    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
    144150    REAL(wp), DIMENSION(0:71,0:9) ::  projection_area_temp         = 0.0_wp
    145151    REAL(wp), DIMENSION(0:35,0:9) ::  radiance_array               = 0.0_wp
     
    181187       MODULE PROCEDURE uvem_check_data_output
    182188    END INTERFACE uvem_check_data_output
    183    
    184 ! !
    185 ! !-- Data output checks for profile data to be done in check_parameters
    186 !     INTERFACE uvem_check_data_output_pr
    187 !        MODULE PROCEDURE uvem_check_data_output_pr
    188 !     END INTERFACE uvem_check_data_output_pr
    189 !     
    190 ! !
    191 ! !-- Input parameter checks to be done in check_parameters
    192 !     INTERFACE uvem_check_parameters
    193 !        MODULE PROCEDURE uvem_check_parameters
    194 !     END INTERFACE uvem_check_parameters
    195189!
    196190!
     
    200194    END INTERFACE uvem_3d_data_averaging
    201195!
    202 ! !
     196!
    203197!-- Data output of 2D quantities
    204198    INTERFACE uvem_data_output_2d
     
    206200    END INTERFACE uvem_data_output_2d
    207201!
    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!
    215203! !-- Definition of data output quantities
    216204    INTERFACE uvem_define_netcdf_grid
    217205       MODULE PROCEDURE uvem_define_netcdf_grid
    218206    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
    226208!
    227209!-- Initialization actions 
     
    229211       MODULE PROCEDURE uvem_init
    230212    END INTERFACE uvem_init
    231 
    232 !
    233 !-- Initialization of arrays
     213!
     214!
     215! !-- Initialization of arrays
    234216    INTERFACE uvem_init_arrays
    235217       MODULE PROCEDURE uvem_init_arrays
    236218    END INTERFACE uvem_init_arrays
    237 !
    238 ! !
    239 ! !-- Writing of binary output for restart runs  !!! renaming?!
    240 !     INTERFACE uvem_wrd_global
    241 !        MODULE PROCEDURE uvem_wrd_global
    242 !     END INTERFACE uvem_wrd_global
    243219!     
    244220!
    245 !-- Reading of NAMELIST parameters
     221! !-- Reading of NAMELIST parameters
    246222    INTERFACE uvem_parin
    247223       MODULE PROCEDURE uvem_parin
    248224    END INTERFACE uvem_parin
    249 !
    250 ! !
    251 ! !-- Reading of parameters for restart runs
    252 !     INTERFACE uvem_rrd_global
    253 !        MODULE PROCEDURE uvem_rrd_global
    254 !     END INTERFACE uvem_rrd_global
    255 !
    256 ! !
    257 ! !-- Swapping of time levels (required for prognostic variables)
    258 !     INTERFACE uvem_swap_timelevel
    259 !        MODULE PROCEDURE uvem_swap_timelevel
    260 !     END INTERFACE uvem_swap_timelevel
    261 !
    262 ! !
    263 ! !-- New module-specific procedure(s) (alphabetical order):
    264 !     INTERFACE uvem_newprocedure
    265 !        MODULE PROCEDURE uvem_newprocedure
    266 !     END INTERFACE uvem_newprocedure
    267225
    268226 CONTAINS
     
    457415    CHARACTER (LEN=80) ::  line  !< dummy string for current line in parameter file
    458416   
    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 = ' ' 
    463424!
    464425!-- Try to find uv exposure model namelist
     
    477438!-- Set flag that indicates that the uv exposure model is switched on
    478439    uv_exposure = .TRUE.
     440    GOTO 20
    479441
    480442 10 BACKSPACE( 11 )
     
    570532        ONLY:  initializing_actions
    571533
    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
    614541
    615542 END SUBROUTINE uvem_init
     
    627554
    628555
     556
    629557    IMPLICIT NONE
    630558
     
    633561    ALLOCATE ( vitd3_exposure(nysg:nyng,nxlg:nxrg) )
    634562    ALLOCATE ( vitd3_exposure_av(nysg:nyng,nxlg:nxrg) )
    635     ALLOCATE ( obstruction_lookup_table(nxlg:nxrg,nysg:nyng,0:44) )
    636563
    637564!
     
    639566    vitd3_exposure = 0.0_wp
    640567    vitd3_exposure_av = 0.0_wp
    641     obstruction_lookup_table = 0
    642568
    643569
     
    660586   
    661587   
    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           
    663590    REAL(wp) ::  declination = 0.0_wp   !< declination
    664591    REAL(wp) ::  dtor        = 0.0_wp   !< factor to convert degree to radiant
     
    674601
    675602    CALL calc_date_and_time
    676        
     603    doy_r = real(day_of_year)   
    677604    dtor = pi / 180.0_wp
    678605    lat = latitude
     
    680607!
    681608!-- calculation of js :
    682     js=  72.0_wp * ( day_of_year + ( time_utc / 86400.0_wp ) ) / 73.0_wp
     609    js=  72.0_wp * ( doy_r + ( time_utc / 86400.0_wp ) ) / 73.0_wp
    683610!
    684611!-- calculation of equation of time (zgl):
     
    704631!
    705632!-- 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 ) ) )   
    710637    saa = alpha / dtor
    711638
     
    721648
    722649    USE indices,                                                               &
    723         ONLY:  nxlg, nxrg, nyng, nysg
     650        ONLY:  nxlg, nxrg, nyng, nysg, nys, nyn, nxl, nxr
    724651   
    725652   
     
    728655    INTEGER(iwp) ::  i   !< running index
    729656    INTEGER(iwp) ::  j   !< running index
    730 
     657    INTEGER(iwp) ::  k   !< running index
    731658
    732659    CALL uvem_solar_position
     
    736663    ELSE
    737664       
    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       
    739690!--    rotate 3D-Model human to desired direction  -----------------------------
    740691       projection_area_temp( 0:35,:) = projection_area_lookup_table
    741692       projection_area_temp(36:71,:) = projection_area_lookup_table               
    742        IF ( Turn_to_Sun .EQ. 0 )  startpos_human = orientation_angle / 10.0_wp
    743        IF ( Turn_to_Sun .EQ. 1 )  startpos_human = startpos_saa_float       
     693       IF ( .NOT. turn_to_sun )  startpos_human = orientation_angle / 10.0_wp
     694       IF (       turn_to_sun )  startpos_human = saa / 10.0_wp       
    744695       DO  ai = 0, 35
    745696           xfactor = ( startpos_human ) - INT( startpos_human )
    746697          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 ) )
    751702          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!             
    769705!           
    770706!--    interpolate to accurate Solar Zenith Angle  ------------------         
     
    776712          ENDDO
    777713       ENDDO
    778        Do  ai = 0, 2           
     714       Do  ai = 0, 2
    779715           irradiance(ai) = ( irradiance_lookup_table(ai, INT(sza) ) * ( 1.0_wp - xfactor)) + &
    780716           (irradiance_lookup_table(ai, INT(sza) + 1) * xfactor )
     
    782718!         
    783719!--    interpolate to accurate Solar Azimuth Angle ------------------
    784        IF ( saa_in_south .EQ. 0 )  THEN
     720       IF ( sun_in_south )  THEN
    785721          startpos_saa_float = 180.0_wp / 10.0_wp
    786722       ELSE
     
    790726       radiance_array_temp(36:71,:) = radiance_array
    791727       xfactor = (startpos_saa_float) - INT(startpos_saa_float)
    792        DO  ai = 0, 35
     728              DO  ai = 0, 35
    793729          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 ) )
    798734          ENDDO
    799735       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)
    810760                IF (obstruction_temp1(0) .NE. 9) THEN
    811761                   DO  zi = 0, 44
     
    826776             ENDIF
    827777!             
    828 !--          calculated human exposure ------------------' 
     778! !--        calculated human exposure ------------------' 
    829779             diffuse_exposure = SUM( radiance_array * projection_area * integration_array * obstruction )     
    830780         
     
    834784             ENDIF
    835785!             
    836 !--          calculate direct normal irradiance (direct beam) ------------------'
     786! !--        calculate direct normal irradiance (direct beam) ------------------'
    837787             direct_exposure = ( irradiance(1) / cos( pi * sza / 180.0_wp ) ) * &
    838788             projection_area_direct_beam * obstruction_direct_beam 
     
    846796 END SUBROUTINE uvem_calc_exposure
    847797
    848 
    849 
    850 
    851  
    852 ! ------------------------------------------------------------------------------!
    853 ! Description:
    854 ! ------------
    855 ! > Check parameters routine
    856 ! ------------------------------------------------------------------------------!
    857 !  SUBROUTINE uvem_check_parameters
    858 !
    859 !     USE control_parameters,                                                    &
    860 !         ONLY:  message_string
    861 !
    862 !       
    863 !     IMPLICIT NONE
    864 !
    865 !
    866 ! --    Checks go here (cf. check_parameters.f90).
    867 !           
    868 !  END SUBROUTINE uvem_check_parameters
    869 
    870 
    871  
    872 ! !------------------------------------------------------------------------------!
    873 ! ! Description:
    874 ! ! ------------
    875 ! !> Header output
    876 ! !------------------------------------------------------------------------------!
    877 !  SUBROUTINE uvem_header ( io )
    878 !
    879 !
    880 !     IMPLICIT NONE
    881 !
    882 
    883 !     INTEGER(iwp), INTENT(IN) ::  io   !< Unit of the output file
    884 
    885 ! !
    886 ! !-- Header output goes here
    887 ! !-- ...
    888 !
    889 !  END SUBROUTINE uvem_header
    890 
    891 
    892 
    893 ! !------------------------------------------------------------------------------!
    894 ! ! Description:
    895 ! ! ------------
    896 ! !> This routine reads the global restart data.
    897 ! !------------------------------------------------------------------------------!
    898 !  SUBROUTINE uvem_rrd_global
    899 !
    900 !
    901 !     USE control_parameters,                                                    &
    902 !         ONLY: length, restart_string
    903 !
    904 !
    905 !     IMPLICIT NONE
    906 !
    907 !     LOGICAL, INTENT(OUT)  ::  found
    908 !
    909 !
    910 !     found = .TRUE.
    911 !       
    912 !       
    913 !     SELECT CASE ( restart_string(1:length) )
    914 !
    915 !       CASE ( 'param1' )
    916 !          READ ( 13 )  param1
    917 !
    918 !        CASE DEFAULT
    919 !
    920 !          found = .FALSE.   
    921 !
    922 !     END SELECT
    923 !
    924 !  END SUBROUTINE uvem_rrd_global 
    925    
    926 
    927 ! !------------------------------------------------------------------------------!
    928 ! ! Description:
    929 ! ! ------------
    930 ! !> This routine writes the global restart data.
    931 ! !------------------------------------------------------------------------------!
    932 !  SUBROUTINE uvem_wrd_global
    933 !
    934 !
    935 !     IMPLICIT NONE
    936 !
    937 !
    938 !     CALL wrd_write_string( 'param1' )
    939 !     WRITE ( 14 )  param1         
    940 !
    941 !       
    942 !       
    943 !  END SUBROUTINE uvem_wrd_global   
    944 
    945 
    946798 END MODULE uv_exposure_model_mod
Note: See TracChangeset for help on using the changeset viewer.