- Timestamp:
- May 30, 2018 5:43:55 PM (7 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 5 edited
-
init_3d_model.f90 (modified) (7 diffs, 1 prop)
-
init_grid.f90 (modified) (6 diffs)
-
land_surface_model_mod.f90 (modified) (4 diffs)
-
netcdf_data_input_mod.f90 (modified) (49 diffs)
-
synthetic_turbulence_generator_mod.f90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/init_3d_model.f90
- Property svn:mergeinfo changed
/palm/trunk/SOURCE/init_3d_model.f90 (added) merged: 3046,3049
r3049 r3051 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Move initialization call for nudging and 1D/3D offline nesting. 28 ! Revise initialization with inifor data. 29 ! 30 ! 3045 2018-05-28 07:55:41Z Giersch 27 31 ! Error messages revised 28 32 ! … … 1116 1120 1117 1121 ! 1118 !-- Initialize nudging if required1119 IF ( nudging ) THEN1120 CALL nudge_init1121 ENDIF1122 1123 !1124 !-- Initialize reading of large scale forcing from external file - if required1125 IF ( large_scale_forcing .OR. forcing ) THEN1126 CALL lsf_init1127 ENDIF1128 1129 !1130 1122 !-- Allocate arrays containing the RK coefficient for calculation of 1131 1123 !-- perturbation pressure and turbulent fluxes. At this point values are … … 1166 1158 CALL location_message( 'initializing with INIFOR', .FALSE. ) 1167 1159 ! 1168 !-- Read initial 1D profiles from NetCDF file if available. 1160 !-- Read initial 1D profiles or 3D data from NetCDF file, depending 1161 !-- on the provided level-of-detail. 1169 1162 !-- At the moment, only u, v, w, pt and q are provided. 1170 1163 CALL netcdf_data_input_init_3d … … 1177 1170 IF ( ANY( zu(1:nzt+1) /= init_3d%zu_atmos(1:init_3d%nzu) ) ) THEN 1178 1171 1179 CALL netcdf_data_input_interpolate( init_3d%u_init(nzb+1:nzt+1), & 1172 IF( init_3d%lod_u == 1 ) & 1173 CALL netcdf_data_input_interpolate( & 1174 init_3d%u_init(nzb+1:nzt+1), & 1180 1175 zu(nzb+1:nzt+1), & 1181 1176 init_3d%zu_atmos ) 1182 CALL netcdf_data_input_interpolate( init_3d%v_init(nzb+1:nzt+1), & 1177 1178 IF( init_3d%lod_v == 1 ) & 1179 CALL netcdf_data_input_interpolate( & 1180 init_3d%v_init(nzb+1:nzt+1), & 1183 1181 zu(nzb+1:nzt+1), & 1184 1182 init_3d%zu_atmos ) 1183 1185 1184 ! CALL netcdf_data_input_interpolate( init_3d%w_init(nzb+1:nzt), & 1186 1185 ! zw(nzb+1:nzt), & 1187 1186 ! init_3d%zw_atmos ) 1188 IF ( .NOT. neutral ) & 1187 1188 IF ( .NOT. neutral .AND. init_3d%lod_pt == 1 ) & 1189 1189 CALL netcdf_data_input_interpolate( & 1190 1190 init_3d%pt_init(nzb+1:nzt+1), & 1191 1191 zu(nzb+1:nzt+1), & 1192 1192 init_3d%zu_atmos ) 1193 IF ( humidity ) & 1193 1194 IF ( humidity .AND. init_3d%lod_q == 1 ) & 1194 1195 CALL netcdf_data_input_interpolate( & 1195 1196 init_3d%q_init(nzb+1:nzt+1), & … … 1197 1198 init_3d%zu_atmos ) 1198 1199 ENDIF 1199 1200 u_init = init_3d%u_init 1201 v_init = init_3d%v_init 1202 IF( .NOT. neutral ) pt_init = init_3d%pt_init 1203 IF( humidity ) q_init = init_3d%q_init 1200 ! 1201 !-- In case of LOD=1, initialize 1D profiles and 3D data. 1202 IF( init_3d%lod_u == 1 ) u_init = init_3d%u_init 1203 IF( init_3d%lod_v == 1 ) v_init = init_3d%v_init 1204 IF( .NOT. neutral .AND. init_3d%lod_pt == 1 ) & 1205 pt_init = init_3d%pt_init 1206 IF( humidity .AND. init_3d%lod_q == 1 ) & 1207 q_init = init_3d%q_init 1204 1208 1205 1209 ! … … 1210 1214 DO i = nxlg, nxrg 1211 1215 DO j = nysg, nyng 1212 u(:,j,i) = u_init(:) 1213 v(:,j,i) = v_init(:) 1214 IF( .NOT. neutral ) pt(:,j,i) = pt_init(:) 1215 IF( humidity ) q(:,j,i) = q_init(:) 1216 IF( init_3d%lod_u == 1 ) u(:,j,i) = u_init(:) 1217 IF( init_3d%lod_v == 1 ) v(:,j,i) = v_init(:) 1218 IF( .NOT. neutral .AND. init_3d%lod_pt == 1 ) & 1219 pt(:,j,i) = pt_init(:) 1220 IF( humidity .AND. init_3d%lod_q == 1 ) & 1221 q(:,j,i) = q_init(:) 1216 1222 ENDDO 1217 1223 ENDDO … … 2287 2293 2288 2294 ! 2295 !-- Initialize nudging if required 2296 IF ( nudging ) CALL nudge_init 2297 2298 ! 2299 !-- Initialize 1D/3D offline-nesting with COSMO model and read data from 2300 !-- external file. 2301 IF ( large_scale_forcing .OR. forcing ) CALL lsf_init 2302 2303 ! 2289 2304 !-- Initialize surface forcing corresponding to large-scale forcing. Therein, 2290 2305 !-- initialize heat-fluxes, etc. via datatype. Revise it later! - Property svn:mergeinfo changed
-
palm/trunk/SOURCE/init_grid.f90
r3049 r3051 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Minor bugfix concerning mapping 3D buildings on top of terrain 28 ! 29 ! 3045 2018-05-28 07:55:41Z Giersch 27 30 ! Error messages revised 28 31 ! … … 926 929 topo_3d(nzb,:,:) = IBCLR( topo_3d(nzb,:,:), 0 ) 927 930 ! 931 !-- In order to map topography on PALM grid also in case of ocean simulations, 932 !-- pre-calculate an offset value. 933 ocean_offset = MERGE( zw(0), 0.0_wp, ocean ) 934 ! 928 935 !-- Reference buildings on top of orography. This is not necessary 929 936 !-- if topography is read from ASCII file as no distinction between buildings … … 1038 1045 1039 1046 ! 1040 !-- Finally, determine maximumum terrain height occupied by the1041 !-- respective building.1047 !-- Determine maximumum terrain height occupied by the respective 1048 !-- building and temporalily store on oro_max 1042 1049 ALLOCATE( oro_max_l(1:SIZE(build_ids_final)) ) 1043 1050 ALLOCATE( oro_max(1:SIZE(build_ids_final)) ) … … 1059 1066 oro_max = oro_max_l 1060 1067 #endif 1068 ! 1069 !-- Finally, determine discrete grid height of maximum orography occupied 1070 !-- by a building. Use all-or-nothing approach, i.e. a grid box is either 1071 oro_max_l = 0.0 1072 DO nr = 1, SIZE(build_ids_final) 1073 DO k = nzb, nzt 1074 IF ( zu(k) - ocean_offset <= oro_max(nr) ) & 1075 oro_max_l = zw(k) - ocean_offset 1076 ENDDO 1077 oro_max = oro_max_l 1078 ENDDO 1061 1079 ENDIF 1062 1080 ! 1063 1081 !-- Map orography as well as buildings onto grid. 1064 !-- In case of ocean simulations, add an offset.1065 ocean_offset = MERGE( zw(0), 0.0_wp, ocean )1066 1082 DO i = nxl, nxr 1067 1083 DO j = nys, nyn … … 1080 1096 topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 ) 1081 1097 topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 1 ) 1082 topo_top_index = topo_top_index + 11098 topo_top_index = k ! topo_top_index + 1 1083 1099 ENDIF 1084 1100 ! … … 1116 1132 building_id_f%var(j,i) ), DIM = 1 ) 1117 1133 ! 1118 !-- Extend building down to the terrain surface. 1119 k2 = topo_top_index 1134 !-- Extend building down to the terrain surface, i.e. fill-up 1135 !-- surface irregularities below a building. Note, oro_max 1136 !-- is already a discrete height according to the all-or-nothing 1137 !-- approach, i.e. grid box is either topography or atmosphere, 1138 !-- terrain top is defined at upper bound of the grid box. 1139 !-- Hence, check for zw in this case. 1120 1140 DO k = topo_top_index + 1, nzt + 1 1121 IF ( z u(k) - ocean_offset <= oro_max(nr) ) THEN1141 IF ( zw(k) - ocean_offset <= oro_max(nr) ) THEN 1122 1142 topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 ) 1123 1143 topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 2 ) 1124 k2 = k2 + 11125 1144 ENDIF 1126 ENDDO 1127 topo_top_index = k2 1128 ! 1129 !-- Now, map building on top. 1145 ENDDO 1146 ! 1147 !-- After surface irregularities are smoothen, determine lower 1148 !-- start index where building starts. 1149 DO k = nzb, nzt 1150 IF ( zw(k) - ocean_offset <= oro_max(nr) ) & 1151 topo_top_index = k 1152 ENDDO 1153 ! 1154 !-- Finally, map building on top. 1130 1155 k2 = 0 1131 1156 DO k = topo_top_index, nzt + 1 -
palm/trunk/SOURCE/land_surface_model_mod.f90
r3049 r3051 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Bugfix in surface-element loops for pavement surfaces 28 ! 29 ! 3045 2018-05-28 07:55:41Z Giersch 27 30 ! Error messages revised 28 31 ! … … 3788 3791 surf_lsm_v(l)%emissivity(ind_pav_green,m) = & 3789 3792 pavement_pars(ind_p_emis,st) 3790 3791 DO k = nzb_soil, surf_lsm_ h%nzt_pavement(m)3793 3794 DO k = nzb_soil, surf_lsm_v(l)%nzt_pavement(m) 3792 3795 surf_lsm_v(l)%lambda_h_def(k,m) = & 3793 3796 pavement_subsurface_pars_1(k,pavement_type) … … 4410 4413 DO k = nzb_soil, nzt_soil 4411 4414 IF ( surf_lsm_v(l)%pavement_surface(m) .AND. & 4412 k <= surf_lsm_ h%nzt_pavement(m) ) THEN4415 k <= surf_lsm_v(l)%nzt_pavement(m) ) THEN 4413 4416 surf_lsm_v(l)%root_fr(k,m) = 0.0_wp 4414 4417 ELSE … … 4692 4695 ALLOCATE ( surf_lsm_v(l)%water_surface(1:surf_lsm_v(l)%ns) ) 4693 4696 4694 surf_lsm_v(l)%water_surface = .FALSE.4695 surf_lsm_v(l)%pavement_surface = .FALSE.4696 surf_lsm_v(l)%vegetation_surface 4697 surf_lsm_v(l)%water_surface = .FALSE. 4698 surf_lsm_v(l)%pavement_surface = .FALSE. 4699 surf_lsm_v(l)%vegetation_surface = .FALSE. 4697 4700 4698 4701 -
palm/trunk/SOURCE/netcdf_data_input_mod.f90
r3049 r3051 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Error messages revised 27 ! - Speed-up NetCDF input 28 ! - Revise input routines and remove NetCDF input via IO-blocks since this is 29 ! not working in parallel mode in case blocking collective read operations 30 ! are done 31 ! - Temporarily revoke renaming of input variables in dynamic driver (tend_ug, 32 ! tend_vg, zsoil) in order to keep dynamic input file working with current 33 ! model version 34 ! - More detailed error messages created 28 35 ! 29 36 ! 3045 2018-05-28 07:55:41Z Giersch 30 ! Error message revised37 ! Error messages revised 31 38 ! 32 39 ! 3041 2018-05-25 10:39:54Z gronemeier … … 563 570 MODULE PROCEDURE get_variable_3d_int8 564 571 MODULE PROCEDURE get_variable_3d_real 565 MODULE PROCEDURE get_variable_3d_real_v 572 MODULE PROCEDURE get_variable_3d_real_dynamic 573 ! MODULE PROCEDURE get_variable_3d_real_v 566 574 MODULE PROCEDURE get_variable_4d_real 567 575 END INTERFACE get_variable … … 647 655 IF ( .NOT. input_pids_static ) RETURN 648 656 649 DO ii = 0, io_blocks-1650 IF ( ii == io_group ) THEN651 657 #if defined ( __netcdf ) 652 658 ! 653 !-- Open file in read-only mode 654 CALL open_read_file( TRIM( input_file_static ) // & 655 TRIM( coupling_char ), id_mod ) 656 ! 657 !-- Read global attributes 658 CALL get_attribute( id_mod, input_file_atts%origin_lat_char, & 659 input_file_atts%origin_lat, .TRUE. ) 660 661 CALL get_attribute( id_mod, input_file_atts%origin_lon_char, & 662 input_file_atts%origin_lon, .TRUE. ) 663 664 CALL get_attribute( id_mod, input_file_atts%origin_time_char, & 665 input_file_atts%origin_time, .TRUE. ) 666 667 CALL get_attribute( id_mod, input_file_atts%origin_x_char, & 668 input_file_atts%origin_x, .TRUE. ) 669 670 CALL get_attribute( id_mod, input_file_atts%origin_y_char, & 671 input_file_atts%origin_y, .TRUE. ) 672 673 CALL get_attribute( id_mod, input_file_atts%origin_z_char, & 674 input_file_atts%origin_z, .TRUE. ) 675 676 CALL get_attribute( id_mod, input_file_atts%rotation_angle_char, & 677 input_file_atts%rotation_angle, .TRUE. ) 678 679 ! 680 !-- Finally, close input file 681 CALL close_input_file( id_mod ) 682 ! 683 !-- Copy lon/lat values 684 init_model%latitude = input_file_atts%origin_lat 685 init_model%longitude = input_file_atts%origin_lon 659 !-- Open file in read-only mode 660 CALL open_read_file( TRIM( input_file_static ) // & 661 TRIM( coupling_char ), id_mod ) 662 ! 663 !-- Read global attributes 664 CALL get_attribute( id_mod, input_file_atts%origin_lat_char, & 665 input_file_atts%origin_lat, .TRUE. ) 666 667 CALL get_attribute( id_mod, input_file_atts%origin_lon_char, & 668 input_file_atts%origin_lon, .TRUE. ) 669 670 CALL get_attribute( id_mod, input_file_atts%origin_time_char, & 671 input_file_atts%origin_time, .TRUE. ) 672 673 CALL get_attribute( id_mod, input_file_atts%origin_x_char, & 674 input_file_atts%origin_x, .TRUE. ) 675 676 CALL get_attribute( id_mod, input_file_atts%origin_y_char, & 677 input_file_atts%origin_y, .TRUE. ) 678 679 CALL get_attribute( id_mod, input_file_atts%origin_z_char, & 680 input_file_atts%origin_z, .TRUE. ) 681 682 CALL get_attribute( id_mod, input_file_atts%rotation_angle_char, & 683 input_file_atts%rotation_angle, .TRUE. ) 684 685 ! 686 !-- Finally, close input file 687 CALL close_input_file( id_mod ) 686 688 #endif 687 ENDIF 688 #if defined( __parallel ) 689 CALL MPI_BARRIER( comm2d, ierr ) 690 #endif 691 ENDDO 689 ! 690 !-- Copy latitude, longitude, origin_z, rotation angle on init type 691 init_model%latitude = input_file_atts%origin_lat 692 init_model%longitude = input_file_atts%origin_lon 693 init_model%origin_time = input_file_atts%origin_time 694 init_model%origin_x = input_file_atts%origin_x 695 init_model%origin_y = input_file_atts%origin_y 696 init_model%origin_z = input_file_atts%origin_z 697 init_model%rotation_angle = input_file_atts%rotation_angle 698 692 699 ! 693 700 !-- In case of nested runs, each model domain might have different longitude … … 697 704 !-- synchronization is required already here. 698 705 #if defined( __parallel ) 699 CALL MPI_BCAST( init_model%latitude, 1, MPI_REAL, 0,&706 CALL MPI_BCAST( init_model%latitude, 1, MPI_REAL, 0, & 700 707 MPI_COMM_WORLD, ierr ) 701 708 CALL MPI_BCAST( init_model%longitude, 1, MPI_REAL, 0, & … … 725 732 CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in static input file 726 733 727 INTEGER(iwp) :: i !< running index along x-direction728 INTEGER(iwp) :: ii !< running index for IO blocks729 734 INTEGER(iwp) :: id_surf !< NetCDF id of input file 730 INTEGER(iwp) :: j !< running index along y-direction731 735 INTEGER(iwp) :: k !< running index along z-direction 732 736 INTEGER(iwp) :: k2 !< running index … … 751 755 !-- Read plant canopy variables. 752 756 IF ( plant_canopy ) THEN 753 DO ii = 0, io_blocks-1754 IF ( ii == io_group ) THEN755 757 #if defined ( __netcdf ) 756 758 ! 757 !-- Open file in read-only mode 758 CALL open_read_file( TRIM( input_file_static ) // & 759 TRIM( coupling_char ) , id_surf ) 760 ! 761 !-- At first, inquire all variable names. 762 !-- This will be used to check whether an optional input variable 763 !-- exist or not. 764 CALL inquire_num_variables( id_surf, num_vars ) 765 766 ALLOCATE( var_names(1:num_vars) ) 767 CALL inquire_variable_names( id_surf, var_names ) 768 769 ! 770 !-- Read leaf area density - resolved vegetation 771 IF ( check_existence( var_names, 'lad' ) ) THEN 772 leaf_area_density_f%from_file = .TRUE. 773 CALL get_attribute( id_surf, char_fill, & 774 leaf_area_density_f%fill, & 775 .FALSE., 'lad' ) 776 ! 777 !-- Inquire number of vertical vegetation layer 778 CALL get_dimension_length( id_surf, leaf_area_density_f%nz, & 779 'zlad' ) 780 ! 781 !-- Allocate variable for leaf-area density 782 ALLOCATE( leaf_area_density_f%var( & 783 0:leaf_area_density_f%nz-1, & 784 nys:nyn,nxl:nxr) ) 785 786 CALL get_variable( id_surf, 'lad', & 787 nxl, nxr, nys, nyn, & 788 leaf_area_density_f%var(:,nys:nyn, nxl:nxr) ) 789 790 ELSE 791 leaf_area_density_f%from_file = .FALSE. 792 ENDIF 793 794 ! 795 !-- Read basal area density - resolved vegetation 796 IF ( check_existence( var_names, 'bad' ) ) THEN 797 basal_area_density_f%from_file = .TRUE. 798 CALL get_attribute( id_surf, char_fill, & 799 basal_area_density_f%fill, & 800 .FALSE., 'bad' ) 801 ! 802 !-- Inquire number of vertical vegetation layer 803 CALL get_dimension_length( id_surf, & 804 basal_area_density_f%nz, & 805 'zlad' ) 806 ! 807 !-- Allocate variable 808 ALLOCATE( basal_area_density_f%var( & 809 0:basal_area_density_f%nz-1, & 810 nys:nyn,nxl:nxr) ) 811 812 CALL get_variable( id_surf, 'bad', & 813 nxl, nxr, nys, nyn, & 814 basal_area_density_f%var(:,nys:nyn, nxl:nxr) ) 815 ELSE 816 basal_area_density_f%from_file = .FALSE. 817 ENDIF 818 819 ! 820 !-- Read root area density - resolved vegetation 821 IF ( check_existence( var_names, 'root_area_dens_r' ) ) THEN 822 root_area_density_lad_f%from_file = .TRUE. 823 CALL get_attribute( id_surf, char_fill, & 824 root_area_density_lad_f%fill, & 825 .FALSE., 'root_area_dens_r' ) 826 ! 827 !-- Inquire number of vertical soil layers 828 CALL get_dimension_length( id_surf, & 829 root_area_density_lad_f%nz, & 830 'zsoil' ) 831 ! 832 !-- Allocate variable 833 ALLOCATE( root_area_density_lad_f%var & 834 (0:root_area_density_lad_f%nz-1,& 759 !-- Open file in read-only mode 760 CALL open_read_file( TRIM( input_file_static ) // & 761 TRIM( coupling_char ) , id_surf ) 762 ! 763 !-- At first, inquire all variable names. 764 !-- This will be used to check whether an optional input variable 765 !-- exist or not. 766 CALL inquire_num_variables( id_surf, num_vars ) 767 768 ALLOCATE( var_names(1:num_vars) ) 769 CALL inquire_variable_names( id_surf, var_names ) 770 771 ! 772 !-- Read leaf area density - resolved vegetation 773 IF ( check_existence( var_names, 'lad' ) ) THEN 774 leaf_area_density_f%from_file = .TRUE. 775 CALL get_attribute( id_surf, char_fill, & 776 leaf_area_density_f%fill, & 777 .FALSE., 'lad' ) 778 ! 779 !-- Inquire number of vertical vegetation layer 780 CALL get_dimension_length( id_surf, leaf_area_density_f%nz, & 781 'zlad' ) 782 ! 783 !-- Allocate variable for leaf-area density 784 ALLOCATE( leaf_area_density_f%var( 0:leaf_area_density_f%nz-1, & 835 785 nys:nyn,nxl:nxr) ) 836 786 837 CALL get_variable( id_surf, 'root_area_dens_r', & 838 nxl, nxr, nys, nyn, & 839 root_area_density_lad_f%var(:,nys:nyn, nxl:nxr) ) 840 ELSE 841 root_area_density_lad_f%from_file = .FALSE. 842 ENDIF 843 ! 844 !-- Finally, close input file 845 CALL close_input_file( id_surf ) 787 CALL get_variable( id_surf, 'lad', leaf_area_density_f%var, & 788 nxl, nxr, nys, nyn, & 789 0, leaf_area_density_f%nz-1 ) 790 791 ELSE 792 leaf_area_density_f%from_file = .FALSE. 793 ENDIF 794 795 ! 796 !-- Read basal area density - resolved vegetation 797 IF ( check_existence( var_names, 'bad' ) ) THEN 798 basal_area_density_f%from_file = .TRUE. 799 CALL get_attribute( id_surf, char_fill, & 800 basal_area_density_f%fill, & 801 .FALSE., 'bad' ) 802 ! 803 !-- Inquire number of vertical vegetation layer 804 CALL get_dimension_length( id_surf, basal_area_density_f%nz, & 805 'zlad' ) 806 ! 807 !-- Allocate variable 808 ALLOCATE( basal_area_density_f%var(0:basal_area_density_f%nz-1, & 809 nys:nyn,nxl:nxr) ) 810 811 CALL get_variable( id_surf, 'bad', basal_area_density_f%var, & 812 nxl, nxr, nys, nyn, & 813 0, basal_area_density_f%nz-1 ) 814 ELSE 815 basal_area_density_f%from_file = .FALSE. 816 ENDIF 817 818 ! 819 !-- Read root area density - resolved vegetation 820 IF ( check_existence( var_names, 'root_area_dens_r' ) ) THEN 821 root_area_density_lad_f%from_file = .TRUE. 822 CALL get_attribute( id_surf, char_fill, & 823 root_area_density_lad_f%fill, & 824 .FALSE., 'root_area_dens_r' ) 825 ! 826 !-- Inquire number of vertical soil layers 827 CALL get_dimension_length( id_surf, & 828 root_area_density_lad_f%nz, & 829 'zsoil' ) 830 ! 831 !-- Allocate variable 832 ALLOCATE( root_area_density_lad_f%var & 833 (0:root_area_density_lad_f%nz-1, & 834 nys:nyn,nxl:nxr) ) 835 836 CALL get_variable( id_surf, 'root_area_dens_r', & 837 root_area_density_lad_f%var, & 838 nxl, nxr, nys, nyn, & 839 0, root_area_density_lad_f%nz-1 ) 840 ELSE 841 root_area_density_lad_f%from_file = .FALSE. 842 ENDIF 843 ! 844 !-- Finally, close input file 845 CALL close_input_file( id_surf ) 846 846 #endif 847 ENDIF 848 #if defined( __parallel ) 849 CALL MPI_BARRIER( comm2d, ierr ) 850 #endif 851 ENDDO 852 ! 853 !-- Deallocate variable list. Will be re-allocated in case further 854 !-- variables are read from file. 855 IF ( ALLOCATED( var_names ) ) DEALLOCATE( var_names ) 856 857 ENDIF 847 ENDIF 848 ! 849 !-- Deallocate variable list. Will be re-allocated in case further 850 !-- variables are read from file. 851 IF ( ALLOCATED( var_names ) ) DEALLOCATE( var_names ) 858 852 ! 859 853 !-- Skip the following if no land-surface or urban-surface module are … … 865 859 var_exchange_real = 0.0_wp 866 860 867 DO ii = 0, io_blocks-1868 IF ( ii == io_group ) THEN869 861 #if defined ( __netcdf ) 870 862 ! 871 !-- Open file in read-only mode 872 CALL open_read_file( TRIM( input_file_static ) // & 873 TRIM( coupling_char ) , id_surf ) 874 875 ! 876 !-- Inquire all variable names. 877 !-- This will be used to check whether an optional input variable exist 878 !-- or not. 879 CALL inquire_num_variables( id_surf, num_vars ) 880 881 ALLOCATE( var_names(1:num_vars) ) 882 CALL inquire_variable_names( id_surf, var_names ) 883 884 ! 885 !-- Read vegetation type and required attributes 886 IF ( check_existence( var_names, 'vegetation_type' ) ) THEN 887 vegetation_type_f%from_file = .TRUE. 888 CALL get_attribute( id_surf, char_fill, & 889 vegetation_type_f%fill, & 890 .FALSE., 'vegetation_type' ) 891 ! 892 !-- PE-wise reading of 2D vegetation type. 893 ALLOCATE ( vegetation_type_f%var(nys:nyn,nxl:nxr) ) 894 895 DO i = nxl, nxr 896 CALL get_variable( id_surf, 'vegetation_type', & 897 i, vegetation_type_f%var(:,i) ) 898 ENDDO 899 ELSE 900 vegetation_type_f%from_file = .FALSE. 901 ENDIF 902 903 ! 904 !-- Read soil type and required attributes 905 IF ( check_existence( var_names, 'soil_type' ) ) THEN 906 soil_type_f%from_file = .TRUE. 907 ! 908 !-- Note, lod is currently not on file; skip for the moment 909 ! CALL get_attribute( id_surf, char_lod, & 910 ! soil_type_f%lod, & 911 ! .FALSE., 'soil_type' ) 912 CALL get_attribute( id_surf, char_fill, & 913 soil_type_f%fill, & 914 .FALSE., 'soil_type' ) 915 916 IF ( soil_type_f%lod == 1 ) THEN 917 ! 918 !-- PE-wise reading of 2D soil type. 919 ALLOCATE ( soil_type_f%var_2d(nys:nyn,nxl:nxr) ) 920 DO i = nxl, nxr 921 CALL get_variable( id_surf, 'soil_type', & 922 i, soil_type_f%var_2d(:,i) ) 923 ENDDO 924 ELSEIF ( soil_type_f%lod == 2 ) THEN 925 ! 926 !-- Obtain number of soil layers from file. 927 CALL get_dimension_length( id_surf, nz_soil, 'zsoil' ) 928 ! 929 !-- PE-wise reading of 3D soil type. 930 ALLOCATE ( soil_type_f%var_3d(0:nz_soil,nys:nyn,nxl:nxr) ) 931 DO i = nxl, nxr 932 DO j = nys, nyn 933 CALL get_variable( id_surf, 'soil_type', i, j, & 934 soil_type_f%var_3d(:,j,i) ) 935 ENDDO 936 ENDDO 937 ENDIF 938 ELSE 939 soil_type_f%from_file = .FALSE. 940 ENDIF 941 942 ! 943 !-- Read pavement type and required attributes 944 IF ( check_existence( var_names, 'pavement_type' ) ) THEN 945 pavement_type_f%from_file = .TRUE. 946 CALL get_attribute( id_surf, char_fill, & 947 pavement_type_f%fill, .FALSE., & 948 'pavement_type' ) 949 ! 950 !-- PE-wise reading of 2D pavement type. 951 ALLOCATE ( pavement_type_f%var(nys:nyn,nxl:nxr) ) 952 DO i = nxl, nxr 953 CALL get_variable( id_surf, 'pavement_type', & 954 i, pavement_type_f%var(:,i) ) 955 ENDDO 956 ELSE 957 pavement_type_f%from_file = .FALSE. 958 ENDIF 959 960 ! 961 !-- Read water type and required attributes 962 IF ( check_existence( var_names, 'water_type' ) ) THEN 963 water_type_f%from_file = .TRUE. 964 CALL get_attribute( id_surf, char_fill, water_type_f%fill, & 965 .FALSE., 'water_type' ) 966 ! 967 !-- PE-wise reading of 2D water type. 968 ALLOCATE ( water_type_f%var(nys:nyn,nxl:nxr) ) 969 DO i = nxl, nxr 970 CALL get_variable( id_surf, 'water_type', i, & 971 water_type_f%var(:,i) ) 972 ENDDO 973 ELSE 974 water_type_f%from_file = .FALSE. 975 ENDIF 976 ! 977 !-- Read surface fractions and related information 978 IF ( check_existence( var_names, 'surface_fraction' ) ) THEN 979 surface_fraction_f%from_file = .TRUE. 980 CALL get_attribute( id_surf, char_fill, & 981 surface_fraction_f%fill, & 982 .FALSE., 'surface_fraction' ) 983 ! 984 !-- Inquire number of surface fractions 985 CALL get_dimension_length( id_surf, & 986 surface_fraction_f%nf, & 987 'nsurface_fraction' ) 988 ! 989 !-- Allocate dimension array and input array for surface fractions 990 ALLOCATE( surface_fraction_f%nfracs(0:surface_fraction_f%nf-1) ) 991 ALLOCATE( surface_fraction_f%frac(0:surface_fraction_f%nf-1, & 992 nys:nyn,nxl:nxr) ) 993 ! 994 !-- Get dimension of surface fractions 995 CALL get_variable( id_surf, 'nsurface_fraction', & 996 surface_fraction_f%nfracs ) 997 ! 998 !-- Read surface fractions 999 CALL get_variable( id_surf, 'surface_fraction', & 1000 nxl, nxr, nys, nyn, & 1001 surface_fraction_f%frac(:,nys:nyn, nxl:nxr)) 1002 ELSE 1003 surface_fraction_f%from_file = .FALSE. 1004 ENDIF 1005 ! 1006 !-- Read building parameters and related information 1007 IF ( check_existence( var_names, 'building_pars' ) ) THEN 1008 building_pars_f%from_file = .TRUE. 1009 CALL get_attribute( id_surf, char_fill, & 1010 building_pars_f%fill, & 1011 .FALSE., 'building_pars' ) 1012 ! 1013 !-- Inquire number of building parameters 1014 CALL get_dimension_length( id_surf, & 1015 building_pars_f%np, & 1016 'nbuilding_pars' ) 1017 ! 1018 !-- Allocate dimension array and input array for building parameters 1019 ALLOCATE( building_pars_f%pars(0:building_pars_f%np-1) ) 1020 ALLOCATE( building_pars_f%pars_xy(0:building_pars_f%np-1, & 1021 nys:nyn,nxl:nxr) ) 1022 ! 1023 !-- Get dimension of building parameters 1024 CALL get_variable( id_surf, 'nbuilding_pars', & 1025 building_pars_f%pars ) 1026 ! 1027 !-- Read building_pars 1028 CALL get_variable( id_surf, 'building_pars', & 1029 nxl, nxr, nys, nyn, & 1030 building_pars_f%pars_xy(:,nys:nyn, nxl:nxr) ) 1031 ELSE 1032 building_pars_f%from_file = .FALSE. 1033 ENDIF 1034 1035 ! 1036 !-- Read albedo type and required attributes 1037 IF ( check_existence( var_names, 'albedo_type' ) ) THEN 1038 albedo_type_f%from_file = .TRUE. 1039 CALL get_attribute( id_surf, char_fill, albedo_type_f%fill, & 1040 .FALSE., 'albedo_type' ) 1041 ! 1042 !-- PE-wise reading of 2D water type. 1043 ALLOCATE ( albedo_type_f%var(nys:nyn,nxl:nxr) ) 1044 DO i = nxl, nxr 1045 CALL get_variable( id_surf, 'albedo_type', & 1046 i, albedo_type_f%var(:,i) ) 1047 ENDDO 1048 ELSE 1049 albedo_type_f%from_file = .FALSE. 1050 ENDIF 1051 ! 1052 !-- Read albedo parameters and related information 1053 IF ( check_existence( var_names, 'albedo_pars' ) ) THEN 1054 albedo_pars_f%from_file = .TRUE. 1055 CALL get_attribute( id_surf, char_fill, albedo_pars_f%fill, & 1056 .FALSE., 'albedo_pars' ) 1057 ! 1058 !-- Inquire number of albedo parameters 1059 CALL get_dimension_length( id_surf, albedo_pars_f%np, & 1060 'nalbedo_pars' ) 1061 ! 1062 !-- Allocate dimension array and input array for albedo parameters 1063 ALLOCATE( albedo_pars_f%pars(0:albedo_pars_f%np-1) ) 1064 ALLOCATE( albedo_pars_f%pars_xy(0:albedo_pars_f%np-1, & 1065 nys:nyn,nxl:nxr) ) 1066 ! 1067 !-- Get dimension of albedo parameters 1068 CALL get_variable( id_surf, 'nalbedo_pars', albedo_pars_f%pars ) 1069 1070 DO i = nxl, nxr 1071 DO j = nys, nyn 1072 CALL get_variable( id_surf, 'albedo_pars', i, j, & 1073 albedo_pars_f%pars_xy(:,j,i) ) 1074 ENDDO 1075 ENDDO 1076 ELSE 1077 albedo_pars_f%from_file = .FALSE. 1078 ENDIF 1079 1080 ! 1081 !-- Read pavement parameters and related information 1082 IF ( check_existence( var_names, 'pavement_pars' ) ) THEN 1083 pavement_pars_f%from_file = .TRUE. 1084 CALL get_attribute( id_surf, char_fill, & 1085 pavement_pars_f%fill, & 1086 .FALSE., 'pavement_pars' ) 1087 ! 1088 !-- Inquire number of pavement parameters 1089 CALL get_dimension_length( id_surf, pavement_pars_f%np, & 1090 'npavement_pars' ) 1091 ! 1092 !-- Allocate dimension array and input array for pavement parameters 1093 ALLOCATE( pavement_pars_f%pars(0:pavement_pars_f%np-1) ) 1094 ALLOCATE( pavement_pars_f%pars_xy(0:pavement_pars_f%np-1, & 1095 nys:nyn,nxl:nxr) ) 1096 ! 1097 !-- Get dimension of pavement parameters 1098 CALL get_variable( id_surf, 'npavement_pars', & 1099 pavement_pars_f%pars ) 1100 1101 DO i = nxl, nxr 1102 DO j = nys, nyn 1103 CALL get_variable( id_surf, 'pavement_pars', i, j, & 1104 pavement_pars_f%pars_xy(:,j,i) ) 1105 ENDDO 1106 ENDDO 1107 ELSE 1108 pavement_pars_f%from_file = .FALSE. 1109 ENDIF 1110 1111 ! 1112 !-- Read pavement subsurface parameters and related information 1113 IF ( check_existence( var_names, 'pavement_subsurface_pars' ) ) & 1114 THEN 1115 pavement_subsurface_pars_f%from_file = .TRUE. 1116 CALL get_attribute( id_surf, char_fill, & 1117 pavement_subsurface_pars_f%fill, & 1118 .FALSE., 'pavement_subsurface_pars' ) 1119 ! 1120 !-- Inquire number of parameters 1121 CALL get_dimension_length( id_surf, & 1122 pavement_subsurface_pars_f%np, & 1123 'npavement_subsurface_pars' ) 1124 ! 1125 !-- Inquire number of soil layers 1126 CALL get_dimension_length( id_surf, & 1127 pavement_subsurface_pars_f%nz, & 1128 'zsoil' ) 1129 ! 1130 !-- Allocate dimension array and input array for pavement parameters 1131 ALLOCATE( pavement_subsurface_pars_f%pars & 1132 (0:pavement_subsurface_pars_f%np-1) ) 1133 ALLOCATE( pavement_subsurface_pars_f%pars_xyz & 1134 (0:pavement_subsurface_pars_f%np-1, & 1135 0:pavement_subsurface_pars_f%nz-1, & 1136 nys:nyn,nxl:nxr) ) 1137 ! 1138 !-- Get dimension of pavement parameters 1139 CALL get_variable( id_surf, 'npavement_subsurface_pars', & 1140 pavement_subsurface_pars_f%pars ) 1141 1142 DO i = nxl, nxr 1143 DO j = nys, nyn 1144 CALL get_variable( & 1145 id_surf, 'pavement_subsurface_pars', & 1146 i, j, & 1147 pavement_subsurface_pars_f%pars_xyz(:,:,j,i),& 1148 pavement_subsurface_pars_f%nz, & 1149 pavement_subsurface_pars_f%np ) 1150 ENDDO 1151 ENDDO 1152 ELSE 1153 pavement_subsurface_pars_f%from_file = .FALSE. 1154 ENDIF 1155 1156 1157 ! 1158 !-- Read vegetation parameters and related information 1159 IF ( check_existence( var_names, 'vegetation_pars' ) ) THEN 1160 vegetation_pars_f%from_file = .TRUE. 1161 CALL get_attribute( id_surf, char_fill, & 1162 vegetation_pars_f%fill, & 1163 .FALSE., 'vegetation_pars' ) 1164 ! 1165 !-- Inquire number of vegetation parameters 1166 CALL get_dimension_length( id_surf, vegetation_pars_f%np, & 1167 'nvegetation_pars' ) 1168 ! 1169 !-- Allocate dimension array and input array for surface fractions 1170 ALLOCATE( vegetation_pars_f%pars(0:vegetation_pars_f%np-1) ) 1171 ALLOCATE( vegetation_pars_f%pars_xy(0:vegetation_pars_f%np-1, & 1172 nys:nyn,nxl:nxr) ) 1173 ! 1174 !-- Get dimension of the parameters 1175 CALL get_variable( id_surf, 'nvegetation_pars', & 1176 vegetation_pars_f%pars ) 1177 1178 CALL get_variable( id_surf, 'vegetation_pars', & 1179 nxl, nxr, nys, nyn, & 1180 vegetation_pars_f%pars_xy(:,nys:nyn,nxl:nxr ) ) 1181 ELSE 1182 vegetation_pars_f%from_file = .FALSE. 1183 ENDIF 1184 1185 ! 1186 !-- Read root parameters/distribution and related information 1187 IF ( check_existence( var_names, 'soil_pars' ) ) THEN 1188 soil_pars_f%from_file = .TRUE. 1189 CALL get_attribute( id_surf, char_fill, & 1190 soil_pars_f%fill, & 1191 .FALSE., 'soil_pars' ) 1192 1193 CALL get_attribute( id_surf, char_lod, & 1194 soil_pars_f%lod, & 1195 .FALSE., 'soil_pars' ) 1196 1197 ! 1198 !-- Inquire number of soil parameters 1199 CALL get_dimension_length( id_surf, & 1200 soil_pars_f%np, & 1201 'nsoil_pars' ) 1202 ! 1203 !-- Read parameters array 1204 ALLOCATE( soil_pars_f%pars(0:soil_pars_f%np-1) ) 1205 CALL get_variable( id_surf, 'nsoil_pars', soil_pars_f%pars ) 1206 1207 ! 1208 !-- In case of level of detail 2, also inquire number of vertical 1209 !-- soil layers, allocate memory and read the respective dimension 1210 IF ( soil_pars_f%lod == 2 ) THEN 1211 CALL get_dimension_length( id_surf, soil_pars_f%nz, 'zsoil' ) 1212 1213 ALLOCATE( soil_pars_f%layers(0:soil_pars_f%nz-1) ) 1214 CALL get_variable( id_surf, 'zsoil', soil_pars_f%layers ) 1215 1216 ENDIF 1217 1218 ! 1219 !-- Read soil parameters, depending on level of detail 1220 IF ( soil_pars_f%lod == 1 ) THEN 1221 ALLOCATE( soil_pars_f%pars_xy(0:soil_pars_f%np-1, & 1222 nys:nyn,nxl:nxr) ) 1223 DO i = nxl, nxr 1224 DO j = nys, nyn 1225 CALL get_variable( id_surf, 'soil_pars', i, j, & 1226 soil_pars_f%pars_xy(:,j,i) ) 1227 ENDDO 1228 ENDDO 1229 1230 ELSEIF ( soil_pars_f%lod == 2 ) THEN 1231 ALLOCATE( soil_pars_f%pars_xyz(0:soil_pars_f%np-1, & 1232 0:soil_pars_f%nz-1, & 1233 nys:nyn,nxl:nxr) ) 1234 DO i = nxl, nxr 1235 DO j = nys, nyn 1236 CALL get_variable( id_surf, 'soil_pars', i, j, & 1237 soil_pars_f%pars_xyz(:,:,j,i), & 1238 soil_pars_f%nz, soil_pars_f%np ) 1239 ENDDO 1240 ENDDO 1241 ENDIF 1242 ELSE 1243 soil_pars_f%from_file = .FALSE. 1244 ENDIF 1245 1246 ! 1247 !-- Read water parameters and related information 1248 IF ( check_existence( var_names, 'water_pars' ) ) THEN 1249 water_pars_f%from_file = .TRUE. 1250 CALL get_attribute( id_surf, char_fill, & 1251 water_pars_f%fill, & 1252 .FALSE., 'water_pars' ) 1253 ! 1254 !-- Inquire number of water parameters 1255 CALL get_dimension_length( id_surf, & 1256 water_pars_f%np, & 1257 'nwater_pars' ) 1258 ! 1259 !-- Allocate dimension array and input array for water parameters 1260 ALLOCATE( water_pars_f%pars(0:water_pars_f%np-1) ) 1261 ALLOCATE( water_pars_f%pars_xy(0:water_pars_f%np-1, & 1262 nys:nyn,nxl:nxr) ) 1263 ! 1264 !-- Get dimension of water parameters 1265 CALL get_variable( id_surf, 'nwater_pars', water_pars_f%pars ) 1266 1267 DO i = nxl, nxr 1268 DO j = nys, nyn 1269 CALL get_variable( id_surf, 'water_pars', i, j, & 1270 water_pars_f%pars_xy(:,j,i) ) 1271 ENDDO 1272 ENDDO 1273 ELSE 1274 water_pars_f%from_file = .FALSE. 1275 ENDIF 1276 ! 1277 !-- Read root area density - parametrized vegetation 1278 IF ( check_existence( var_names, 'root_area_dens_s' ) ) THEN 1279 root_area_density_lsm_f%from_file = .TRUE. 1280 CALL get_attribute( id_surf, char_fill, & 1281 root_area_density_lsm_f%fill, & 1282 .FALSE., 'root_area_dens_s' ) 1283 ! 1284 !-- Obtain number of soil layers from file and allocate variable 1285 CALL get_dimension_length( id_surf, root_area_density_lsm_f%nz,& 1286 'zsoil' ) 1287 ALLOCATE( root_area_density_lsm_f%var & 1288 (0:root_area_density_lsm_f%nz-1, & 1289 nys:nyn,nxl:nxr) ) 1290 1291 ! 1292 !-- Read root-area density 1293 DO i = nxl, nxr 1294 DO j = nys, nyn 1295 CALL get_variable( id_surf, 'root_area_dens_s', & 1296 i, j, & 1297 root_area_density_lsm_f%var(:,j,i) ) 1298 ENDDO 1299 ENDDO 1300 1301 ELSE 1302 root_area_density_lsm_f%from_file = .FALSE. 1303 ENDIF 1304 ! 1305 !-- Read street type and street crossing 1306 IF ( check_existence( var_names, 'street_type' ) ) THEN 1307 street_type_f%from_file = .TRUE. 1308 CALL get_attribute( id_surf, char_fill, & 1309 street_type_f%fill, .FALSE., & 1310 'street_type' ) 1311 ! 1312 !-- PE-wise reading of 2D pavement type. 1313 ALLOCATE ( street_type_f%var(nys:nyn,nxl:nxr) ) 1314 DO i = nxl, nxr 1315 CALL get_variable( id_surf, 'street_type', & 1316 i, street_type_f%var(:,i) ) 1317 ENDDO 1318 ELSE 1319 street_type_f%from_file = .FALSE. 1320 ENDIF 1321 1322 IF ( check_existence( var_names, 'street_crossing' ) ) THEN 1323 street_crossing_f%from_file = .TRUE. 1324 CALL get_attribute( id_surf, char_fill, & 1325 street_crossing_f%fill, .FALSE., & 1326 'street_crossing' ) 1327 ! 1328 !-- PE-wise reading of 2D pavement type. 1329 ALLOCATE ( street_crossing_f%var(nys:nyn,nxl:nxr) ) 1330 DO i = nxl, nxr 1331 CALL get_variable( id_surf, 'street_crossing', & 1332 i, street_crossing_f%var(:,i) ) 1333 ENDDO 1334 ELSE 1335 street_crossing_f%from_file = .FALSE. 1336 ENDIF 1337 ! 1338 !-- Still missing: root_resolved and building_surface_pars. 1339 !-- Will be implemented as soon as they are available. 1340 1341 ! 1342 !-- Finally, close input file 1343 CALL close_input_file( id_surf ) 863 !-- Open file in read-only mode 864 CALL open_read_file( TRIM( input_file_static ) // & 865 TRIM( coupling_char ) , id_surf ) 866 ! 867 !-- Inquire all variable names. 868 !-- This will be used to check whether an optional input variable exist 869 !-- or not. 870 CALL inquire_num_variables( id_surf, num_vars ) 871 872 ALLOCATE( var_names(1:num_vars) ) 873 CALL inquire_variable_names( id_surf, var_names ) 874 ! 875 !-- Read vegetation type and required attributes 876 IF ( check_existence( var_names, 'vegetation_type' ) ) THEN 877 vegetation_type_f%from_file = .TRUE. 878 CALL get_attribute( id_surf, char_fill, & 879 vegetation_type_f%fill, & 880 .FALSE., 'vegetation_type' ) 881 882 ALLOCATE ( vegetation_type_f%var(nys:nyn,nxl:nxr) ) 883 884 CALL get_variable( id_surf, 'vegetation_type', & 885 vegetation_type_f%var, nxl, nxr, nys, nyn ) 886 ELSE 887 vegetation_type_f%from_file = .FALSE. 888 ENDIF 889 890 ! 891 !-- Read soil type and required attributes 892 IF ( check_existence( var_names, 'soil_type' ) ) THEN 893 soil_type_f%from_file = .TRUE. 894 ! 895 !-- Note, lod is currently not on file; skip for the moment 896 ! CALL get_attribute( id_surf, char_lod, & 897 ! soil_type_f%lod, & 898 ! .FALSE., 'soil_type' ) 899 CALL get_attribute( id_surf, char_fill, & 900 soil_type_f%fill, & 901 .FALSE., 'soil_type' ) 902 903 IF ( soil_type_f%lod == 1 ) THEN 904 905 ALLOCATE ( soil_type_f%var_2d(nys:nyn,nxl:nxr) ) 906 907 CALL get_variable( id_surf, 'soil_type', soil_type_f%var_2d, & 908 nxl, nxr, nys, nyn ) 909 910 ELSEIF ( soil_type_f%lod == 2 ) THEN 911 ! 912 !-- Obtain number of soil layers from file. 913 CALL get_dimension_length( id_surf, nz_soil, 'zsoil' ) 914 915 ALLOCATE ( soil_type_f%var_3d(0:nz_soil,nys:nyn,nxl:nxr) ) 916 917 CALL get_variable( id_surf, 'soil_type', soil_type_f%var_3d, & 918 nxl, nxr, nys, nyn, 0, nz_soil ) 919 920 ENDIF 921 ELSE 922 soil_type_f%from_file = .FALSE. 923 ENDIF 924 925 ! 926 !-- Read pavement type and required attributes 927 IF ( check_existence( var_names, 'pavement_type' ) ) THEN 928 pavement_type_f%from_file = .TRUE. 929 CALL get_attribute( id_surf, char_fill, & 930 pavement_type_f%fill, .FALSE., & 931 'pavement_type' ) 932 933 ALLOCATE ( pavement_type_f%var(nys:nyn,nxl:nxr) ) 934 935 CALL get_variable( id_surf, 'pavement_type', pavement_type_f%var, & 936 nxl, nxr, nys, nyn ) 937 ELSE 938 pavement_type_f%from_file = .FALSE. 939 ENDIF 940 941 ! 942 !-- Read water type and required attributes 943 IF ( check_existence( var_names, 'water_type' ) ) THEN 944 water_type_f%from_file = .TRUE. 945 CALL get_attribute( id_surf, char_fill, water_type_f%fill, & 946 .FALSE., 'water_type' ) 947 948 ALLOCATE ( water_type_f%var(nys:nyn,nxl:nxr) ) 949 950 CALL get_variable( id_surf, 'water_type', water_type_f%var, & 951 nxl, nxr, nys, nyn ) 952 953 ELSE 954 water_type_f%from_file = .FALSE. 955 ENDIF 956 ! 957 !-- Read surface fractions and related information 958 IF ( check_existence( var_names, 'surface_fraction' ) ) THEN 959 surface_fraction_f%from_file = .TRUE. 960 CALL get_attribute( id_surf, char_fill, & 961 surface_fraction_f%fill, & 962 .FALSE., 'surface_fraction' ) 963 ! 964 !-- Inquire number of surface fractions 965 CALL get_dimension_length( id_surf, & 966 surface_fraction_f%nf, & 967 'nsurface_fraction' ) 968 ! 969 !-- Allocate dimension array and input array for surface fractions 970 ALLOCATE( surface_fraction_f%nfracs(0:surface_fraction_f%nf-1) ) 971 ALLOCATE( surface_fraction_f%frac(0:surface_fraction_f%nf-1, & 972 nys:nyn,nxl:nxr) ) 973 ! 974 !-- Get dimension of surface fractions 975 CALL get_variable( id_surf, 'nsurface_fraction', & 976 surface_fraction_f%nfracs ) 977 ! 978 !-- Read surface fractions 979 CALL get_variable( id_surf, 'surface_fraction', & 980 surface_fraction_f%frac, nxl, nxr, nys, nyn, & 981 0, surface_fraction_f%nf-1 ) 982 ELSE 983 surface_fraction_f%from_file = .FALSE. 984 ENDIF 985 ! 986 !-- Read building parameters and related information 987 IF ( check_existence( var_names, 'building_pars' ) ) THEN 988 building_pars_f%from_file = .TRUE. 989 CALL get_attribute( id_surf, char_fill, & 990 building_pars_f%fill, & 991 .FALSE., 'building_pars' ) 992 ! 993 !-- Inquire number of building parameters 994 CALL get_dimension_length( id_surf, & 995 building_pars_f%np, & 996 'nbuilding_pars' ) 997 ! 998 !-- Allocate dimension array and input array for building parameters 999 ALLOCATE( building_pars_f%pars(0:building_pars_f%np-1) ) 1000 ALLOCATE( building_pars_f%pars_xy(0:building_pars_f%np-1, & 1001 nys:nyn,nxl:nxr) ) 1002 ! 1003 !-- Get dimension of building parameters 1004 CALL get_variable( id_surf, 'nbuilding_pars', & 1005 building_pars_f%pars ) 1006 ! 1007 !-- Read building_pars 1008 CALL get_variable( id_surf, 'building_pars', & 1009 building_pars_f%pars_xy, nxl, nxr, nys, nyn, & 1010 0, building_pars_f%np-1 ) 1011 ELSE 1012 building_pars_f%from_file = .FALSE. 1013 ENDIF 1014 1015 ! 1016 !-- Read albedo type and required attributes 1017 IF ( check_existence( var_names, 'albedo_type' ) ) THEN 1018 albedo_type_f%from_file = .TRUE. 1019 CALL get_attribute( id_surf, char_fill, albedo_type_f%fill, & 1020 .FALSE., 'albedo_type' ) 1021 1022 ALLOCATE ( albedo_type_f%var(nys:nyn,nxl:nxr) ) 1023 1024 CALL get_variable( id_surf, 'albedo_type', albedo_type_f%var, & 1025 nxl, nxr, nys, nyn ) 1026 ELSE 1027 albedo_type_f%from_file = .FALSE. 1028 ENDIF 1029 ! 1030 !-- Read albedo parameters and related information 1031 IF ( check_existence( var_names, 'albedo_pars' ) ) THEN 1032 albedo_pars_f%from_file = .TRUE. 1033 CALL get_attribute( id_surf, char_fill, albedo_pars_f%fill, & 1034 .FALSE., 'albedo_pars' ) 1035 ! 1036 !-- Inquire number of albedo parameters 1037 CALL get_dimension_length( id_surf, albedo_pars_f%np, & 1038 'nalbedo_pars' ) 1039 ! 1040 !-- Allocate dimension array and input array for albedo parameters 1041 ALLOCATE( albedo_pars_f%pars(0:albedo_pars_f%np-1) ) 1042 ALLOCATE( albedo_pars_f%pars_xy(0:albedo_pars_f%np-1, & 1043 nys:nyn,nxl:nxr) ) 1044 ! 1045 !-- Get dimension of albedo parameters 1046 CALL get_variable( id_surf, 'nalbedo_pars', albedo_pars_f%pars ) 1047 1048 CALL get_variable( id_surf, 'albedo_pars', albedo_pars_f%pars_xy, & 1049 nxl, nxr, nys, nyn, & 1050 0, albedo_pars_f%np-1 ) 1051 ELSE 1052 albedo_pars_f%from_file = .FALSE. 1053 ENDIF 1054 1055 ! 1056 !-- Read pavement parameters and related information 1057 IF ( check_existence( var_names, 'pavement_pars' ) ) THEN 1058 pavement_pars_f%from_file = .TRUE. 1059 CALL get_attribute( id_surf, char_fill, & 1060 pavement_pars_f%fill, & 1061 .FALSE., 'pavement_pars' ) 1062 ! 1063 !-- Inquire number of pavement parameters 1064 CALL get_dimension_length( id_surf, pavement_pars_f%np, & 1065 'npavement_pars' ) 1066 ! 1067 !-- Allocate dimension array and input array for pavement parameters 1068 ALLOCATE( pavement_pars_f%pars(0:pavement_pars_f%np-1) ) 1069 ALLOCATE( pavement_pars_f%pars_xy(0:pavement_pars_f%np-1, & 1070 nys:nyn,nxl:nxr) ) 1071 ! 1072 !-- Get dimension of pavement parameters 1073 CALL get_variable( id_surf, 'npavement_pars', pavement_pars_f%pars ) 1074 1075 CALL get_variable( id_surf, 'pavement_pars', pavement_pars_f%pars_xy,& 1076 nxl, nxr, nys, nyn, & 1077 0, pavement_pars_f%np-1 ) 1078 ELSE 1079 pavement_pars_f%from_file = .FALSE. 1080 ENDIF 1081 1082 ! 1083 !-- Read pavement subsurface parameters and related information 1084 IF ( check_existence( var_names, 'pavement_subsurface_pars' ) ) & 1085 THEN 1086 pavement_subsurface_pars_f%from_file = .TRUE. 1087 CALL get_attribute( id_surf, char_fill, & 1088 pavement_subsurface_pars_f%fill, & 1089 .FALSE., 'pavement_subsurface_pars' ) 1090 ! 1091 !-- Inquire number of parameters 1092 CALL get_dimension_length( id_surf, & 1093 pavement_subsurface_pars_f%np, & 1094 'npavement_subsurface_pars' ) 1095 ! 1096 !-- Inquire number of soil layers 1097 CALL get_dimension_length( id_surf, & 1098 pavement_subsurface_pars_f%nz, & 1099 'zsoil' ) 1100 ! 1101 !-- Allocate dimension array and input array for pavement parameters 1102 ALLOCATE( pavement_subsurface_pars_f%pars & 1103 (0:pavement_subsurface_pars_f%np-1) ) 1104 ALLOCATE( pavement_subsurface_pars_f%pars_xyz & 1105 (0:pavement_subsurface_pars_f%np-1, & 1106 0:pavement_subsurface_pars_f%nz-1, & 1107 nys:nyn,nxl:nxr) ) 1108 ! 1109 !-- Get dimension of pavement parameters 1110 CALL get_variable( id_surf, 'npavement_subsurface_pars', & 1111 pavement_subsurface_pars_f%pars ) 1112 1113 CALL get_variable( id_surf, 'pavement_subsurface_pars', & 1114 pavement_subsurface_pars_f%pars_xyz, & 1115 nxl, nxr, nys, nyn, & 1116 0, pavement_subsurface_pars_f%nz-1, & 1117 0, pavement_subsurface_pars_f%np-1 ) 1118 ELSE 1119 pavement_subsurface_pars_f%from_file = .FALSE. 1120 ENDIF 1121 1122 1123 ! 1124 !-- Read vegetation parameters and related information 1125 IF ( check_existence( var_names, 'vegetation_pars' ) ) THEN 1126 vegetation_pars_f%from_file = .TRUE. 1127 CALL get_attribute( id_surf, char_fill, & 1128 vegetation_pars_f%fill, & 1129 .FALSE., 'vegetation_pars' ) 1130 ! 1131 !-- Inquire number of vegetation parameters 1132 CALL get_dimension_length( id_surf, vegetation_pars_f%np, & 1133 'nvegetation_pars' ) 1134 ! 1135 !-- Allocate dimension array and input array for surface fractions 1136 ALLOCATE( vegetation_pars_f%pars(0:vegetation_pars_f%np-1) ) 1137 ALLOCATE( vegetation_pars_f%pars_xy(0:vegetation_pars_f%np-1, & 1138 nys:nyn,nxl:nxr) ) 1139 ! 1140 !-- Get dimension of the parameters 1141 CALL get_variable( id_surf, 'nvegetation_pars', & 1142 vegetation_pars_f%pars ) 1143 1144 CALL get_variable( id_surf, 'vegetation_pars', & 1145 vegetation_pars_f%pars_xy, nxl, nxr, nys, nyn, & 1146 0, vegetation_pars_f%np-1 ) 1147 ELSE 1148 vegetation_pars_f%from_file = .FALSE. 1149 ENDIF 1150 1151 ! 1152 !-- Read root parameters/distribution and related information 1153 IF ( check_existence( var_names, 'soil_pars' ) ) THEN 1154 soil_pars_f%from_file = .TRUE. 1155 CALL get_attribute( id_surf, char_fill, & 1156 soil_pars_f%fill, & 1157 .FALSE., 'soil_pars' ) 1158 1159 CALL get_attribute( id_surf, char_lod, & 1160 soil_pars_f%lod, & 1161 .FALSE., 'soil_pars' ) 1162 1163 ! 1164 !-- Inquire number of soil parameters 1165 CALL get_dimension_length( id_surf, & 1166 soil_pars_f%np, & 1167 'nsoil_pars' ) 1168 ! 1169 !-- Read parameters array 1170 ALLOCATE( soil_pars_f%pars(0:soil_pars_f%np-1) ) 1171 CALL get_variable( id_surf, 'nsoil_pars', soil_pars_f%pars ) 1172 1173 ! 1174 !-- In case of level of detail 2, also inquire number of vertical 1175 !-- soil layers, allocate memory and read the respective dimension 1176 IF ( soil_pars_f%lod == 2 ) THEN 1177 CALL get_dimension_length( id_surf, soil_pars_f%nz, 'zsoil' ) 1178 1179 ALLOCATE( soil_pars_f%layers(0:soil_pars_f%nz-1) ) 1180 CALL get_variable( id_surf, 'zsoil', soil_pars_f%layers ) 1181 1182 ENDIF 1183 1184 ! 1185 !-- Read soil parameters, depending on level of detail 1186 IF ( soil_pars_f%lod == 1 ) THEN 1187 ALLOCATE( soil_pars_f%pars_xy(0:soil_pars_f%np-1, & 1188 nys:nyn,nxl:nxr) ) 1189 1190 CALL get_variable( id_surf, 'soil_pars', soil_pars_f%pars_xy, & 1191 nxl, nxr, nys, nyn, 0, soil_pars_f%np-1 ) 1192 1193 ELSEIF ( soil_pars_f%lod == 2 ) THEN 1194 ALLOCATE( soil_pars_f%pars_xyz(0:soil_pars_f%np-1, & 1195 0:soil_pars_f%nz-1, & 1196 nys:nyn,nxl:nxr) ) 1197 CALL get_variable( id_surf, 'soil_pars', & 1198 soil_pars_f%pars_xyz, & 1199 nxl, nxr, nys, nyn, 0, soil_pars_f%nz-1, & 1200 0, soil_pars_f%np-1 ) 1201 1202 ENDIF 1203 ELSE 1204 soil_pars_f%from_file = .FALSE. 1205 ENDIF 1206 1207 ! 1208 !-- Read water parameters and related information 1209 IF ( check_existence( var_names, 'water_pars' ) ) THEN 1210 water_pars_f%from_file = .TRUE. 1211 CALL get_attribute( id_surf, char_fill, & 1212 water_pars_f%fill, & 1213 .FALSE., 'water_pars' ) 1214 ! 1215 !-- Inquire number of water parameters 1216 CALL get_dimension_length( id_surf, & 1217 water_pars_f%np, & 1218 'nwater_pars' ) 1219 ! 1220 !-- Allocate dimension array and input array for water parameters 1221 ALLOCATE( water_pars_f%pars(0:water_pars_f%np-1) ) 1222 ALLOCATE( water_pars_f%pars_xy(0:water_pars_f%np-1, & 1223 nys:nyn,nxl:nxr) ) 1224 ! 1225 !-- Get dimension of water parameters 1226 CALL get_variable( id_surf, 'nwater_pars', water_pars_f%pars ) 1227 1228 CALL get_variable( id_surf, 'water_pars', water_pars_f%pars_xy, & 1229 nxl, nxr, nys, nyn, 0, water_pars_f%np-1 ) 1230 ELSE 1231 water_pars_f%from_file = .FALSE. 1232 ENDIF 1233 ! 1234 !-- Read root area density - parametrized vegetation 1235 IF ( check_existence( var_names, 'root_area_dens_s' ) ) THEN 1236 root_area_density_lsm_f%from_file = .TRUE. 1237 CALL get_attribute( id_surf, char_fill, & 1238 root_area_density_lsm_f%fill, & 1239 .FALSE., 'root_area_dens_s' ) 1240 ! 1241 !-- Obtain number of soil layers from file and allocate variable 1242 CALL get_dimension_length( id_surf, root_area_density_lsm_f%nz, & 1243 'zsoil' ) 1244 ALLOCATE( root_area_density_lsm_f%var & 1245 (0:root_area_density_lsm_f%nz-1, & 1246 nys:nyn,nxl:nxr) ) 1247 1248 ! 1249 !-- Read root-area density 1250 CALL get_variable( id_surf, 'root_area_dens_s', & 1251 root_area_density_lsm_f%var, & 1252 nxl, nxr, nys, nyn, & 1253 0, root_area_density_lsm_f%nz-1 ) 1254 1255 ELSE 1256 root_area_density_lsm_f%from_file = .FALSE. 1257 ENDIF 1258 ! 1259 !-- Read street type and street crossing 1260 IF ( check_existence( var_names, 'street_type' ) ) THEN 1261 street_type_f%from_file = .TRUE. 1262 CALL get_attribute( id_surf, char_fill, & 1263 street_type_f%fill, .FALSE., & 1264 'street_type' ) 1265 1266 ALLOCATE ( street_type_f%var(nys:nyn,nxl:nxr) ) 1267 1268 CALL get_variable( id_surf, 'street_type', street_type_f%var, & 1269 nxl, nxr, nys, nyn ) 1270 ELSE 1271 street_type_f%from_file = .FALSE. 1272 ENDIF 1273 1274 IF ( check_existence( var_names, 'street_crossing' ) ) THEN 1275 street_crossing_f%from_file = .TRUE. 1276 CALL get_attribute( id_surf, char_fill, & 1277 street_crossing_f%fill, .FALSE., & 1278 'street_crossing' ) 1279 1280 ALLOCATE ( street_crossing_f%var(nys:nyn,nxl:nxr) ) 1281 1282 CALL get_variable( id_surf, 'street_crossing', & 1283 street_crossing_f%var, nxl, nxr, nys, nyn ) 1284 1285 ELSE 1286 street_crossing_f%from_file = .FALSE. 1287 ENDIF 1288 ! 1289 !-- Still missing: root_resolved and building_surface_pars. 1290 !-- Will be implemented as soon as they are available. 1291 1292 ! 1293 !-- Finally, close input file 1294 CALL close_input_file( id_surf ) 1344 1295 #endif 1345 ENDIF1346 #if defined( __parallel )1347 CALL MPI_BARRIER( comm2d, ierr )1348 #endif1349 ENDDO1350 1296 ! 1351 1297 !-- End of CPU measurement … … 1829 1775 CALL cpu_log( log_point_s(83), 'NetCDF/ASCII input topo', 'start' ) 1830 1776 1831 DO ii = 0, io_blocks-1 1832 IF ( ii == io_group ) THEN 1833 ! 1834 !-- Input via palm-input data standard 1835 IF ( input_pids_static ) THEN 1777 ! 1778 !-- Input via palm-input data standard 1779 IF ( input_pids_static ) THEN 1836 1780 #if defined ( __netcdf ) 1837 1781 ! 1838 !-- Open file in read-only mode 1839 CALL open_read_file( TRIM( input_file_static ) // & 1840 TRIM( coupling_char ), id_topo ) 1841 1842 ! 1843 !-- At first, inquire all variable names. 1844 !-- This will be used to check whether an input variable exist 1845 !-- or not. 1846 CALL inquire_num_variables( id_topo, num_vars ) 1847 ! 1848 !-- Allocate memory to store variable names and inquire them. 1849 ALLOCATE( var_names(1:num_vars) ) 1850 CALL inquire_variable_names( id_topo, var_names ) 1851 ! 1852 !-- Read x, y - dimensions. Only required for consistency checks. 1853 CALL get_dimension_length( id_topo, dim_static%nx, 'x' ) 1854 CALL get_dimension_length( id_topo, dim_static%ny, 'y' ) 1855 ALLOCATE( dim_static%x(0:dim_static%nx-1) ) 1856 ALLOCATE( dim_static%y(0:dim_static%ny-1) ) 1857 CALL get_variable( id_topo, 'x', dim_static%x ) 1858 CALL get_variable( id_topo, 'y', dim_static%y ) 1859 ! 1860 !-- Terrain height. First, get variable-related _FillValue attribute 1861 IF ( check_existence( var_names, 'zt' ) ) THEN 1862 terrain_height_f%from_file = .TRUE. 1863 CALL get_attribute( id_topo, char_fill, & 1864 terrain_height_f%fill, & 1865 .FALSE., 'zt' ) 1866 ! 1867 !-- PE-wise reading of 2D terrain height. 1868 ALLOCATE ( terrain_height_f%var(nys:nyn,nxl:nxr) ) 1869 DO i = nxl, nxr 1870 CALL get_variable( id_topo, 'zt', & 1871 i, terrain_height_f%var(:,i) ) 1872 ENDDO 1873 ELSE 1874 terrain_height_f%from_file = .FALSE. 1875 ENDIF 1876 1877 ! 1878 !-- Read building height. First, read its _FillValue attribute, 1879 !-- as well as lod attribute 1880 buildings_f%from_file = .FALSE. 1881 IF ( check_existence( var_names, 'buildings_2d' ) ) THEN 1882 buildings_f%from_file = .TRUE. 1883 CALL get_attribute( id_topo, char_lod, buildings_f%lod, & 1884 .FALSE., 'buildings_2d' ) 1885 1886 CALL get_attribute( id_topo, char_fill, & 1887 buildings_f%fill1, & 1888 .FALSE., 'buildings_2d' ) 1889 1890 ! 1891 !-- Read 2D topography 1892 IF ( buildings_f%lod == 1 ) THEN 1893 ALLOCATE ( buildings_f%var_2d(nys:nyn,nxl:nxr) ) 1894 DO i = nxl, nxr 1895 CALL get_variable( id_topo, 'buildings_2d', & 1896 i, buildings_f%var_2d(:,i) ) 1897 ENDDO 1898 ELSE 1899 message_string = 'NetCDF attribute lod ' // & 1900 '(level of detail) is not set ' // & 1901 'properly for buildings_2d.' 1902 CALL message( 'netcdf_data_input_mod', 'PA0457', & 1903 1, 2, 0, 6, 0 ) 1904 ENDIF 1905 ENDIF 1906 ! 1907 !-- If available, also read 3D building information. If both are 1908 !-- available, use 3D information. 1909 IF ( check_existence( var_names, 'buildings_3d' ) ) THEN 1910 buildings_f%from_file = .TRUE. 1911 CALL get_attribute( id_topo, char_lod, buildings_f%lod, & 1912 .FALSE., 'buildings_3d' ) 1913 1914 CALL get_attribute( id_topo, char_fill, & 1915 buildings_f%fill2, & 1916 .FALSE., 'buildings_3d' ) 1917 1918 CALL get_dimension_length( id_topo, buildings_f%nz, 'z' ) 1919 1920 IF ( buildings_f%lod == 2 ) THEN 1921 ALLOCATE( buildings_f%z(nzb:buildings_f%nz-1) ) 1922 CALL get_variable( id_topo, 'z', buildings_f%z ) 1923 1924 ALLOCATE( buildings_f%var_3d(nzb:buildings_f%nz-1, & 1925 nys:nyn,nxl:nxr) ) 1926 buildings_f%var_3d = 0 1927 ! 1928 !-- Read data PE-wise. Read yz-slices. 1929 DO i = nxl, nxr 1930 DO j = nys, nyn 1931 CALL get_variable( id_topo, 'buildings_3d', & 1932 i, j, & 1933 buildings_f%var_3d(:,j,i) ) 1934 ENDDO 1935 ENDDO 1936 ELSE 1937 message_string = 'NetCDF attribute lod ' // & 1938 '(level of detail) is not set ' // & 1939 'properly for buildings_3d.' 1940 CALL message( 'netcdf_data_input_mod', 'PA0457', & 1941 1, 2, 0, 6, 0 ) 1942 ENDIF 1943 ENDIF 1944 ! 1945 !-- Read building IDs and its FillValue attribute. Further required 1946 !-- for mapping buildings on top of orography. 1947 IF ( check_existence( var_names, 'building_id' ) ) THEN 1948 building_id_f%from_file = .TRUE. 1949 CALL get_attribute( id_topo, char_fill, & 1950 building_id_f%fill, .FALSE., & 1951 'building_id' ) 1952 1953 1954 ALLOCATE ( building_id_f%var(nys:nyn,nxl:nxr) ) 1955 DO i = nxl, nxr 1956 CALL get_variable( id_topo, 'building_id', & 1957 i, building_id_f%var(:,i) ) 1958 ENDDO 1959 ELSE 1960 building_id_f%from_file = .FALSE. 1961 ENDIF 1962 ! 1963 !-- Read building_type and required attributes. 1964 IF ( check_existence( var_names, 'building_type' ) ) THEN 1965 building_type_f%from_file = .TRUE. 1966 CALL get_attribute( id_topo, char_fill, & 1967 building_type_f%fill, .FALSE., & 1968 'building_type' ) 1969 1970 ALLOCATE ( building_type_f%var(nys:nyn,nxl:nxr) ) 1971 DO i = nxl, nxr 1972 CALL get_variable( id_topo, 'building_type', & 1973 i, building_type_f%var(:,i) ) 1974 ENDDO 1975 ELSE 1976 building_type_f%from_file = .FALSE. 1977 ENDIF 1978 1979 ! 1980 !-- Close topography input file 1981 CALL close_input_file( id_topo ) 1782 !-- Open file in read-only mode 1783 CALL open_read_file( TRIM( input_file_static ) // & 1784 TRIM( coupling_char ), id_topo ) 1785 ! 1786 !-- At first, inquire all variable names. 1787 !-- This will be used to check whether an input variable exist 1788 !-- or not. 1789 CALL inquire_num_variables( id_topo, num_vars ) 1790 ! 1791 !-- Allocate memory to store variable names and inquire them. 1792 ALLOCATE( var_names(1:num_vars) ) 1793 CALL inquire_variable_names( id_topo, var_names ) 1794 ! 1795 !-- Read x, y - dimensions. Only required for consistency checks. 1796 CALL get_dimension_length( id_topo, dim_static%nx, 'x' ) 1797 CALL get_dimension_length( id_topo, dim_static%ny, 'y' ) 1798 ALLOCATE( dim_static%x(0:dim_static%nx-1) ) 1799 ALLOCATE( dim_static%y(0:dim_static%ny-1) ) 1800 CALL get_variable( id_topo, 'x', dim_static%x ) 1801 CALL get_variable( id_topo, 'y', dim_static%y ) 1802 ! 1803 !-- Terrain height. First, get variable-related _FillValue attribute 1804 IF ( check_existence( var_names, 'zt' ) ) THEN 1805 terrain_height_f%from_file = .TRUE. 1806 CALL get_attribute( id_topo, char_fill, terrain_height_f%fill, & 1807 .FALSE., 'zt' ) 1808 ! 1809 !-- Input 2D terrain height. 1810 ALLOCATE ( terrain_height_f%var(nys:nyn,nxl:nxr) ) 1811 1812 CALL get_variable( id_topo, 'zt', terrain_height_f%var, & 1813 nxl, nxr, nys, nyn ) 1814 1815 ELSE 1816 terrain_height_f%from_file = .FALSE. 1817 ENDIF 1818 1819 ! 1820 !-- Read building height. First, read its _FillValue attribute, 1821 !-- as well as lod attribute 1822 buildings_f%from_file = .FALSE. 1823 IF ( check_existence( var_names, 'buildings_2d' ) ) THEN 1824 buildings_f%from_file = .TRUE. 1825 CALL get_attribute( id_topo, char_lod, buildings_f%lod, & 1826 .FALSE., 'buildings_2d' ) 1827 1828 CALL get_attribute( id_topo, char_fill, buildings_f%fill1, & 1829 .FALSE., 'buildings_2d' ) 1830 1831 ! 1832 !-- Read 2D buildings 1833 IF ( buildings_f%lod == 1 ) THEN 1834 ALLOCATE ( buildings_f%var_2d(nys:nyn,nxl:nxr) ) 1835 1836 CALL get_variable( id_topo, 'buildings_2d', & 1837 buildings_f%var_2d, & 1838 nxl, nxr, nys, nyn ) 1839 ELSE 1840 message_string = 'NetCDF attribute lod ' // & 1841 '(level of detail) is not set ' // & 1842 'properly for buildings_2d.' 1843 CALL message( 'netcdf_data_input_mod', 'NDI000', & 1844 1, 2, 0, 6, 0 ) 1845 ENDIF 1846 ENDIF 1847 ! 1848 !-- If available, also read 3D building information. If both are 1849 !-- available, use 3D information. 1850 IF ( check_existence( var_names, 'buildings_3d' ) ) THEN 1851 buildings_f%from_file = .TRUE. 1852 CALL get_attribute( id_topo, char_lod, buildings_f%lod, & 1853 .FALSE., 'buildings_3d' ) 1854 1855 CALL get_attribute( id_topo, char_fill, buildings_f%fill2, & 1856 .FALSE., 'buildings_3d' ) 1857 1858 CALL get_dimension_length( id_topo, buildings_f%nz, 'z' ) 1859 ! 1860 !-- Read 3D buildings 1861 IF ( buildings_f%lod == 2 ) THEN 1862 ALLOCATE( buildings_f%z(nzb:buildings_f%nz-1) ) 1863 CALL get_variable( id_topo, 'z', buildings_f%z ) 1864 1865 ALLOCATE( buildings_f%var_3d(nzb:buildings_f%nz-1, & 1866 nys:nyn,nxl:nxr) ) 1867 buildings_f%var_3d = 0 1868 1869 CALL get_variable( id_topo, 'buildings_3d', & 1870 buildings_f%var_3d, & 1871 nxl, nxr, nys, nyn, 0, buildings_f%nz-1 ) 1872 ELSE 1873 message_string = 'NetCDF attribute lod ' // & 1874 '(level of detail) is not set ' // & 1875 'properly for buildings_3d.' 1876 CALL message( 'netcdf_data_input_mod', 'NDI001', & 1877 1, 2, 0, 6, 0 ) 1878 ENDIF 1879 ENDIF 1880 ! 1881 !-- Read building IDs and its FillValue attribute. Further required 1882 !-- for mapping buildings on top of orography. 1883 IF ( check_existence( var_names, 'building_id' ) ) THEN 1884 building_id_f%from_file = .TRUE. 1885 CALL get_attribute( id_topo, char_fill, & 1886 building_id_f%fill, .FALSE., & 1887 'building_id' ) 1888 1889 ALLOCATE ( building_id_f%var(nys:nyn,nxl:nxr) ) 1890 1891 CALL get_variable( id_topo, 'building_id', building_id_f%var, & 1892 nxl, nxr, nys, nyn ) 1893 ELSE 1894 building_id_f%from_file = .FALSE. 1895 ENDIF 1896 ! 1897 !-- Read building_type and required attributes. 1898 IF ( check_existence( var_names, 'building_type' ) ) THEN 1899 building_type_f%from_file = .TRUE. 1900 CALL get_attribute( id_topo, char_fill, & 1901 building_type_f%fill, .FALSE., & 1902 'building_type' ) 1903 1904 ALLOCATE ( building_type_f%var(nys:nyn,nxl:nxr) ) 1905 1906 CALL get_variable( id_topo, 'building_type', building_type_f%var, & 1907 nxl, nxr, nys, nyn ) 1908 1909 ELSE 1910 building_type_f%from_file = .FALSE. 1911 ENDIF 1912 ! 1913 !-- Close topography input file 1914 CALL close_input_file( id_topo ) 1982 1915 #else 1983 1916 CONTINUE 1984 1917 #endif 1985 1918 ! 1986 !-- ASCII input 1987 ELSEIF ( TRIM( topography ) == 'read_from_file' ) THEN 1919 !-- ASCII input 1920 ELSEIF ( TRIM( topography ) == 'read_from_file' ) THEN 1921 1922 DO ii = 0, io_blocks-1 1923 IF ( ii == io_group ) THEN 1988 1924 1989 1925 OPEN( 90, FILE='TOPOGRAPHY_DATA'//TRIM( coupling_char ), & … … 2021 1957 2022 1958 ENDIF 2023 2024 ENDIF2025 1959 #if defined( __parallel ) 2026 CALL MPI_BARRIER( comm2d, ierr )1960 CALL MPI_BARRIER( comm2d, ierr ) 2027 1961 #endif 2028 ENDDO 1962 ENDDO 1963 1964 ENDIF 2029 1965 ! 2030 1966 !-- End of CPU measurement … … 2117 2053 CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names 2118 2054 2055 LOGICAL :: dynamic_3d = .TRUE. !< flag indicating that 3D data is read from dynamic file 2056 2119 2057 INTEGER(iwp) :: i !< running index along x-direction 2120 INTEGER(iwp) :: ii !< running index for IO blocks2121 2058 INTEGER(iwp) :: id_dynamic !< NetCDF id of dynamic input file 2122 2059 INTEGER(iwp) :: j !< running index along y-direction 2123 2060 INTEGER(iwp) :: k !< running index along z-direction 2124 2061 INTEGER(iwp) :: num_vars !< number of variables in netcdf input file 2125 INTEGER(iwp) :: off_i !< offset in x-direction used for reading the u-component2126 INTEGER(iwp) :: off_j !< offset in y-direction used for reading the v-component2127 2062 2128 2063 LOGICAL :: check_passed !< flag indicating if a check passed … … 2148 2083 CALL cpu_log( log_point_s(85), 'NetCDF input init', 'start' ) 2149 2084 2150 DO ii = 0, io_blocks-12151 IF ( ii == io_group ) THEN2152 2085 #if defined ( __netcdf ) 2153 2086 ! 2154 !-- Open file in read-only mode 2155 CALL open_read_file( TRIM( input_file_dynamic ) // & 2156 TRIM( coupling_char ), id_dynamic ) 2157 2158 ! 2159 !-- At first, inquire all variable names. 2160 CALL inquire_num_variables( id_dynamic, num_vars ) 2161 ! 2162 !-- Allocate memory to store variable names. 2163 ALLOCATE( var_names(1:num_vars) ) 2164 CALL inquire_variable_names( id_dynamic, var_names ) 2165 ! 2166 !-- Read vertical dimension of scalar und w grid. Will be used for 2167 !-- inter- and extrapolation in case of stretched numeric grid. 2168 !-- This will be removed when Inifor is able to handle stretched grids. 2169 CALL get_dimension_length( id_dynamic, init_3d%nzu, 'z' ) 2170 CALL get_dimension_length( id_dynamic, init_3d%nzw, 'zw' ) 2171 CALL get_dimension_length( id_dynamic, init_3d%nzs, 'zsoil' ) 2172 ! 2173 !-- Read also the horizontal dimensions. These are used just used fo 2174 !-- checking the compatibility with the PALM grid before reading. 2175 CALL get_dimension_length( id_dynamic, init_3d%nx, 'x' ) 2176 CALL get_dimension_length( id_dynamic, init_3d%nxu, 'xu' ) 2177 CALL get_dimension_length( id_dynamic, init_3d%ny, 'y' ) 2178 CALL get_dimension_length( id_dynamic, init_3d%nyv, 'yv' ) 2179 2180 ! 2181 !-- Check for correct horizontal and vertical dimension. Please note, 2182 !-- checks are performed directly here and not called from 2183 !-- check_parameters as some varialbes are still not allocated there. 2184 !-- Moreover, please note, u- and v-grid has 1 grid point less on 2185 !-- Inifor grid. 2186 IF ( init_3d%nx-1 /= nx .OR. init_3d%nxu-1 /= nx - 1 .OR. & 2187 init_3d%ny-1 /= ny .OR. init_3d%nyv-1 /= ny - 1 ) THEN 2188 message_string = 'Number of inifor horizontal grid points '// & 2189 'does not match the number of numeric grid '//& 2190 'points.' 2191 CALL message( 'netcdf_data_input_mod', 'NDI003', 1, 2, 0, 6, 0 ) 2087 !-- Open file in read-only mode 2088 CALL open_read_file( TRIM( input_file_dynamic ) // & 2089 TRIM( coupling_char ), id_dynamic ) 2090 2091 ! 2092 !-- At first, inquire all variable names. 2093 CALL inquire_num_variables( id_dynamic, num_vars ) 2094 ! 2095 !-- Allocate memory to store variable names. 2096 ALLOCATE( var_names(1:num_vars) ) 2097 CALL inquire_variable_names( id_dynamic, var_names ) 2098 ! 2099 !-- Read vertical dimension of scalar und w grid. Will be used for 2100 !-- inter- and extrapolation in case of stretched numeric grid. 2101 !-- This will be removed when Inifor is able to handle stretched grids. 2102 CALL get_dimension_length( id_dynamic, init_3d%nzu, 'z' ) 2103 CALL get_dimension_length( id_dynamic, init_3d%nzw, 'zw' ) 2104 CALL get_dimension_length( id_dynamic, init_3d%nzs, 'depth' ) 2105 ! 2106 !-- Read also the horizontal dimensions. These are used just used fo 2107 !-- checking the compatibility with the PALM grid before reading. 2108 CALL get_dimension_length( id_dynamic, init_3d%nx, 'x' ) 2109 CALL get_dimension_length( id_dynamic, init_3d%nxu, 'xu' ) 2110 CALL get_dimension_length( id_dynamic, init_3d%ny, 'y' ) 2111 CALL get_dimension_length( id_dynamic, init_3d%nyv, 'yv' ) 2112 2113 ! 2114 !-- Check for correct horizontal and vertical dimension. Please note, 2115 !-- checks are performed directly here and not called from 2116 !-- check_parameters as some varialbes are still not allocated there. 2117 !-- Moreover, please note, u- and v-grid has 1 grid point less on 2118 !-- Inifor grid. 2119 IF ( init_3d%nx-1 /= nx .OR. init_3d%nxu-1 /= nx - 1 .OR. & 2120 init_3d%ny-1 /= ny .OR. init_3d%nyv-1 /= ny - 1 ) THEN 2121 message_string = 'Number of inifor horizontal grid points '// & 2122 'does not match the number of numeric grid '// & 2123 'points.' 2124 CALL message( 'netcdf_data_input_mod', 'NDI003', 1, 2, 0, 6, 0 ) 2125 ENDIF 2126 2127 IF ( init_3d%nzu-1 /= nz ) THEN 2128 message_string = 'Number of inifor vertical grid points ' // & 2129 'does not match the number of numeric grid '// & 2130 'points.' 2131 CALL message( 'netcdf_data_input_mod', 'NDI003', 1, 2, 0, 6, 0 ) 2132 ENDIF 2133 ! 2134 !-- Read vertical dimensions. Later, these are required for eventual 2135 !-- inter- and extrapolations of the initialization data. 2136 IF ( check_existence( var_names, 'z' ) ) THEN 2137 ALLOCATE( init_3d%zu_atmos(1:init_3d%nzu) ) 2138 CALL get_variable( id_dynamic, 'z', init_3d%zu_atmos ) 2139 ENDIF 2140 IF ( check_existence( var_names, 'zw' ) ) THEN 2141 ALLOCATE( init_3d%zw_atmos(1:init_3d%nzw) ) 2142 CALL get_variable( id_dynamic, 'zw', init_3d%zw_atmos ) 2143 ENDIF 2144 IF ( check_existence( var_names, 'depth' ) ) THEN 2145 ALLOCATE( init_3d%z_soil(1:init_3d%nzs) ) 2146 CALL get_variable( id_dynamic, 'depth', init_3d%z_soil ) 2147 ENDIF 2148 ! 2149 !-- Read initial geostrophic wind components at t = 0 (index 1 in file). 2150 ! IF ( check_existence( var_names, 'tend_ug' ) ) THEN 2151 IF ( check_existence( var_names, 'ls_forcing_ug' ) ) THEN 2152 ALLOCATE( init_3d%ug_init(nzb:nzt+1) ) 2153 ! CALL get_variable_pr( id_dynamic, 'tend_ug', 1, & 2154 ! init_3d%ug_init ) 2155 CALL get_variable_pr( id_dynamic, 'ls_forcing_ug', 1, & 2156 init_3d%ug_init ) 2157 init_3d%from_file_ug = .TRUE. 2158 ELSE 2159 init_3d%from_file_ug = .FALSE. 2160 ENDIF 2161 ! IF ( check_existence( var_names, 'tend_vg' ) ) THEN 2162 IF ( check_existence( var_names, 'ls_forcing_vg' ) ) THEN 2163 ALLOCATE( init_3d%vg_init(nzb:nzt+1) ) 2164 ! CALL get_variable_pr( id_dynamic, 'tend_vg', 1, & 2165 ! init_3d%vg_init ) 2166 CALL get_variable_pr( id_dynamic, 'ls_forcing_vg', 1, & 2167 init_3d%vg_init ) 2168 init_3d%from_file_vg = .TRUE. 2169 ELSE 2170 init_3d%from_file_vg = .FALSE. 2171 ENDIF 2172 ! 2173 !-- Read inital 3D data of u, v, w, pt and q, 2174 !-- derived from COSMO model. Read PE-wise yz-slices. 2175 !-- Please note, the u-, v- and w-component are defined on different 2176 !-- grids with one element less in the x-, y-, 2177 !-- and z-direction, respectively. Hence, reading is subdivided 2178 !-- into separate loops. 2179 !-- Read u-component 2180 IF ( check_existence( var_names, 'init_u' ) ) THEN 2181 ! 2182 !-- Read attributes for the fill value and level-of-detail 2183 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_u, & 2184 .FALSE., 'init_u' ) 2185 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_u, & 2186 .FALSE., 'init_u' ) 2187 ! 2188 !-- level-of-detail 1 - read initialization profile 2189 IF ( init_3d%lod_u == 1 ) THEN 2190 ALLOCATE( init_3d%u_init(nzb:nzt+1) ) 2191 init_3d%u_init = 0.0_wp 2192 2193 CALL get_variable( id_dynamic, 'init_u', & 2194 init_3d%u_init(nzb+1:nzt+1) ) 2195 ! 2196 !-- level-of-detail 2 - read 3D initialization data 2197 ELSEIF ( init_3d%lod_u == 2 ) THEN 2198 2199 CALL get_variable( id_dynamic, 'init_u', & 2200 u(nzb+1:nzt+1,nys:nyn,nxlu:nxr), & 2201 nxlu, nys+1, nzb+1, & 2202 nxr-nxlu+1, nyn-nys+1, init_3d%nzu, & 2203 dynamic_3d ) 2204 ENDIF 2205 init_3d%from_file_u = .TRUE. 2206 ENDIF 2207 ! 2208 !-- Read v-component 2209 IF ( check_existence( var_names, 'init_v' ) ) THEN 2210 ! 2211 !-- Read attributes for the fill value and level-of-detail 2212 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_v, & 2213 .FALSE., 'init_v' ) 2214 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_v, & 2215 .FALSE., 'init_v' ) 2216 ! 2217 !-- level-of-detail 1 - read initialization profile 2218 IF ( init_3d%lod_v == 1 ) THEN 2219 ALLOCATE( init_3d%v_init(nzb:nzt+1) ) 2220 init_3d%v_init = 0.0_wp 2221 2222 CALL get_variable( id_dynamic, 'init_v', & 2223 init_3d%v_init(nzb+1:nzt+1) ) 2224 2225 ! 2226 !-- level-of-detail 2 - read 3D initialization data 2227 ELSEIF ( init_3d%lod_v == 2 ) THEN 2228 2229 CALL get_variable( id_dynamic, 'init_v', & 2230 v(nzb+1:nzt+1,nysv:nyn,nxl:nxr), & 2231 nxl+1, nysv, nzb+1, & 2232 nxr-nxl+1, nyn-nysv+1, init_3d%nzu, & 2233 dynamic_3d ) 2234 2235 ENDIF 2236 init_3d%from_file_v = .TRUE. 2237 ENDIF 2238 ! 2239 !-- Read w-component 2240 IF ( check_existence( var_names, 'init_w' ) ) THEN 2241 ! 2242 !-- Read attributes for the fill value and level-of-detail 2243 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_w, & 2244 .FALSE., 'init_w' ) 2245 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_w, & 2246 .FALSE., 'init_w' ) 2247 ! 2248 !-- level-of-detail 1 - read initialization profile 2249 IF ( init_3d%lod_w == 1 ) THEN 2250 ALLOCATE( init_3d%w_init(nzb:nzt+1) ) 2251 init_3d%w_init = 0.0_wp 2252 2253 CALL get_variable( id_dynamic, 'init_w', & 2254 init_3d%w_init(nzb+1:nzt) ) 2255 2256 ! 2257 !-- level-of-detail 2 - read 3D initialization data 2258 ELSEIF ( init_3d%lod_w == 2 ) THEN 2259 2260 CALL get_variable( id_dynamic, 'init_w', & 2261 w(nzb+1:nzt,nys:nyn,nxl:nxr), & 2262 nxl+1, nys+1, nzb+1, & 2263 nxr-nxl+1, nyn-nys+1, init_3d%nzw, & 2264 dynamic_3d ) 2265 2266 ENDIF 2267 init_3d%from_file_w = .TRUE. 2268 ENDIF 2269 ! 2270 !-- Read potential temperature 2271 IF ( .NOT. neutral ) THEN 2272 IF ( check_existence( var_names, 'init_pt' ) ) THEN 2273 ! 2274 !-- Read attributes for the fill value and level-of-detail 2275 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_pt, & 2276 .FALSE., 'init_pt' ) 2277 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_pt, & 2278 .FALSE., 'init_pt' ) 2279 ! 2280 !-- level-of-detail 1 - read initialization profile 2281 IF ( init_3d%lod_pt == 1 ) THEN 2282 ALLOCATE( init_3d%pt_init(nzb:nzt+1) ) 2283 2284 CALL get_variable( id_dynamic, 'init_pt', & 2285 init_3d%pt_init(nzb+1:nzt+1) ) 2286 ! 2287 !-- Set Neumann surface boundary condition for initial profil 2288 init_3d%pt_init(nzb) = init_3d%pt_init(nzb+1) 2289 ! 2290 !-- level-of-detail 2 - read 3D initialization data 2291 ELSEIF ( init_3d%lod_pt == 2 ) THEN 2292 2293 CALL get_variable( id_dynamic, 'init_pt', & 2294 pt(nzb+1:nzt+1,nys:nyn,nxl:nxr), & 2295 nxl+1, nys+1, nzb+1, & 2296 nxr-nxl+1, nyn-nys+1, init_3d%nzu, & 2297 dynamic_3d ) 2298 2299 2192 2300 ENDIF 2193 2194 IF ( init_3d%nzu-1 /= nz ) THEN 2195 message_string = 'Number of inifor vertical grid points ' // & 2196 'does not match the number of numeric grid '//& 2197 'points.' 2198 CALL message( 'netcdf_data_input_mod', 'NDI003', 1, 2, 0, 6, 0 ) 2301 init_3d%from_file_pt = .TRUE. 2302 ENDIF 2303 ENDIF 2304 ! 2305 !-- Read mixing ratio 2306 IF ( humidity ) THEN 2307 IF ( check_existence( var_names, 'init_qv' ) ) THEN 2308 ! 2309 !-- Read attributes for the fill value and level-of-detail 2310 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_q, & 2311 .FALSE., 'init_qv' ) 2312 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_q, & 2313 .FALSE., 'init_qv' ) 2314 ! 2315 !-- level-of-detail 1 - read initialization profile 2316 IF ( init_3d%lod_q == 1 ) THEN 2317 ALLOCATE( init_3d%q_init(nzb:nzt+1) ) 2318 2319 CALL get_variable( id_dynamic, 'init_qv', & 2320 init_3d%q_init(nzb+1:nzt+1) ) 2321 ! 2322 !-- Set Neumann surface boundary condition for initial profil 2323 init_3d%q_init(nzb) = init_3d%q_init(nzb+1) 2324 2325 ! 2326 !-- level-of-detail 2 - read 3D initialization data 2327 ELSEIF ( init_3d%lod_q == 2 ) THEN 2328 2329 CALL get_variable( id_dynamic, 'init_qv', & 2330 q(nzb+1:nzt+1,nys:nyn,nxl:nxr), & 2331 nxl+1, nys+1, nzb+1, & 2332 nxr-nxl+1, nyn-nys+1, init_3d%nzu, & 2333 dynamic_3d ) 2334 2335 2336 2199 2337 ENDIF 2200 ! 2201 !-- Read vertical dimensions. Later, these are required for eventual 2202 !-- inter- and extrapolations of the initialization data. 2203 IF ( check_existence( var_names, 'z' ) ) THEN 2204 ALLOCATE( init_3d%zu_atmos(1:init_3d%nzu) ) 2205 CALL get_variable( id_dynamic, 'z', init_3d%zu_atmos ) 2338 init_3d%from_file_q = .TRUE. 2339 ENDIF 2340 ENDIF 2341 ! 2342 !-- Read soil moisture 2343 IF ( land_surface ) THEN 2344 2345 IF ( check_existence( var_names, 'init_soil_m' ) ) THEN 2346 ! 2347 !-- Read attributes for the fill value and level-of-detail 2348 CALL get_attribute( id_dynamic, char_fill, & 2349 init_3d%fill_msoil, & 2350 .FALSE., 'init_soil_m' ) 2351 CALL get_attribute( id_dynamic, char_lod, & 2352 init_3d%lod_msoil, & 2353 .FALSE., 'init_soil_m' ) 2354 ! 2355 !-- level-of-detail 1 - read initialization profile 2356 IF ( init_3d%lod_msoil == 1 ) THEN 2357 ALLOCATE( init_3d%msoil_init(0:init_3d%nzs-1) ) 2358 2359 CALL get_variable( id_dynamic, 'init_soil_m', & 2360 init_3d%msoil_init(0:init_3d%nzs-1) ) 2361 ! 2362 !-- level-of-detail 2 - read 3D initialization data 2363 ELSEIF ( init_3d%lod_msoil == 2 ) THEN 2364 ALLOCATE ( init_3d%msoil(0:init_3d%nzs-1,nys:nyn,nxl:nxr) ) 2365 2366 CALL get_variable( id_dynamic, 'init_soil_m', & 2367 init_3d%msoil(0:init_3d%nzs-1,nys:nyn,nxl:nxr),& 2368 nxl, nxr, nys, nyn, 0, init_3d%nzs-1 ) 2369 2206 2370 ENDIF 2207 IF ( check_existence( var_names, 'zw' ) ) THEN 2208 ALLOCATE( init_3d%zw_atmos(1:init_3d%nzw) ) 2209 CALL get_variable( id_dynamic, 'zw', init_3d%zw_atmos ) 2371 init_3d%from_file_msoil = .TRUE. 2372 ENDIF 2373 ! 2374 !-- Read soil temperature 2375 IF ( check_existence( var_names, 'init_soil_t' ) ) THEN 2376 ! 2377 !-- Read attributes for the fill value and level-of-detail 2378 CALL get_attribute( id_dynamic, char_fill, & 2379 init_3d%fill_tsoil, & 2380 .FALSE., 'init_soil_t' ) 2381 CALL get_attribute( id_dynamic, char_lod, & 2382 init_3d%lod_tsoil, & 2383 .FALSE., 'init_soil_t' ) 2384 ! 2385 !-- level-of-detail 1 - read initialization profile 2386 IF ( init_3d%lod_tsoil == 1 ) THEN 2387 ALLOCATE( init_3d%tsoil_init(0:init_3d%nzs-1) ) 2388 2389 CALL get_variable( id_dynamic, 'init_soil_t', & 2390 init_3d%tsoil_init(0:init_3d%nzs-1) ) 2391 2392 ! 2393 !-- level-of-detail 2 - read 3D initialization data 2394 ELSEIF ( init_3d%lod_tsoil == 2 ) THEN 2395 ALLOCATE ( init_3d%tsoil(0:init_3d%nzs-1,nys:nyn,nxl:nxr) ) 2396 2397 CALL get_variable( id_dynamic, 'init_soil_t', & 2398 init_3d%tsoil(0:init_3d%nzs-1,nys:nyn,nxl:nxr),& 2399 nxl, nxr, nys, nyn, 0, init_3d%nzs-1 ) 2210 2400 ENDIF 2211 IF ( check_existence( var_names, 'zsoil' ) ) THEN 2212 ALLOCATE( init_3d%z_soil(1:init_3d%nzs) ) 2213 CALL get_variable( id_dynamic, 'zsoil', init_3d%z_soil ) 2214 ENDIF 2215 ! 2216 !-- Read initial geostrophic wind components at 2217 !-- t = 0 (index 1 in file). 2218 IF ( check_existence( var_names, 'tend_ug' ) ) THEN 2219 ALLOCATE( init_3d%ug_init(nzb:nzt+1) ) 2220 CALL get_variable_pr( id_dynamic, 'tend_ug', 1, & 2221 init_3d%ug_init ) 2222 init_3d%from_file_ug = .TRUE. 2223 ELSE 2224 init_3d%from_file_ug = .FALSE. 2225 ENDIF 2226 IF ( check_existence( var_names, 'tend_vg' ) ) THEN 2227 ALLOCATE( init_3d%vg_init(nzb:nzt+1) ) 2228 CALL get_variable_pr( id_dynamic, 'tend_vg', 1, & 2229 init_3d%vg_init ) 2230 init_3d%from_file_vg = .TRUE. 2231 ELSE 2232 init_3d%from_file_vg = .FALSE. 2233 ENDIF 2234 ! 2235 !-- Read inital 3D data of u, v, w, pt and q, 2236 !-- derived from COSMO model. Read PE-wise yz-slices. 2237 !-- Please note, the u-, v- and w-component are defined on different 2238 !-- grids with one element less in the x-, y-, 2239 !-- and z-direction, respectively. Hence, reading is subdivided 2240 !-- into separate loops. Moreover, i and j are used 2241 !-- as start index in the NF90 interface. 2242 !-- The passed arguments for u, and v are (i,j)-1, respectively, 2243 !-- in contrast to the remaining quantities. This is because in case 2244 !-- of forcing is applied, the input data for u and v has one 2245 !-- element less along the x- and y-direction respectively. 2246 !-- Read u-component 2247 IF ( check_existence( var_names, 'init_u' ) ) THEN 2248 ! 2249 !-- Read attributes for the fill value and level-of-detail 2250 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_u, & 2251 .FALSE., 'init_u' ) 2252 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_u, & 2253 .FALSE., 'init_u' ) 2254 ! 2255 !-- level-of-detail 1 - read initialization profile 2256 IF ( init_3d%lod_u == 1 ) THEN 2257 ALLOCATE( init_3d%u_init(nzb:nzt+1) ) 2258 init_3d%u_init = 0.0_wp 2259 2260 CALL get_variable( id_dynamic, 'init_u', & 2261 init_3d%u_init(nzb+1:nzt+1) ) 2262 ! 2263 !-- level-of-detail 2 - read 3D initialization data 2264 ELSEIF ( init_3d%lod_u == 2 ) THEN 2265 ! 2266 !-- Set offset value. In case of Dirichlet conditions at the left 2267 !-- domain boundary, the u component starts at nxl+1. This case, 2268 !-- the passed start-index for reading the NetCDF data is shifted 2269 !-- by -1. 2270 off_i = 1 !MERGE( 1, 0, forcing ) 2271 2272 DO i = nxlu, nxr 2273 DO j = nys, nyn 2274 CALL get_variable( id_dynamic, 'init_u', i-off_i, j, & 2275 u(nzb+1:nzt+1,j,i) ) 2276 ENDDO 2277 ENDDO 2278 2279 ENDIF 2280 init_3d%from_file_u = .TRUE. 2281 ENDIF 2282 ! 2283 !-- Read v-component 2284 IF ( check_existence( var_names, 'init_v' ) ) THEN 2285 ! 2286 !-- Read attributes for the fill value and level-of-detail 2287 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_v, & 2288 .FALSE., 'init_v' ) 2289 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_v, & 2290 .FALSE., 'init_v' ) 2291 ! 2292 !-- level-of-detail 1 - read initialization profile 2293 IF ( init_3d%lod_v == 1 ) THEN 2294 ALLOCATE( init_3d%v_init(nzb:nzt+1) ) 2295 init_3d%v_init = 0.0_wp 2296 2297 CALL get_variable( id_dynamic, 'init_v', & 2298 init_3d%v_init(nzb+1:nzt+1) ) 2299 2300 ! 2301 !-- level-of-detail 2 - read 3D initialization data 2302 ELSEIF ( init_3d%lod_v == 2 ) THEN 2303 ! 2304 !-- Set offset value. In case of Dirichlet conditions at the south 2305 !-- domain boundary, the v component starts at nys+1. This case, 2306 !-- the passed start-index for reading the NetCDF data is shifted 2307 !-- by -1. 2308 off_j = 1 !MERGE( 1, 0, forcing ) 2309 2310 DO i = nxl, nxr 2311 DO j = nysv, nyn 2312 CALL get_variable( id_dynamic, 'init_v', i, j-off_j, & 2313 v(nzb+1:nzt+1,j,i) ) 2314 ENDDO 2315 ENDDO 2316 2317 ENDIF 2318 init_3d%from_file_v = .TRUE. 2319 ENDIF 2320 ! 2321 !-- Read w-component 2322 IF ( check_existence( var_names, 'init_w' ) ) THEN 2323 ! 2324 !-- Read attributes for the fill value and level-of-detail 2325 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_w, & 2326 .FALSE., 'init_w' ) 2327 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_w, & 2328 .FALSE., 'init_w' ) 2329 ! 2330 !-- level-of-detail 1 - read initialization profile 2331 IF ( init_3d%lod_w == 1 ) THEN 2332 ALLOCATE( init_3d%w_init(nzb:nzt+1) ) 2333 init_3d%w_init = 0.0_wp 2334 2335 CALL get_variable( id_dynamic, 'init_w', & 2336 init_3d%w_init(nzb+1:nzt) ) 2337 2338 ! 2339 !-- level-of-detail 2 - read 3D initialization data 2340 ELSEIF ( init_3d%lod_w == 2 ) THEN 2341 DO i = nxl, nxr 2342 DO j = nys, nyn 2343 CALL get_variable( id_dynamic, 'init_w', i, j, & 2344 w(nzb+1:nzt,j,i) ) 2345 ENDDO 2346 ENDDO 2347 2348 ENDIF 2349 init_3d%from_file_w = .TRUE. 2350 ENDIF 2351 ! 2352 !-- Read potential temperature 2353 IF ( .NOT. neutral ) THEN 2354 IF ( check_existence( var_names, 'init_pt' ) ) THEN 2355 ! 2356 !-- Read attributes for the fill value and level-of-detail 2357 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_pt, & 2358 .FALSE., 'init_pt' ) 2359 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_pt, & 2360 .FALSE., 'init_pt' ) 2361 ! 2362 !-- level-of-detail 1 - read initialization profile 2363 IF ( init_3d%lod_pt == 1 ) THEN 2364 ALLOCATE( init_3d%pt_init(nzb:nzt+1) ) 2365 2366 CALL get_variable( id_dynamic, 'init_pt', & 2367 init_3d%pt_init(nzb+1:nzt+1) ) 2368 ! 2369 !-- Set Neumann surface boundary condition for initial profil 2370 init_3d%pt_init(nzb) = init_3d%pt_init(nzb+1) 2371 ! 2372 !-- level-of-detail 2 - read 3D initialization data 2373 ELSEIF ( init_3d%lod_pt == 2 ) THEN 2374 DO i = nxl, nxr 2375 DO j = nys, nyn 2376 CALL get_variable( id_dynamic, 'init_pt', i, j, & 2377 pt(nzb+1:nzt+1,j,i) ) 2378 ENDDO 2379 ENDDO 2380 2381 ENDIF 2382 init_3d%from_file_pt = .TRUE. 2383 ENDIF 2384 ENDIF 2385 ! 2386 !-- Read mixing ratio 2387 IF ( humidity ) THEN 2388 IF ( check_existence( var_names, 'init_qv' ) ) THEN 2389 ! 2390 !-- Read attributes for the fill value and level-of-detail 2391 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_q, & 2392 .FALSE., 'init_qv' ) 2393 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_q, & 2394 .FALSE., 'init_qv' ) 2395 ! 2396 !-- level-of-detail 1 - read initialization profile 2397 IF ( init_3d%lod_q == 1 ) THEN 2398 ALLOCATE( init_3d%q_init(nzb:nzt+1) ) 2399 2400 CALL get_variable( id_dynamic, 'init_qv', & 2401 init_3d%q_init(nzb+1:nzt+1) ) 2402 ! 2403 !-- Set Neumann surface boundary condition for initial profil 2404 init_3d%q_init(nzb) = init_3d%q_init(nzb+1) 2405 2406 ! 2407 !-- level-of-detail 2 - read 3D initialization data 2408 ELSEIF ( init_3d%lod_q == 2 ) THEN 2409 DO i = nxl, nxr 2410 DO j = nys, nyn 2411 CALL get_variable( id_dynamic, 'init_qv', i, j, & 2412 q(nzb+1:nzt+1,j,i) ) 2413 ENDDO 2414 ENDDO 2415 2416 ENDIF 2417 init_3d%from_file_q = .TRUE. 2418 ENDIF 2419 ENDIF 2420 ! 2421 !-- Read soil moisture 2422 IF ( land_surface ) THEN 2423 2424 IF ( check_existence( var_names, 'init_soil_m' ) ) THEN 2425 ! 2426 !-- Read attributes for the fill value and level-of-detail 2427 CALL get_attribute( id_dynamic, char_fill, & 2428 init_3d%fill_msoil, & 2429 .FALSE., 'init_soil_m' ) 2430 CALL get_attribute( id_dynamic, char_lod, & 2431 init_3d%lod_msoil, & 2432 .FALSE., 'init_soil_m' ) 2433 ! 2434 !-- level-of-detail 1 - read initialization profile 2435 IF ( init_3d%lod_msoil == 1 ) THEN 2436 ALLOCATE( init_3d%msoil_init(0:init_3d%nzs-1) ) 2437 2438 CALL get_variable( id_dynamic, 'init_soil_m', & 2439 init_3d%msoil_init(0:init_3d%nzs-1) ) 2440 ! 2441 !-- level-of-detail 2 - read 3D initialization data 2442 ELSEIF ( init_3d%lod_msoil == 2 ) THEN 2443 ALLOCATE ( init_3d%msoil(0:init_3d%nzs-1,nys:nyn,nxl:nxr) ) 2444 DO i = nxl, nxr 2445 DO j = nys, nyn 2446 CALL get_variable( id_dynamic, 'init_soil_m', i, j,& 2447 init_3d%msoil(0:init_3d%nzs-1,j,i) ) 2448 ENDDO 2449 ENDDO 2450 ENDIF 2451 init_3d%from_file_msoil = .TRUE. 2452 ENDIF 2453 ! 2454 !-- Read soil temperature 2455 IF ( check_existence( var_names, 'init_soil_t' ) ) THEN 2456 ! 2457 !-- Read attributes for the fill value and level-of-detail 2458 CALL get_attribute( id_dynamic, char_fill, & 2459 init_3d%fill_tsoil, & 2460 .FALSE., 'init_soil_t' ) 2461 CALL get_attribute( id_dynamic, char_lod, & 2462 init_3d%lod_tsoil, & 2463 .FALSE., 'init_soil_t' ) 2464 ! 2465 !-- level-of-detail 1 - read initialization profile 2466 IF ( init_3d%lod_tsoil == 1 ) THEN 2467 ALLOCATE( init_3d%tsoil_init(0:init_3d%nzs-1) ) 2468 2469 CALL get_variable( id_dynamic, 'init_soil_t', & 2470 init_3d%tsoil_init(0:init_3d%nzs-1) ) 2471 2472 ! 2473 !-- level-of-detail 2 - read 3D initialization data 2474 ELSEIF ( init_3d%lod_tsoil == 2 ) THEN 2475 ALLOCATE ( init_3d%tsoil(0:init_3d%nzs-1,nys:nyn,nxl:nxr) ) 2476 DO i = nxl, nxr 2477 DO j = nys, nyn 2478 CALL get_variable( id_dynamic, 'init_soil_t', i, j,& 2479 init_3d%tsoil(0:init_3d%nzs-1,j,i) ) 2480 ENDDO 2481 ENDDO 2482 ENDIF 2483 init_3d%from_file_tsoil = .TRUE. 2484 ENDIF 2485 ENDIF 2486 ! 2487 !-- Close input file 2488 CALL close_input_file( id_dynamic ) 2401 init_3d%from_file_tsoil = .TRUE. 2402 ENDIF 2403 ENDIF 2404 ! 2405 !-- Close input file 2406 CALL close_input_file( id_dynamic ) 2489 2407 #endif 2490 ENDIF2491 #if defined( __parallel )2492 CALL MPI_BARRIER( comm2d, ierr )2493 #endif2494 ENDDO2495 2408 ! 2496 2409 !-- End of CPU measurement … … 2604 2517 IMPLICIT NONE 2605 2518 2606 2519 LOGICAL :: dynamic_3d = .TRUE. !< flag indicating that 3D data is read from dynamic file 2520 2607 2521 INTEGER(iwp) :: i !< running index along x-direction 2608 INTEGER(iwp) :: ii !< running index for IO blocks2609 2522 INTEGER(iwp) :: id_dynamic !< NetCDF id of dynamic input file 2610 2523 INTEGER(iwp) :: j !< running index along y-direction … … 2624 2537 CALL cpu_log( log_point_s(86), 'NetCDF input forcing', 'start' ) 2625 2538 2626 DO ii = 0, io_blocks-12627 IF ( ii == io_group ) THEN2628 2539 #if defined ( __netcdf ) 2629 2540 ! 2630 !-- Open file in read-only mode 2631 CALL open_read_file( TRIM( input_file_dynamic ) // & 2632 TRIM( coupling_char ), id_dynamic ) 2633 ! 2634 !-- Initialize INIFOR forcing. 2635 IF ( .NOT. force%init ) THEN 2636 ! 2637 !-- At first, inquire all variable names. 2638 CALL inquire_num_variables( id_dynamic, num_vars ) 2639 ! 2640 !-- Allocate memory to store variable names. 2641 ALLOCATE( force%var_names(1:num_vars) ) 2642 CALL inquire_variable_names( id_dynamic, force%var_names ) 2643 ! 2644 !-- Read time dimension, allocate memory and finally read time array 2645 CALL get_dimension_length( id_dynamic, force%nt, 'time' ) 2646 2647 IF ( check_existence( force%var_names, 'time' ) ) THEN 2648 ALLOCATE( force%time(0:force%nt-1) ) 2649 CALL get_variable( id_dynamic, 'time', force%time ) 2650 ENDIF 2651 ! 2652 !-- Read vertical dimension of scalar und w grid 2653 CALL get_dimension_length( id_dynamic, force%nzu, 'z' ) 2654 CALL get_dimension_length( id_dynamic, force%nzw, 'zw' ) 2655 2656 IF ( check_existence( force%var_names, 'z' ) ) THEN 2657 ALLOCATE( force%zu_atmos(1:force%nzu) ) 2658 CALL get_variable( id_dynamic, 'z', force%zu_atmos ) 2659 ENDIF 2660 IF ( check_existence( force%var_names, 'zw' ) ) THEN 2661 ALLOCATE( force%zw_atmos(1:force%nzw) ) 2662 CALL get_variable( id_dynamic, 'zw', force%zw_atmos ) 2663 ENDIF 2664 2665 ! 2666 !-- Read surface pressure 2667 IF ( check_existence( force%var_names, & 2668 'surface_forcing_surface_pressure' ) ) THEN 2669 ALLOCATE( force%surface_pressure(0:force%nt-1) ) 2670 CALL get_variable( id_dynamic, & 2671 'surface_forcing_surface_pressure', & 2672 force%surface_pressure ) 2673 ENDIF 2674 ! 2675 !-- Set control flag to indicate that initialization is already done 2676 force%init = .TRUE. 2677 2678 ENDIF 2679 2680 ! 2681 !-- Obtain time index for current input starting at 0. 2682 !-- @todo: At the moment time, in INIFOR and simulated time correspond 2683 !-- to each other. If required, adjust to daytime. 2684 force%tind = MINLOC( ABS( force%time - simulated_time ), DIM = 1 )& 2685 - 1 2686 force%tind_p = force%tind + 1 2687 ! 2688 !-- Read geostrophic wind components. In case of forcing, this is only 2689 !-- required if cyclic boundary conditions are applied. 2690 IF ( bc_lr_cyc .AND. bc_ns_cyc ) THEN 2691 DO t = force%tind, force%tind_p 2692 CALL get_variable_pr( id_dynamic, 'tend_ug', t+1, & 2693 force%ug(t-force%tind,:) ) 2694 CALL get_variable_pr( id_dynamic, 'tend_vg', t+1, & 2695 force%ug(t-force%tind,:) ) 2696 ENDDO 2697 ENDIF 2698 ! 2699 !-- Read data at lateral and top boundaries. Please note, at left and 2700 !-- right domain boundary, yz-layers are read for u, v, w, pt and q. 2701 !-- For the v-component, the data starts at nysv, while for the other 2702 !-- quantities the data starts at nys. This is equivalent at the north 2703 !-- and south domain boundary for the u-component. 2704 !-- The function get_variable_bc assumes the start indices with respect 2705 !-- to the netcdf file convention (data starts at index 1). For this 2706 !-- reason, nys+1 / nxl+1 are passed instead of nys / nxl. For the 2707 !-- the u- and v-component at the north/south, and left/right boundary, 2708 !-- nxlu and nysv are passed, respectively, since these always starts 2709 !-- at index 1 in case of forcing. 2710 2711 IF ( force_bound_l ) THEN 2712 DO j = nys, nyn 2713 DO t = force%tind, force%tind_p 2714 CALL get_variable_bc( id_dynamic, 'ls_forcing_left_u', & 2715 t+1, & 2716 nzb+1, nzt+1-(nzb+1)+1, & 2717 j+1, 1, & 2718 force%u_left(t-force%tind,nzb+1:nzt+1,j) ) 2719 ENDDO 2720 ENDDO 2721 2722 DO j = nysv, nyn 2723 DO t = force%tind, force%tind_p 2724 CALL get_variable_bc( id_dynamic, 'ls_forcing_left_v', & 2725 t+1, & 2726 nzb+1, nzt+1-(nzb+1)+1, & 2727 j, 1, & 2728 force%v_left(t-force%tind,nzb+1:nzt+1,j) ) 2729 ENDDO 2730 ENDDO 2731 DO j = nys, nyn 2732 DO t = force%tind, force%tind_p 2733 CALL get_variable_bc( id_dynamic, & 2734 'ls_forcing_left_w', & 2735 t+1, & 2736 nzb+1, nzt-(nzb+1) + 1, & 2737 j+1, 1, & 2738 force%w_left(t-force%tind,nzb+1:nzt,j) ) 2739 ENDDO 2740 ENDDO 2741 IF ( .NOT. neutral ) THEN 2742 DO j = nys, nyn 2743 DO t = force%tind, force%tind_p 2744 CALL get_variable_bc( id_dynamic, & 2745 'ls_forcing_left_pt', & 2746 t+1, & 2747 nzb+1, nzt+1-(nzb+1)+1, & 2748 j+1, 1, & 2749 force%pt_left(t-force%tind,nzb+1:nzt+1,j) ) 2750 ENDDO 2751 ENDDO 2752 ENDIF 2753 IF ( humidity ) THEN 2754 DO j = nys, nyn 2755 DO t = force%tind, force%tind_p 2756 CALL get_variable_bc( id_dynamic, & 2757 'ls_forcing_left_qv', & 2758 t+1, & 2759 nzb+1, nzt+1-(nzb+1)+1, & 2760 j+1, 1, & 2761 force%q_left(t-force%tind,nzb+1:nzt+1,j) ) 2762 ENDDO 2763 ENDDO 2764 ENDIF 2765 ENDIF 2766 2767 IF ( force_bound_r ) THEN 2768 DO j = nys, nyn 2769 DO t = force%tind, force%tind_p 2770 CALL get_variable_bc( id_dynamic, 'ls_forcing_right_u', & 2771 t+1, & 2772 nzb+1, nzt+1-(nzb+1)+1, & 2773 j+1, 1, & 2774 force%u_right(t-force%tind,nzb+1:nzt+1,j) ) 2775 ENDDO 2776 ENDDO 2777 DO j = nysv, nyn 2778 DO t = force%tind, force%tind_p 2779 CALL get_variable_bc( id_dynamic, 'ls_forcing_right_v', & 2780 t+1, & 2781 nzb+1, nzt+1-(nzb+1)+1, & 2782 j, 1, & 2783 force%v_right(t-force%tind,nzb+1:nzt+1,j) ) 2784 ENDDO 2785 ENDDO 2786 DO j = nys, nyn 2787 DO t = force%tind, force%tind_p 2788 CALL get_variable_bc( id_dynamic, 'ls_forcing_right_w', & 2789 t+1, & 2790 nzb+1, nzt-(nzb+1)+1, & 2791 j+1, 1, & 2792 force%w_right(t-force%tind,nzb+1:nzt,j) ) 2793 ENDDO 2794 ENDDO 2795 IF ( .NOT. neutral ) THEN 2796 DO j = nys, nyn 2797 DO t = force%tind, force%tind_p 2798 CALL get_variable_bc( id_dynamic, & 2799 'ls_forcing_right_pt', & 2800 t+1, & 2801 nzb+1, nzt+1-(nzb+1)+1, & 2802 j+1, 1, & 2803 force%pt_right(t-force%tind,nzb+1:nzt+1,j) ) 2804 ENDDO 2805 ENDDO 2806 ENDIF 2807 IF ( humidity ) THEN 2808 DO j = nys, nyn 2809 DO t = force%tind, force%tind_p 2810 CALL get_variable_bc( id_dynamic, & 2811 'ls_forcing_right_qv', & 2812 t+1, & 2813 nzb+1, nzt+1-(nzb+1)+1, & 2814 j+1, 1, & 2815 force%q_right(t-force%tind,nzb+1:nzt+1,j) ) 2816 ENDDO 2817 ENDDO 2818 ENDIF 2819 ENDIF 2820 2821 IF ( force_bound_n ) THEN 2822 DO i = nxlu, nxr 2823 DO t = force%tind, force%tind_p 2824 CALL get_variable_bc( id_dynamic, 'ls_forcing_north_u', & 2825 t+1, & 2826 nzb+1, nzt+1-(nzb+1)+1, & 2827 i, 1, & 2828 force%u_north(t-force%tind,nzb+1:nzt+1,i) ) 2829 ENDDO 2830 ENDDO 2831 DO i = nxl, nxr 2832 DO t = force%tind, force%tind_p 2833 CALL get_variable_bc( id_dynamic, 'ls_forcing_north_v', & 2834 t+1, & 2835 nzb+1, nzt+1-(nzb+1)+1, & 2836 i+1, 1, & 2837 force%v_north(t-force%tind,nzb+1:nzt+1,i) ) 2838 ENDDO 2839 ENDDO 2840 DO i = nxl, nxr 2841 DO t = force%tind, force%tind_p 2842 CALL get_variable_bc( id_dynamic, 'ls_forcing_north_w', & 2843 t+1, & 2844 nzb+1, nzt-(nzb+1)+1, & 2845 i+1, 1, & 2846 force%w_north(t-force%tind,nzb+1:nzt,i) ) 2847 ENDDO 2848 ENDDO 2849 IF ( .NOT. neutral ) THEN 2850 DO i = nxl, nxr 2851 DO t = force%tind, force%tind_p 2852 CALL get_variable_bc( id_dynamic, & 2853 'ls_forcing_north_pt', & 2854 t+1, & 2855 nzb+1, nzt+1-(nzb+1)+1, & 2856 i+1, 1, & 2857 force%pt_north(t-force%tind,nzb+1:nzt+1,i) ) 2858 ENDDO 2859 ENDDO 2860 ENDIF 2861 IF ( humidity ) THEN 2862 DO i = nxl, nxr 2863 DO t = force%tind, force%tind_p 2864 CALL get_variable_bc( id_dynamic, & 2865 'ls_forcing_north_qv', & 2866 t+1, & 2867 nzb+1, nzt+1-(nzb+1)+1, & 2868 i+1, 1, & 2869 force%q_north(t-force%tind,nzb+1:nzt+1,i) ) 2870 ENDDO 2871 ENDDO 2872 ENDIF 2873 ENDIF 2874 2875 IF ( force_bound_s ) THEN 2876 DO i = nxlu, nxr 2877 DO t = force%tind, force%tind_p 2878 CALL get_variable_bc( id_dynamic, 'ls_forcing_south_u', & 2879 t+1, & 2880 nzb+1, nzt+1-(nzb+1)+1, & 2881 i, 1, & 2882 force%u_south(t-force%tind,nzb+1:nzt+1,i) ) 2883 ENDDO 2884 ENDDO 2885 DO i = nxl, nxr 2886 DO t = force%tind, force%tind_p 2887 CALL get_variable_bc( id_dynamic, 'ls_forcing_south_v', & 2888 t+1, & 2889 nzb+1, nzt+1-(nzb+1)+1, & 2890 i+1, 1, & 2891 force%v_south(t-force%tind,nzb+1:nzt+1,i) ) 2892 ENDDO 2893 ENDDO 2894 DO i = nxl, nxr 2895 DO t = force%tind, force%tind_p 2896 CALL get_variable_bc( id_dynamic, 'ls_forcing_south_w', & 2897 t+1, & 2898 nzb+1, nzt-(nzb+1)+1, & 2899 i+1, 1, & 2900 force%w_south(t-force%tind,nzb+1:nzt,i) ) 2901 ENDDO 2902 ENDDO 2903 IF ( .NOT. neutral ) THEN 2904 DO i = nxl, nxr 2905 DO t = force%tind, force%tind_p 2906 CALL get_variable_bc( id_dynamic, & 2907 'ls_forcing_south_pt', & 2908 t+1, & 2909 nzb+1, nzt+1-(nzb+1)+1, & 2910 i+1, 1, & 2911 force%pt_south(t-force%tind,nzb+1:nzt+1,i) ) 2912 ENDDO 2913 ENDDO 2914 ENDIF 2915 IF ( humidity ) THEN 2916 DO i = nxl, nxr 2917 DO t = force%tind, force%tind_p 2918 CALL get_variable_bc( id_dynamic, & 2919 'ls_forcing_south_qv', & 2920 t+1, & 2921 nzb+1, nzt+1-(nzb+1)+1, & 2922 i+1, 1, & 2923 force%q_south(t-force%tind,nzb+1:nzt+1,i) ) 2924 ENDDO 2925 ENDDO 2926 ENDIF 2927 ENDIF 2928 ! 2929 !-- Top boundary 2930 DO i = nxlu, nxr 2931 DO t = force%tind, force%tind_p 2932 CALL get_variable_bc( id_dynamic, 'ls_forcing_top_u', & 2933 t+1, & 2934 nys+1, nyn-nys+1, & 2935 i, 1, & 2936 force%u_top(t-force%tind,nys:nyn,i) ) 2937 ENDDO 2938 ENDDO 2939 DO i = nxl, nxr 2940 DO t = force%tind, force%tind_p 2941 CALL get_variable_bc( id_dynamic, 'ls_forcing_top_v', & 2942 t+1, & 2943 nysv, nyn-nysv+1, & 2944 i+1, 1, & 2945 force%v_top(t-force%tind,nysv:nyn,i) ) 2946 ENDDO 2947 ENDDO 2948 DO i = nxl, nxr 2949 DO t = force%tind, force%tind_p 2950 CALL get_variable_bc( id_dynamic, 'ls_forcing_top_w', & 2951 t+1, & 2952 nys+1, nyn-nys+1, & 2953 i+1, 1, & 2954 force%w_top(t-force%tind,nys:nyn,i) ) 2955 ENDDO 2956 ENDDO 2957 IF ( .NOT. neutral ) THEN 2958 DO i = nxl, nxr 2959 DO t = force%tind, force%tind_p 2960 CALL get_variable_bc( id_dynamic, 'ls_forcing_top_pt', & 2961 t+1, & 2962 nys+1, nyn-nys+1, & 2963 i+1, 1, & 2964 force%pt_top(t-force%tind,nys:nyn,i) ) 2965 ENDDO 2966 ENDDO 2967 ENDIF 2968 IF ( humidity ) THEN 2969 DO i = nxl, nxr 2970 DO t = force%tind, force%tind_p 2971 CALL get_variable_bc( id_dynamic, 'ls_forcing_top_qv', & 2972 t+1, & 2973 nys+1, nyn-nys+1, & 2974 i+1, 1, & 2975 force%q_top(t-force%tind,nys:nyn,i) ) 2976 ENDDO 2977 ENDDO 2978 ENDIF 2979 2980 ! 2981 !-- Close input file 2982 CALL close_input_file( id_dynamic ) 2541 !-- Open file in read-only mode 2542 CALL open_read_file( TRIM( input_file_dynamic ) // & 2543 TRIM( coupling_char ), id_dynamic ) 2544 ! 2545 !-- Initialize INIFOR forcing. 2546 IF ( .NOT. force%init ) THEN 2547 ! 2548 !-- At first, inquire all variable names. 2549 CALL inquire_num_variables( id_dynamic, num_vars ) 2550 ! 2551 !-- Allocate memory to store variable names. 2552 ALLOCATE( force%var_names(1:num_vars) ) 2553 CALL inquire_variable_names( id_dynamic, force%var_names ) 2554 ! 2555 !-- Read time dimension, allocate memory and finally read time array 2556 CALL get_dimension_length( id_dynamic, force%nt, 'time' ) 2557 2558 IF ( check_existence( force%var_names, 'time' ) ) THEN 2559 ALLOCATE( force%time(0:force%nt-1) ) 2560 CALL get_variable( id_dynamic, 'time', force%time ) 2561 ENDIF 2562 ! 2563 !-- Read vertical dimension of scalar und w grid 2564 CALL get_dimension_length( id_dynamic, force%nzu, 'z' ) 2565 CALL get_dimension_length( id_dynamic, force%nzw, 'zw' ) 2566 2567 IF ( check_existence( force%var_names, 'z' ) ) THEN 2568 ALLOCATE( force%zu_atmos(1:force%nzu) ) 2569 CALL get_variable( id_dynamic, 'z', force%zu_atmos ) 2570 ENDIF 2571 IF ( check_existence( force%var_names, 'zw' ) ) THEN 2572 ALLOCATE( force%zw_atmos(1:force%nzw) ) 2573 CALL get_variable( id_dynamic, 'zw', force%zw_atmos ) 2574 ENDIF 2575 2576 ! 2577 !-- Read surface pressure 2578 IF ( check_existence( force%var_names, & 2579 'surface_forcing_surface_pressure' ) ) THEN 2580 ALLOCATE( force%surface_pressure(0:force%nt-1) ) 2581 CALL get_variable( id_dynamic, & 2582 'surface_forcing_surface_pressure', & 2583 force%surface_pressure ) 2584 ENDIF 2585 ! 2586 !-- Set control flag to indicate that initialization is already done 2587 force%init = .TRUE. 2588 2589 ENDIF 2590 2591 ! 2592 !-- Obtain time index for current input starting at 0. 2593 !-- @todo: At the moment time, in INIFOR and simulated time correspond 2594 !-- to each other. If required, adjust to daytime. 2595 force%tind = MINLOC( ABS( force%time - simulated_time ), DIM = 1 ) & 2596 - 1 2597 force%tind_p = force%tind + 1 2598 ! 2599 !-- Read geostrophic wind components. In case of forcing, this is only 2600 !-- required if cyclic boundary conditions are applied. 2601 IF ( bc_lr_cyc .AND. bc_ns_cyc ) THEN 2602 DO t = force%tind, force%tind_p 2603 ! CALL get_variable_pr( id_dynamic, 'tend_ug', t+1, & 2604 ! force%ug(t-force%tind,:) ) 2605 ! CALL get_variable_pr( id_dynamic, 'tend_vg', t+1, & 2606 ! force%ug(t-force%tind,:) ) 2607 CALL get_variable_pr( id_dynamic, 'ls_forcing_ug', t+1, & 2608 force%ug(t-force%tind,:) ) 2609 CALL get_variable_pr( id_dynamic, 'ls_forcing_vg', t+1, & 2610 force%ug(t-force%tind,:) ) 2611 ENDDO 2612 ENDIF 2613 ! 2614 !-- Read data at lateral and top boundaries. Please note, at left and 2615 !-- right domain boundary, yz-layers are read for u, v, w, pt and q. 2616 !-- For the v-component, the data starts at nysv, while for the other 2617 !-- quantities the data starts at nys. This is equivalent at the north 2618 !-- and south domain boundary for the u-component. 2619 IF ( force_bound_l ) THEN 2620 CALL get_variable( id_dynamic, 'ls_forcing_left_u', & 2621 force%u_left(0:1,nzb+1:nzt+1,nys:nyn), & 2622 nys+1, nzb+1, force%tind+1, & 2623 nyn-nys+1, force%nzu, 2, dynamic_3d ) 2624 2625 CALL get_variable( id_dynamic, 'ls_forcing_left_v', & 2626 force%v_left(0:1,nzb+1:nzt+1,nysv:nyn), & 2627 nysv, nzb+1, force%tind+1, & 2628 nyn-nysv+1, force%nzu, 2, dynamic_3d ) 2629 2630 CALL get_variable( id_dynamic, 'ls_forcing_left_w', & 2631 force%w_left(0:1,nzb+1:nzt,nys:nyn), & 2632 nys+1, nzb+1, force%tind+1, & 2633 nyn-nys+1, force%nzw, 2, dynamic_3d ) 2634 2635 IF ( .NOT. neutral ) THEN 2636 CALL get_variable( id_dynamic, 'ls_forcing_left_pt', & 2637 force%pt_left(0:1,nzb+1:nzt+1,nys:nyn), & 2638 nys+1, nzb+1, force%tind+1, & 2639 nyn-nys+1, force%nzu, 2, dynamic_3d ) 2640 ENDIF 2641 IF ( humidity ) THEN 2642 CALL get_variable( id_dynamic, 'ls_forcing_left_qv', & 2643 force%q_left(0:1,nzb+1:nzt+1,nys:nyn), & 2644 nys+1, nzb+1, force%tind+1, & 2645 nyn-nys+1, force%nzu, 2, dynamic_3d ) 2646 ENDIF 2647 ENDIF 2648 2649 IF ( force_bound_r ) THEN 2650 CALL get_variable( id_dynamic, 'ls_forcing_right_u', & 2651 force%u_right(0:1,nzb+1:nzt+1,nys:nyn), & 2652 nys+1, nzb+1, force%tind+1, & 2653 nyn-nys+1, force%nzu, 2, dynamic_3d ) 2654 2655 CALL get_variable( id_dynamic, 'ls_forcing_right_v', & 2656 force%v_right(0:1,nzb+1:nzt+1,nysv:nyn), & 2657 nysv, nzb+1, force%tind+1, & 2658 nyn-nysv+1, force%nzu, 2, dynamic_3d ) 2659 2660 CALL get_variable( id_dynamic, 'ls_forcing_right_w', & 2661 force%w_right(0:1,nzb+1:nzt,nys:nyn), & 2662 nys+1, nzb+1, force%tind+1, & 2663 nyn-nys+1, force%nzw, 2, dynamic_3d ) 2664 2665 IF ( .NOT. neutral ) THEN 2666 CALL get_variable( id_dynamic, 'ls_forcing_right_pt', & 2667 force%pt_right(0:1,nzb+1:nzt+1,nys:nyn), & 2668 nys+1, nzb+1, force%tind+1, & 2669 nyn-nys+1, force%nzu, 2, dynamic_3d ) 2670 ENDIF 2671 IF ( humidity ) THEN 2672 CALL get_variable( id_dynamic, 'ls_forcing_right_qv', & 2673 force%q_right(0:1,nzb+1:nzt+1,nys:nyn), & 2674 nys+1, nzb+1, force%tind+1, & 2675 nyn-nys+1, force%nzu, 2, dynamic_3d ) 2676 ENDIF 2677 ENDIF 2678 2679 IF ( force_bound_n ) THEN 2680 2681 CALL get_variable( id_dynamic, 'ls_forcing_north_u', & 2682 force%u_north(0:1,nzb+1:nzt+1,nxlu:nxr), & 2683 nxlu, nzb+1, force%tind+1, & 2684 nxr-nxlu+1, force%nzu, 2, dynamic_3d ) 2685 2686 CALL get_variable( id_dynamic, 'ls_forcing_north_v', & 2687 force%v_north(0:1,nzb+1:nzt+1,nxl:nxr), & 2688 nxl+1, nzb+1, force%tind+1, & 2689 nxr-nxl+1, force%nzu, 2, dynamic_3d ) 2690 2691 CALL get_variable( id_dynamic, 'ls_forcing_north_w', & 2692 force%w_north(0:1,nzb+1:nzt,nxl:nxr), & 2693 nxl+1, nzb+1, force%tind+1, & 2694 nxr-nxl+1, force%nzw, 2, dynamic_3d ) 2695 2696 IF ( .NOT. neutral ) THEN 2697 CALL get_variable( id_dynamic, 'ls_forcing_north_pt', & 2698 force%pt_north(0:1,nzb+1:nzt+1,nxl:nxr), & 2699 nxl+1, nzb+1, force%tind+1, & 2700 nxr-nxl+1, force%nzu, 2, dynamic_3d ) 2701 ENDIF 2702 IF ( humidity ) THEN 2703 CALL get_variable( id_dynamic, 'ls_forcing_north_qv', & 2704 force%q_north(0:1,nzb+1:nzt+1,nxl:nxr), & 2705 nxl+1, nzb+1, force%tind+1, & 2706 nxr-nxl+1, force%nzu, 2, dynamic_3d ) 2707 ENDIF 2708 ENDIF 2709 2710 IF ( force_bound_s ) THEN 2711 CALL get_variable( id_dynamic, 'ls_forcing_south_u', & 2712 force%u_south(0:1,nzb+1:nzt+1,nxlu:nxr), & 2713 nxlu, nzb+1, force%tind+1, & 2714 nxr-nxlu+1, force%nzu, 2, dynamic_3d ) 2715 2716 CALL get_variable( id_dynamic, 'ls_forcing_south_v', & 2717 force%v_south(0:1,nzb+1:nzt+1,nxl:nxr), & 2718 nxl+1, nzb+1, force%tind+1, & 2719 nxr-nxl+1, force%nzu, 2, dynamic_3d ) 2720 2721 CALL get_variable( id_dynamic, 'ls_forcing_south_w', & 2722 force%w_south(0:1,nzb+1:nzt,nxl:nxr), & 2723 nxl+1, nzb+1, force%tind+1, & 2724 nxr-nxl+1, force%nzw, 2, dynamic_3d ) 2725 2726 IF ( .NOT. neutral ) THEN 2727 CALL get_variable( id_dynamic, 'ls_forcing_south_pt', & 2728 force%pt_south(0:1,nzb+1:nzt+1,nxl:nxr), & 2729 nxl+1, nzb+1, force%tind+1, & 2730 nxr-nxl+1, force%nzu, 2, dynamic_3d ) 2731 ENDIF 2732 IF ( humidity ) THEN 2733 CALL get_variable( id_dynamic, 'ls_forcing_south_qv', & 2734 force%q_south(0:1,nzb+1:nzt+1,nxl:nxr), & 2735 nxl+1, nzb+1, force%tind+1, & 2736 nxr-nxl+1, force%nzu, 2, dynamic_3d ) 2737 ENDIF 2738 ENDIF 2739 ! 2740 !-- Top boundary 2741 CALL get_variable( id_dynamic, 'ls_forcing_top_u', & 2742 force%u_top(0:1,nys:nyn,nxlu:nxr), & 2743 nxlu, nys+1, force%tind+1, & 2744 nxr-nxlu+1, nyn-nys+1, 2, dynamic_3d ) 2745 2746 CALL get_variable( id_dynamic, 'ls_forcing_top_v', & 2747 force%v_top(0:1,nysv:nyn,nxl:nxr), & 2748 nxl+1, nysv, force%tind+1, & 2749 nxr-nxl+1, nyn-nysv+1, 2, dynamic_3d ) 2750 2751 CALL get_variable( id_dynamic, 'ls_forcing_top_w', & 2752 force%w_top(0:1,nys:nyn,nxl:nxr), & 2753 nxl+1, nys+1, force%tind+1, & 2754 nxr-nxl+1, nyn-nys+1, 2, dynamic_3d ) 2755 2756 IF ( .NOT. neutral ) THEN 2757 CALL get_variable( id_dynamic, 'ls_forcing_top_pt', & 2758 force%pt_top(0:1,nys:nyn,nxl:nxr), & 2759 nxl+1, nys+1, force%tind+1, & 2760 nxr-nxl+1, nyn-nys+1, 2, dynamic_3d ) 2761 ENDIF 2762 IF ( humidity ) THEN 2763 CALL get_variable( id_dynamic, 'ls_forcing_top_qv', & 2764 force%q_top(0:1,nys:nyn,nxl:nxr), & 2765 nxl+1, nys+1, force%tind+1, & 2766 nxr-nxl+1, nyn-nys+1, 2, dynamic_3d ) 2767 ENDIF 2768 2769 ! 2770 !-- Close input file 2771 CALL close_input_file( id_dynamic ) 2983 2772 #endif 2984 ENDIF2985 #if defined( __parallel )2986 CALL MPI_BARRIER( comm2d, ierr )2987 #endif2988 ENDDO2989 2990 2773 ! 2991 2774 !-- End of CPU measurement … … 3874 3657 3875 3658 nc_stat = NF90_CLOSE( id ) 3876 CALL handle_error( 'close', 5 37)3659 CALL handle_error( 'close', 540 ) 3877 3660 #endif 3878 3661 END SUBROUTINE close_input_file … … 3901 3684 nc_stat = NF90_OPEN( filename, NF90_NOWRITE, id ) 3902 3685 collective_read = .FALSE. 3903 write(9,*) 'open ',TRIM(filename),' as serial NetCDF file on every PE'3904 3686 ELSE 3905 3687 collective_read = .TRUE. 3906 write(9,*) 'open ',TRIM(filename),' using parallel NetCDF'3907 3688 END IF 3908 3689 #else … … 3911 3692 #endif 3912 3693 3913 CALL handle_error( 'open_read_file', 53 6)3694 CALL handle_error( 'open_read_file', 539 ) 3914 3695 3915 3696 #endif … … 3942 3723 IF ( global ) THEN 3943 3724 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 3944 CALL handle_error( 'get_attribute_int32 global', 522 )3725 CALL handle_error( 'get_attribute_int32 global', 522, attribute_name ) 3945 3726 ! 3946 3727 !-- Read attributes referring to a single variable. Therefore, first inquire … … 3948 3729 ELSE 3949 3730 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 3950 CALL handle_error( 'get_attribute_int32', 522 )3731 CALL handle_error( 'get_attribute_int32', 522, attribute_name ) 3951 3732 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 3952 CALL handle_error( 'get_attribute_int32', 522 )3733 CALL handle_error( 'get_attribute_int32', 522, attribute_name ) 3953 3734 ENDIF 3954 3735 #endif … … 3981 3762 IF ( global ) THEN 3982 3763 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 3983 CALL handle_error( 'get_attribute_int8 global', 523 )3764 CALL handle_error( 'get_attribute_int8 global', 523, attribute_name ) 3984 3765 ! 3985 3766 !-- Read attributes referring to a single variable. Therefore, first inquire … … 3987 3768 ELSE 3988 3769 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 3989 CALL handle_error( 'get_attribute_int8', 523 )3770 CALL handle_error( 'get_attribute_int8', 523, attribute_name ) 3990 3771 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 3991 CALL handle_error( 'get_attribute_int8', 523 )3772 CALL handle_error( 'get_attribute_int8', 523, attribute_name ) 3992 3773 ENDIF 3993 3774 #endif … … 4022 3803 IF ( global ) THEN 4023 3804 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 4024 CALL handle_error( 'get_attribute_real global', 524 )3805 CALL handle_error( 'get_attribute_real global', 524, attribute_name ) 4025 3806 ! 4026 3807 !-- Read attributes referring to a single variable. Therefore, first inquire … … 4028 3809 ELSE 4029 3810 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4030 CALL handle_error( 'get_attribute_real', 524 )3811 CALL handle_error( 'get_attribute_real', 524, attribute_name ) 4031 3812 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 4032 CALL handle_error( 'get_attribute_real', 524 )3813 CALL handle_error( 'get_attribute_real', 524, attribute_name ) 4033 3814 ENDIF 4034 3815 #endif … … 4063 3844 IF ( global ) THEN 4064 3845 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 4065 CALL handle_error( 'get_attribute_string global', 525 )3846 CALL handle_error( 'get_attribute_string global', 525, attribute_name ) 4066 3847 ! 4067 3848 !-- Read attributes referring to a single variable. Therefore, first inquire … … 4069 3850 ELSE 4070 3851 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4071 CALL handle_error( 'get_attribute_string', 525 )3852 CALL handle_error( 'get_attribute_string', 525, attribute_name ) 4072 3853 4073 3854 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 4074 CALL handle_error( 'get_attribute_string',525 )3855 CALL handle_error( 'get_attribute_string',525, attribute_name ) 4075 3856 4076 3857 ENDIF … … 4102 3883 !-- First, inquire dimension ID 4103 3884 nc_stat = NF90_INQ_DIMID( id, TRIM( variable_name ), id_dim ) 4104 CALL handle_error( 'get_dimension_length', 526 )3885 CALL handle_error( 'get_dimension_length', 526, variable_name ) 4105 3886 ! 4106 3887 !-- Inquire dimension length 4107 3888 nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim, dum, LEN = dim_len ) 4108 CALL handle_error( 'get_dimension_length', 526 )3889 CALL handle_error( 'get_dimension_length', 526, variable_name ) 4109 3890 4110 3891 #endif … … 4133 3914 !-- First, inquire variable ID 4134 3915 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4135 CALL handle_error( 'get_variable_1d_int', 527 )3916 CALL handle_error( 'get_variable_1d_int', 527, variable_name ) 4136 3917 ! 4137 3918 !-- Inquire dimension length 4138 3919 nc_stat = NF90_GET_VAR( id, id_var, var ) 4139 CALL handle_error( 'get_variable_1d_int', 527 )3920 CALL handle_error( 'get_variable_1d_int', 527, variable_name ) 4140 3921 4141 3922 #endif … … 4164 3945 !-- First, inquire variable ID 4165 3946 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4166 CALL handle_error( 'get_variable_1d_real', 52 7)3947 CALL handle_error( 'get_variable_1d_real', 528, variable_name ) 4167 3948 ! 4168 3949 !-- Inquire dimension length 4169 3950 nc_stat = NF90_GET_VAR( id, id_var, var ) 4170 CALL handle_error( 'get_variable_1d_real', 52 7)3951 CALL handle_error( 'get_variable_1d_real', 528, variable_name ) 4171 3952 4172 3953 #endif … … 4208 3989 start = (/ 1, t /), & 4209 3990 count = (/ n_file, 1 /) ) 4210 CALL handle_error( 'get_variable_pr', 52 7)3991 CALL handle_error( 'get_variable_pr', 529, variable_name ) 4211 3992 4212 3993 #endif … … 4220 4001 !> i.e. each core reads its own domain in slices along x. 4221 4002 !------------------------------------------------------------------------------! 4222 SUBROUTINE get_variable_2d_real( id, variable_name, i, var)4003 SUBROUTINE get_variable_2d_real( id, variable_name, var, is, ie, js, je ) 4223 4004 4224 4005 USE indices … … 4229 4010 CHARACTER(LEN=*) :: variable_name !< variable name 4230 4011 4231 INTEGER(iwp), INTENT(IN) :: i !< index along x direction 4012 INTEGER(iwp) :: i !< running index along x direction 4013 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4014 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4232 4015 INTEGER(iwp), INTENT(IN) :: id !< file id 4233 4016 INTEGER(iwp) :: id_var !< variable id 4234 4235 REAL(wp), DIMENSION(nys:nyn), INTENT(INOUT) :: var !< variable to be read 4017 INTEGER(iwp) :: j !< running index along y direction 4018 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4019 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4020 4021 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4022 !< to its reverse memory access 4023 REAL(wp), DIMENSION(:,:), INTENT(INOUT) :: var !< variable to be read 4236 4024 #if defined( __netcdf ) 4237 4025 ! … … 4239 4027 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4240 4028 ! 4029 !-- Check for collective read-operation and set respective NetCDF flags if 4030 !-- required. 4031 IF ( collective_read ) THEN 4032 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4033 ENDIF 4034 ! 4035 !-- Allocate temporary variable according to memory access on file. 4036 ALLOCATE( tmp(is:ie,js:je) ) 4037 ! 4241 4038 !-- Get variable 4242 nc_stat = NF90_GET_VAR( id, id_var, var(nys:nyn), & 4243 start = (/ i+1, nys+1 /), & 4244 count = (/ 1, nyn - nys + 1 /) ) 4245 4246 CALL handle_error( 'get_variable_2d_real', 528 ) 4039 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4040 start = (/ is+1, js+1 /), & 4041 count = (/ ie-is + 1, je-js+1 /) ) 4042 4043 CALL handle_error( 'get_variable_2d_real', 530, variable_name ) 4044 ! 4045 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4046 DO i = is, ie 4047 DO j = js, je 4048 var(j-js+1,i-is+1) = tmp(i,j) 4049 ENDDO 4050 ENDDO 4051 4052 DEALLOCATE( tmp ) 4053 4247 4054 #endif 4248 4055 END SUBROUTINE get_variable_2d_real … … 4254 4061 !> i.e. each core reads its own domain in slices along x. 4255 4062 !------------------------------------------------------------------------------! 4256 SUBROUTINE get_variable_2d_int32( id, variable_name, i, var)4063 SUBROUTINE get_variable_2d_int32( id, variable_name, var, is, ie, js, je ) 4257 4064 4258 4065 USE indices … … 4263 4070 CHARACTER(LEN=*) :: variable_name !< variable name 4264 4071 4265 INTEGER(iwp), INTENT(IN) :: i !< index along x direction 4072 INTEGER(iwp) :: i !< running index along x direction 4073 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4074 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4266 4075 INTEGER(iwp), INTENT(IN) :: id !< file id 4267 4076 INTEGER(iwp) :: id_var !< variable id 4268 INTEGER(iwp), DIMENSION(nys:nyn), INTENT(INOUT) :: var !< variable to be read 4077 INTEGER(iwp) :: j !< running index along y direction 4078 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4079 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4080 4081 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4082 !< to its reverse memory access 4083 INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) :: var !< variable to be read 4269 4084 #if defined( __netcdf ) 4270 4085 ! … … 4272 4087 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4273 4088 ! 4089 !-- Check for collective read-operation and set respective NetCDF flags if 4090 !-- required. 4091 IF ( collective_read ) THEN 4092 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4093 ENDIF 4094 ! 4095 !-- Allocate temporary variable according to memory access on file. 4096 ALLOCATE( tmp(is:ie,js:je) ) 4097 ! 4274 4098 !-- Get variable 4275 nc_stat = NF90_GET_VAR( id, id_var, var(nys:nyn), & 4276 start = (/ i+1, nys+1 /), & 4277 count = (/ 1, nyn - nys + 1 /) ) 4278 4279 CALL handle_error( 'get_variable_2d_int32', 529 ) 4099 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4100 start = (/ is+1, js+1 /), & 4101 count = (/ ie-is + 1, je-js+1 /) ) 4102 4103 CALL handle_error( 'get_variable_2d_int32', 531, variable_name ) 4104 ! 4105 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4106 DO i = is, ie 4107 DO j = js, je 4108 var(j-js+1,i-is+1) = tmp(i,j) 4109 ENDDO 4110 ENDDO 4111 4112 DEALLOCATE( tmp ) 4113 4280 4114 #endif 4281 4115 END SUBROUTINE get_variable_2d_int32 … … 4287 4121 !> i.e. each core reads its own domain in slices along x. 4288 4122 !------------------------------------------------------------------------------! 4289 SUBROUTINE get_variable_2d_int8( id, variable_name, i, var)4123 SUBROUTINE get_variable_2d_int8( id, variable_name, var, is, ie, js, je ) 4290 4124 4291 4125 USE indices … … 4296 4130 CHARACTER(LEN=*) :: variable_name !< variable name 4297 4131 4298 INTEGER(iwp), INTENT(IN) :: i !< index along x direction 4132 INTEGER(iwp) :: i !< running index along x direction 4133 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4134 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4299 4135 INTEGER(iwp), INTENT(IN) :: id !< file id 4300 4136 INTEGER(iwp) :: id_var !< variable id 4301 INTEGER(KIND=1), DIMENSION(nys:nyn), INTENT(INOUT) :: var !< variable to be read 4137 INTEGER(iwp) :: j !< running index along y direction 4138 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4139 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4140 4141 INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4142 !< to its reverse memory access 4143 INTEGER(KIND=1), DIMENSION(:,:), INTENT(INOUT) :: var !< variable to be read 4302 4144 #if defined( __netcdf ) 4303 4145 ! … … 4305 4147 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4306 4148 ! 4149 !-- Check for collective read-operation and set respective NetCDF flags if 4150 !-- required. 4151 IF ( collective_read ) THEN 4152 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4153 ENDIF 4154 ! 4155 !-- Allocate temporary variable according to memory access on file. 4156 ALLOCATE( tmp(is:ie,js:je) ) 4157 ! 4307 4158 !-- Get variable 4308 nc_stat = NF90_GET_VAR( id, id_var, var(nys:nyn), & 4309 start = (/ i+1, nys+1 /), & 4310 count = (/ 1, nyn - nys + 1 /) ) 4311 4312 CALL handle_error( 'get_variable_2d_int8', 530 ) 4159 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4160 start = (/ is+1, js+1 /), & 4161 count = (/ ie-is + 1, je-js+1 /) ) 4162 4163 CALL handle_error( 'get_variable_2d_int8', 532, variable_name ) 4164 ! 4165 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4166 DO i = is, ie 4167 DO j = js, je 4168 var(j-js+1,i-is+1) = tmp(i,j) 4169 ENDDO 4170 ENDDO 4171 4172 DEALLOCATE( tmp ) 4173 4313 4174 #endif 4314 4175 END SUBROUTINE get_variable_2d_int8 4176 4315 4177 4316 4178 !------------------------------------------------------------------------------! … … 4319 4181 !> Reads a 3D 8-bit INTEGER variable from file. 4320 4182 !------------------------------------------------------------------------------! 4321 SUBROUTINE get_variable_3d_int8( id, variable_name, i, j, var ) 4183 SUBROUTINE get_variable_3d_int8( id, variable_name, var, is, ie, js, je, & 4184 ks, ke ) 4322 4185 4323 4186 USE indices … … 4328 4191 CHARACTER(LEN=*) :: variable_name !< variable name 4329 4192 4330 INTEGER(iwp), INTENT(IN) :: i !< index along x direction 4193 INTEGER(iwp) :: i !< index along x direction 4194 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4195 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4331 4196 INTEGER(iwp), INTENT(IN) :: id !< file id 4332 4197 INTEGER(iwp) :: id_var !< variable id 4333 INTEGER(iwp), INTENT(IN) :: j !< index along y direction 4334 INTEGER(iwp) :: n_file !< number of data-points along 3rd dimension 4335 4336 INTEGER(iwp), DIMENSION(1:3) :: id_dim 4337 4338 INTEGER( KIND = 1 ), DIMENSION(nzb:nzt+1), INTENT(INOUT) :: var !< variable to be read 4198 INTEGER(iwp) :: j !< index along y direction 4199 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4200 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4201 INTEGER(iwp) :: k !< index along any 3rd dimension 4202 INTEGER(iwp) :: ke !< start index of 3rd dimension 4203 INTEGER(iwp) :: ks !< end index of 3rd dimension 4204 4205 INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4206 !< to its reverse memory access 4207 4208 INTEGER(KIND=1), DIMENSION(:,:,:), INTENT(INOUT) :: var !< variable to be read 4339 4209 #if defined( __netcdf ) 4340 4210 4341 4211 ! 4342 4212 !-- Inquire variable id 4343 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4344 ! 4345 !-- Get length of first dimension, required for the count parameter. 4346 !-- Therefore, first inquired dimension ids 4347 nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim ) 4348 nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(3), LEN = n_file ) 4213 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4214 ! 4215 !-- Check for collective read-operation and set respective NetCDF flags if 4216 !-- required. 4217 IF ( collective_read ) THEN 4218 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4219 ENDIF 4220 ! 4221 !-- Allocate temporary variable according to memory access on file. 4222 ALLOCATE( tmp(is:ie,js:je,ks:ke) ) 4349 4223 ! 4350 4224 !-- Get variable 4351 nc_stat = NF90_GET_VAR( id, id_var, var, & 4352 start = (/ i+1, j+1, 1 /), & 4353 count = (/ 1, 1, n_file /) ) 4354 4355 CALL handle_error( 'get_variable_3d_int8', 531 ) 4225 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4226 start = (/ is+1, js+1, ks+1 /), & 4227 count = (/ ie-is+1, je-js+1, ke-ks+1 /) ) 4228 4229 CALL handle_error( 'get_variable_3d_int8', 533, variable_name ) 4230 ! 4231 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4232 DO i = is, ie 4233 DO j = js, je 4234 DO k = ks, ke 4235 var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k) 4236 ENDDO 4237 ENDDO 4238 ENDDO 4239 4240 DEALLOCATE( tmp ) 4241 4356 4242 #endif 4357 4243 END SUBROUTINE get_variable_3d_int8 … … 4363 4249 !> Reads a 3D float variable from file. 4364 4250 !------------------------------------------------------------------------------! 4365 SUBROUTINE get_variable_3d_real( id, variable_name, i, j, var ) 4251 SUBROUTINE get_variable_3d_real( id, variable_name, var, is, ie, js, je, & 4252 ks, ke ) 4366 4253 4367 4254 USE indices … … 4372 4259 CHARACTER(LEN=*) :: variable_name !< variable name 4373 4260 4374 INTEGER(iwp), INTENT(IN) :: i !< index along x direction 4261 INTEGER(iwp) :: i !< index along x direction 4262 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4263 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4375 4264 INTEGER(iwp), INTENT(IN) :: id !< file id 4376 4265 INTEGER(iwp) :: id_var !< variable id 4377 INTEGER(iwp), INTENT(IN) :: j !< index along y direction 4378 INTEGER(iwp) :: n3 !< number of data-points along 3rd dimension 4379 4380 INTEGER(iwp), DIMENSION(3) :: id_dim 4381 4382 REAL(wp), DIMENSION(:), INTENT(INOUT) :: var !< variable to be read 4266 INTEGER(iwp) :: j !< index along y direction 4267 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4268 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4269 INTEGER(iwp) :: k !< index along any 3rd dimension 4270 INTEGER(iwp) :: ke !< start index of 3rd dimension 4271 INTEGER(iwp) :: ks !< end index of 3rd dimension 4272 4273 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4274 !< to its reverse memory access 4275 4276 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< variable to be read 4383 4277 #if defined( __netcdf ) 4384 4278 4385 4279 ! 4386 4280 !-- Inquire variable id 4387 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4388 ! 4389 !-- Get length of first dimension, required for the count parameter. 4390 !-- Therefore, first inquired dimension ids 4391 nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim ) 4392 nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(3), LEN = n3 ) 4281 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4282 ! 4283 !-- Check for collective read-operation and set respective NetCDF flags if 4284 !-- required. 4285 IF ( collective_read ) THEN 4286 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4287 ENDIF 4288 ! 4289 !-- Allocate temporary variable according to memory access on file. 4290 ALLOCATE( tmp(is:ie,js:je,ks:ke) ) 4393 4291 ! 4394 4292 !-- Get variable 4395 nc_stat = NF90_GET_VAR( id, id_var, var, & 4396 start = (/ i+1, j+1, 1 /), & 4397 count = (/ 1, 1, n3 /) ) 4398 4399 CALL handle_error( 'get_variable_3d_real', 532 ) 4293 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4294 start = (/ is+1, js+1, ks+1 /), & 4295 count = (/ ie-is+1, je-js+1, ke-ks+1 /) ) 4296 4297 CALL handle_error( 'get_variable_3d_real', 534, variable_name ) 4298 ! 4299 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4300 DO i = is, ie 4301 DO j = js, je 4302 DO k = ks, ke 4303 var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k) 4304 ENDDO 4305 ENDDO 4306 ENDDO 4307 4308 DEALLOCATE( tmp ) 4400 4309 4401 4310 #endif … … 4407 4316 !> Reads a 3D float array from file. 4408 4317 !------------------------------------------------------------------------------! 4409 SUBROUTINE get_variable_3d_real_v( id, variable_name, is, ie, js, je, var ) 4318 ! SUBROUTINE get_variable_3d_real_v( id, variable_name, is, ie, js, je, var ) 4319 ! 4320 ! USE indices 4321 ! USE pegrid 4322 ! 4323 ! IMPLICIT NONE 4324 ! 4325 ! CHARACTER(LEN=*) :: variable_name !< variable name 4326 ! 4327 ! INTEGER(iwp), INTENT(IN) :: is,ie !< index range along x direction 4328 ! INTEGER(iwp), INTENT(IN) :: id !< file id 4329 ! INTEGER(iwp) :: id_var !< variable id 4330 ! INTEGER(iwp), INTENT(IN) :: js,je !< index range along y direction 4331 ! INTEGER(iwp) :: n3 !< number of data-points along 3rd dimension 4332 ! 4333 ! INTEGER(iwp) :: i,j,k 4334 ! INTEGER(iwp), DIMENSION(3) :: id_dim 4335 ! 4336 ! REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< variable to be read 4337 ! #if defined( __netcdf ) 4338 ! ! 4339 ! !-- Inside the ...static NetCDF files, the array is stored as float. 4340 ! !-- Therefore single precision is sufficiant for the temporary array 4341 ! 4342 ! REAL(sp), DIMENSION(:,:,:), ALLOCATABLE :: tmp_var !< temporary array to read NetCDF data in i,j,k direction 4343 ! 4344 ! !kk Please check, if it is time consuming to do the inquire every time 4345 ! ! 4346 ! !-- Inquire variable id 4347 ! nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4348 ! ! 4349 ! !-- Get length of third dimension, required for the count parameter. 4350 ! !-- Therefore, first inquired dimension ids 4351 ! nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim ) 4352 ! nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(3), LEN = n3 ) 4353 ! 4354 ! ! 4355 ! !-- Check for collective read-operation and set respective NetCDF flags if 4356 ! !-- required. 4357 ! IF ( collective_read ) THEN 4358 ! nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4359 ! ENDIF 4360 ! 4361 ! ! 4362 ! !-- Allocate temporary array ro read NetCDF data in i,j,k direction 4363 ! 4364 ! ALLOCATE(tmp_var(is:ie,js:je,n3)) 4365 ! ! 4366 ! !-- Get variable 4367 ! !-- Read complete local 3-D array in oone call 4368 ! 4369 ! nc_stat = NF90_GET_VAR( id, id_var, tmp_var, & 4370 ! start = (/ is+1, js+1, 1 /), & 4371 ! count = (/ ie-is+1, je-js+1, n3 /) ) 4372 ! 4373 ! CALL handle_error( 'get_variable_3d_real', 532 ) 4374 ! 4375 ! ! 4376 ! !-- Resort data in k,j,i direction 4377 ! 4378 ! DO i=is,ie 4379 ! DO j=js,je 4380 ! DO K=1,n3 4381 ! var (k,j-js+1,i-is+1) = tmp_var(i,j,k) 4382 ! END DO 4383 ! END DO 4384 ! END DO 4385 ! 4386 ! DEALLOCATE(tmp_var) 4387 ! 4388 ! #endif 4389 ! END SUBROUTINE get_variable_3d_real_v 4390 4391 4392 !------------------------------------------------------------------------------! 4393 ! Description: 4394 ! ------------ 4395 !> Reads a 4D float variable from file. 4396 !------------------------------------------------------------------------------! 4397 SUBROUTINE get_variable_4d_real( id, variable_name, var, is, ie, js, je, & 4398 k1s, k1e, k2s, k2e ) 4410 4399 4411 4400 USE indices … … 4416 4405 CHARACTER(LEN=*) :: variable_name !< variable name 4417 4406 4418 INTEGER(iwp), INTENT(IN) :: is,ie !< index range along x direction 4407 INTEGER(iwp) :: i !< index along x direction 4408 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4409 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4419 4410 INTEGER(iwp), INTENT(IN) :: id !< file id 4420 4411 INTEGER(iwp) :: id_var !< variable id 4421 INTEGER(iwp), INTENT(IN) :: js,je !< index range along y direction 4422 INTEGER(iwp) :: n3 !< number of data-points along 3rd dimension 4423 4424 INTEGER(iwp) :: i,j,k 4425 INTEGER(iwp), DIMENSION(3) :: id_dim 4426 4427 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< variable to be read 4412 INTEGER(iwp) :: j !< index along y direction 4413 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4414 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4415 INTEGER(iwp) :: k1 !< index along 3rd direction 4416 INTEGER(iwp) :: k1e !< start index for 3rd dimension 4417 INTEGER(iwp) :: k1s !< end index for 3rd dimension 4418 INTEGER(iwp) :: k2 !< index along 4th direction 4419 INTEGER(iwp) :: k2e !< start index for 4th dimension 4420 INTEGER(iwp) :: k2s !< end index for 4th dimension 4421 4422 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4423 !< to its reverse memory access 4424 REAL(wp), DIMENSION(:,:,:,:), INTENT(INOUT) :: var !< variable to be read 4428 4425 #if defined( __netcdf ) 4429 ! 4430 !-- Inside the ...static NetCDF files, the array is stored as float. 4431 !-- Therefore single precision is sufficiant for the temporary array 4432 4433 REAL(sp), DIMENSION(:,:,:), ALLOCATABLE :: tmp_var !< temporary array to read NetCDF data in i,j,k direction 4434 4435 !kk Please check, if it is time consuming to do the inquire every time 4426 4436 4427 ! 4437 4428 !-- Inquire variable id 4438 4429 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4439 4430 ! 4440 !-- Get length of first dimension, required for the count parameter. 4441 !-- Therefore, first inquired dimension ids 4442 nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim ) 4443 nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(3), LEN = n3 ) 4444 4445 IF(collective_read) THEN 4431 !-- Check for collective read-operation and set respective NetCDF flags if 4432 !-- required. 4433 IF ( collective_read ) THEN 4446 4434 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4447 4435 ENDIF 4448 4449 ! 4450 !-- Allocate temporary array ro read NetCDF data in i,j,k direction 4451 4452 ALLOCATE(tmp_var(is:ie,js:je,n3)) 4436 ! 4437 !-- Allocate temporary variable according to memory access on file. 4438 ALLOCATE( tmp(is:ie,js:je,k1s:k1e,k2s:k2e) ) 4453 4439 ! 4454 4440 !-- Get variable 4455 !-- Read complete local 3-D array in oone call 4456 4457 nc_stat = NF90_GET_VAR( id, id_var, tmp_var, & 4458 start = (/ is+1, js+1, 1 /), & 4459 count = (/ ie-is+1, je-js+1, n3 /) ) 4460 4461 CALL handle_error( 'get_variable_3d_real', 532 ) 4462 4463 ! 4464 !-- Resort data in k,j,i direction 4465 4466 DO i=is,ie 4467 DO j=js,je 4468 DO K=1,n3 4469 var (k,j-js+1,i-is+1) = tmp_var(i,j,k) 4470 END DO 4471 END DO 4472 END DO 4473 4474 DEALLOCATE(tmp_var) 4475 4441 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4442 start = (/ is+1, js+1, k1s+1, k2s+1 /), & 4443 count = (/ ie-is+1, je-js+1, & 4444 k1e-k1s+1, k2e-k2s+1 /) ) 4445 4446 CALL handle_error( 'get_variable_4d_real', 535, variable_name ) 4447 ! 4448 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4449 DO i = is, ie 4450 DO j = js, je 4451 DO k1 = k1s, k1e 4452 DO k2 = k2s, k2e 4453 var(k2-k2s+1,k1-k1s+1,j-js+1,i-is+1) = tmp(i,j,k1,k2) 4454 ENDDO 4455 ENDDO 4456 ENDDO 4457 ENDDO 4458 4459 DEALLOCATE( tmp ) 4476 4460 #endif 4477 END SUBROUTINE get_variable_3d_real_v 4461 END SUBROUTINE get_variable_4d_real 4462 4478 4463 4479 4464 … … 4481 4466 ! Description: 4482 4467 ! ------------ 4483 !> Reads a 4D float variable from file. Note, in constrast to 3D versions, 4484 !> dimensions are already inquired and passed so that they are known here. 4485 !------------------------------------------------------------------------------! 4486 SUBROUTINE get_variable_4d_real( id, variable_name, i, j, var, n3, n4 ) 4487 4468 !> Reads a 3D float variables from dynamic driver, such as time-dependent xy-, 4469 !> xz- or yz-boundary data as well as 3D initialization data. Please note, 4470 !> the passed arguments are start indices and number of elements in each 4471 !> dimension, which is in contrast to the other 3d versions where start- and 4472 !> end indices are passed. The different handling of 3D dynamic variables is 4473 !> due to its asymmetry for the u- and v component. 4474 !------------------------------------------------------------------------------! 4475 SUBROUTINE get_variable_3d_real_dynamic( id, variable_name, var, & 4476 i1s, i2s, i3s, count_1, count_2, count_3, dynamic) 4477 4488 4478 USE indices 4489 4479 USE pegrid … … 4493 4483 CHARACTER(LEN=*) :: variable_name !< variable name 4494 4484 4495 INTEGER(iwp), INTENT(IN) :: i !< index along x direction 4485 LOGICAL :: dynamic !< additional flag just used to select correct overloaded routine from interface block 4486 4487 INTEGER(iwp) :: count_1 !< number of elements to be read along 1st dimension (with respect to file) 4488 INTEGER(iwp) :: count_2 !< number of elements to be read along 2nd dimension (with respect to file) 4489 INTEGER(iwp) :: count_3 !< number of elements to be read along 3rd dimension (with respect to file) 4490 INTEGER(iwp) :: i1 !< running index along 1st dimension on file 4491 INTEGER(iwp) :: i1s !< start index for subdomain input along 1st dimension (with respect to file) 4492 INTEGER(iwp) :: i2 !< running index along 2nd dimension on file 4493 INTEGER(iwp) :: i2s !< start index for subdomain input along 2nd dimension (with respect to file) 4494 INTEGER(iwp) :: i3 !< running index along 3rd dimension on file 4495 INTEGER(iwp) :: i3s !< start index of 3rd dimension, in dynamic file this is either time (2D boundary) or z (3D) 4496 4496 INTEGER(iwp), INTENT(IN) :: id !< file id 4497 4497 INTEGER(iwp) :: id_var !< variable id 4498 INTEGER(iwp), INTENT(IN) :: j !< index along y direction 4499 INTEGER(iwp), INTENT(IN) :: n3 !< number of data-points along 3rd dimension 4500 INTEGER(iwp), INTENT(IN) :: n4 !< number of data-points along 4th dimension 4501 4502 INTEGER(iwp), DIMENSION(3) :: id_dim 4503 4504 REAL(wp), DIMENSION(:,:), INTENT(INOUT) :: var !< variable to be read 4498 INTEGER(iwp) :: lb1 !< lower bound of 1st dimension (with respect to file) 4499 INTEGER(iwp) :: lb2 !< lower bound of 2nd dimension (with respect to file) 4500 INTEGER(iwp) :: lb3 !< lower bound of 3rd dimension (with respect to file) 4501 INTEGER(iwp) :: ub1 !< upper bound of 1st dimension (with respect to file) 4502 INTEGER(iwp) :: ub2 !< upper bound of 2nd dimension (with respect to file) 4503 INTEGER(iwp) :: ub3 !< upper bound of 3rd dimension (with respect to file) 4504 4505 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4506 !< to its reverse memory access 4507 4508 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< input variable 4509 4505 4510 #if defined( __netcdf ) 4506 4507 4511 ! 4508 4512 !-- Inquire variable id 4509 4513 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4510 4514 ! 4515 !-- Check for collective read-operation and set respective NetCDF flags if 4516 !-- required. 4517 IF ( collective_read ) THEN 4518 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4519 ENDIF 4520 ! 4521 !-- Allocate temporary variable according to memory access on file. 4522 !-- Therefore, determine dimension bounds of input array. 4523 lb1 = LBOUND(var,3) 4524 ub1 = UBOUND(var,3) 4525 lb2 = LBOUND(var,2) 4526 ub2 = UBOUND(var,2) 4527 lb3 = LBOUND(var,1) 4528 ub3 = UBOUND(var,1) 4529 ALLOCATE( tmp(lb1:ub1,lb2:ub2,lb3:ub3) ) 4530 ! 4511 4531 !-- Get variable 4512 nc_stat = NF90_GET_VAR( id, id_var, var, & 4513 start = (/ i+1, j+1, 1, 1 /), & 4514 count = (/ 1, 1, n3, n4 /) ) 4515 4516 CALL handle_error( 'get_variable_4d_real', 533 ) 4532 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4533 start = (/ i1s, i2s, i3s /), & 4534 count = (/ count_1, count_2, count_3 /) ) 4535 4536 CALL handle_error( 'get_variable_3d_real_dynamic', 536, variable_name ) 4537 ! 4538 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4539 DO i3 = lb3, ub3 4540 DO i2 = lb2, ub2 4541 DO i1 = lb1, ub1 4542 var(i3,i2,i1) = tmp(i1,i2,i3) 4543 ENDDO 4544 ENDDO 4545 ENDDO 4546 4547 DEALLOCATE( tmp ) 4517 4548 #endif 4518 END SUBROUTINE get_variable_4d_real 4519 4520 4521 4522 !------------------------------------------------------------------------------! 4523 ! Description: 4524 ! ------------ 4525 !> Reads a 3D float variable at left, right, north, south and top boundaries. 4526 !------------------------------------------------------------------------------! 4527 SUBROUTINE get_variable_bc( id, variable_name, t_start, & 4528 i2_s, count_2, i3_s, count_3, var ) 4529 4530 USE indices 4531 USE pegrid 4532 4533 IMPLICIT NONE 4534 4535 CHARACTER(LEN=*) :: variable_name !< variable name 4536 4537 INTEGER(iwp) :: count_2 !< number of elements in second dimension 4538 INTEGER(iwp) :: count_3 !< number of elements in third dimension (usually 1) 4539 INTEGER(iwp) :: i2_s !< start index of second dimension 4540 INTEGER(iwp) :: i3_s !< start index of third dimension 4541 INTEGER(iwp), INTENT(IN) :: id !< file id 4542 INTEGER(iwp) :: id_var !< variable id 4543 INTEGER(iwp) :: t_start !< start index at time dimension with respect to netcdf convention 4544 4545 REAL(wp), DIMENSION(:), INTENT(INOUT) :: var !< input variable 4546 #if defined( __netcdf ) 4547 4548 ! 4549 !-- Inquire variable id 4550 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4551 ! 4552 !-- Get variable 4553 nc_stat = NF90_GET_VAR( id, id_var, var, & 4554 start = (/ i3_s, i2_s, t_start /), & 4555 count = (/ count_3, count_2, 1 /) ) 4556 4557 CALL handle_error( 'get_variable_bc', 532 ) 4558 #endif 4559 END SUBROUTINE get_variable_bc 4549 END SUBROUTINE get_variable_3d_real_dynamic 4560 4550 4561 4551 … … 4578 4568 4579 4569 nc_stat = NF90_INQUIRE( id, NVARIABLES = num_vars ) 4580 CALL handle_error( 'inquire_num_variables', 53 4)4570 CALL handle_error( 'inquire_num_variables', 537 ) 4581 4571 4582 4572 #endif … … 4605 4595 ALLOCATE( varids(1:SIZE(var_names)) ) 4606 4596 nc_stat = NF90_INQ_VARIDS( id, NVARS = num_vars, VARIDS = varids ) 4607 CALL handle_error( 'inquire_variable_names', 53 5)4597 CALL handle_error( 'inquire_variable_names', 538 ) 4608 4598 4609 4599 DO i = 1, SIZE(var_names) 4610 4600 nc_stat = NF90_INQUIRE_VARIABLE( id, varids(i), NAME = var_names(i) ) 4611 CALL handle_error( 'inquire_variable_names', 53 5)4601 CALL handle_error( 'inquire_variable_names', 538 ) 4612 4602 ENDDO 4613 4603 … … 4621 4611 !> Prints out a text message corresponding to the current status. 4622 4612 !------------------------------------------------------------------------------! 4623 SUBROUTINE handle_error( routine_name, errno )4613 SUBROUTINE handle_error( routine_name, errno, name ) 4624 4614 4625 4615 USE control_parameters, & … … 4630 4620 CHARACTER(LEN=6) :: message_identifier 4631 4621 CHARACTER(LEN=*) :: routine_name 4622 CHARACTER(LEN=*), OPTIONAL :: name 4632 4623 4633 4624 INTEGER(iwp) :: errno 4634 4625 #if defined( __netcdf ) 4635 4626 4636 4627 IF ( nc_stat /= NF90_NOERR ) THEN 4637 4628 4638 4629 WRITE( message_identifier, '(''NC'',I4.4)' ) errno 4639 message_string = TRIM( NF90_STRERROR( nc_stat ) ) 4630 4631 IF ( PRESENT( name ) ) THEN 4632 message_string = "Problem reading attribute/variable - " // & 4633 TRIM(name) // ": " // & 4634 TRIM( NF90_STRERROR( nc_stat ) ) 4635 ELSE 4636 message_string = TRIM( NF90_STRERROR( nc_stat ) ) 4637 ENDIF 4640 4638 4641 4639 CALL message( routine_name, message_identifier, 2, 2, 0, 6, 1 ) -
palm/trunk/SOURCE/synthetic_turbulence_generator_mod.f90
r3049 r3051 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Error messages revised27 ! Bugfix in calculation of initial Reynolds-stress tensor. 28 28 ! 29 29 ! 3045 2018-05-28 07:55:41Z Giersch 30 ! Error message revised30 ! Error messages revised 31 31 ! 32 32 ! 3044 2018-05-25 10:59:41Z gronemeier … … 718 718 IF ( a22(k) > 0.0_wp ) THEN 719 719 a22(k) = SQRT( a22(k) ) 720 a32(k) = ( r32(k) - a21(k) * a31(k) ) / a22(k)721 720 ELSE 722 721 a22(k) = 0.0_wp 723 a32(k) = 0.0_wp724 722 ENDIF 725 723
Note: See TracChangeset
for help on using the changeset viewer.
