Changeset 3678 for palm/trunk/UTIL/inifor/src/inifor_grid.f90
- Timestamp:
- Jan 17, 2019 2:12:17 PM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/UTIL/inifor/src/inifor_grid.f90
r3618 r3678 26 26 ! ----------------- 27 27 ! $Id$ 28 ! bugfix: Avoid empty averaging regions for small PALM domains 29 ! change: moved get_input_file_list() to io module 30 ! 31 ! 32 ! 3618 2018-12-10 13:25:22Z eckhard 28 33 ! Prefixed all INIFOR modules with inifor_, removed unused variables 29 34 ! … … 112 117 ONLY: get_netcdf_attribute, get_netcdf_dim_vector, & 113 118 get_netcdf_variable, parse_command_line_arguments, & 114 validate_config119 get_input_file_list, validate_config 115 120 USE inifor_transform, & 116 121 ONLY: average_2d, rotate_to_cosmo, find_horizontal_neighbours,& … … 1625 1630 dlat = cosmo_lat(1) - cosmo_lat(0) 1626 1631 1627 imin = CEILING( (avg_grid % lon(1) - cosmo_lon(0)) / dlon )1628 imax = FLOOR( (avg_grid % lon(2) - cosmo_lon(0)) / dlon )1629 1630 jmin = CEILING( (avg_grid % lat(1) - cosmo_lat(0)) / dlat )1631 jmax = FLOOR( (avg_grid % lat(2) - cosmo_lat(0)) / dlat )1632 imin = FLOOR ( (avg_grid % lon(1) - cosmo_lon(0)) / dlon ) 1633 imax = CEILING( (avg_grid % lon(2) - cosmo_lon(0)) / dlon ) 1634 1635 jmin = FLOOR ( (avg_grid % lat(1) - cosmo_lat(0)) / dlat ) 1636 jmax = CEILING( (avg_grid % lat(2) - cosmo_lat(0)) / dlat ) 1632 1637 1633 1638 message = "Averaging '" // TRIM(avg_grid % kind) // "' over "// & … … 3641 3646 3642 3647 3643 SUBROUTINE get_input_file_list(start_date_string, start_hour, end_hour, &3644 step_hour, path, prefix, suffix, file_list)3645 3646 CHARACTER (LEN=DATE), INTENT(IN) :: start_date_string3647 CHARACTER (LEN=*), INTENT(IN) :: prefix, suffix, path3648 INTEGER, INTENT(IN) :: start_hour, end_hour, step_hour3649 CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: file_list(:)3650 3651 INTEGER :: number_of_intervals, hour, i3652 CHARACTER(LEN=DATE) :: date_string3653 3654 number_of_intervals = CEILING( REAL(end_hour - start_hour) / step_hour )3655 ALLOCATE( file_list(number_of_intervals + 1) )3656 3657 DO i = 0, number_of_intervals3658 hour = start_hour + i * step_hour3659 date_string = add_hours_to(start_date_string, hour)3660 3661 file_list(i+1) = TRIM(path) // TRIM(prefix) // TRIM(date_string) // &3662 TRIM(suffix) // '.nc'3663 message = "Set up input file name '" // TRIM(file_list(i+1)) //"'"3664 CALL report('input_file_list', message)3665 END DO3666 3667 END SUBROUTINE get_input_file_list3668 3669 3670 3648 !------------------------------------------------------------------------------! 3671 3649 ! Description:
Note: See TracChangeset
for help on using the changeset viewer.