Changeset 3298 for palm/trunk/SOURCE/netcdf_data_input_mod.f90
- Timestamp:
- Oct 2, 2018 12:21:11 PM (6 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
netcdf_data_input_mod.f90 (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE
- Property svn:mergeinfo changed
-
palm/trunk/SOURCE/netcdf_data_input_mod.f90
r3257 r3298 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Modified EXPERT mode to PRE-PROCESSED mode (Russo) 28 ! Introduced Chemistry static netcdf file (Russo) 29 ! Added the routine for reading-in netcdf data for chemistry (Russo) 30 ! Added routines to get_variable interface specific for chemistry files (Russo) 31 ! 32 ! 3257 2018-09-17 17:11:46Z suehring 27 33 ! Adjust checks for building_type and building_id, which is necessary after 28 34 ! topography filtering (building_type and id can be modified by the filtering). … … 189 195 !> Modulue contains routines to input data according to Palm input data 190 196 !> standart using dynamic and static input files. 191 !> 197 !> @todo - Review Reading of netcdf files for chemistry 192 198 !> @todo - Order input alphabetically 193 199 !> @todo - Revise error messages and error numbers … … 341 347 342 348 END TYPE init_type 349 350 !-- Data type for the general information of chemistry emissions, do not dependent on the particular chemical species 351 TYPE chem_emis_att_type 352 353 !-DIMENSIONS 354 INTEGER(iwp) :: nspec !< number of chem species for which emission values are provided 355 INTEGER(iwp) :: ncat !< number of emission categories 356 INTEGER(iwp) :: nvoc !< number of VOCs components 357 INTEGER(iwp) :: npm !< number of PMs components 358 INTEGER(iwp) :: nnox=2 !< number of NOx components: NO and NO2 359 INTEGER(iwp) :: nsox=2 !< number of SOx components: SO and SO4 360 INTEGER(iwp) :: nhoursyear !< number of hours of a specific year in the HOURLY mode 361 ! of the default mode 362 INTEGER(iwp) :: nmonthdayhour !< number of month days and hours in the MDH mode 363 ! of the default mode 364 INTEGER(iwp) :: dt_emission !< Number of emissions timesteps for one year 365 ! in the pre-processed emissions case 366 !-- 1d emission input variables 367 CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: pm_name !< Names of PMs components 368 CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: cat_name !< Emission categories names 369 CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: species_name !< Names of emission chemical species 370 CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: voc_name !< Names of VOCs components 371 CHARACTER (LEN=25) :: units !< Units 372 373 INTEGER(iwp) :: i_hour !< indices for assigning the emission values at different timesteps 374 INTEGER(iwp),ALLOCATABLE, DIMENSION(:) :: cat_index !< Index of emission categories 375 INTEGER(iwp),ALLOCATABLE, DIMENSION(:) :: species_index !< Index of emission chem species 376 377 REAL(wp), DIMENSION(24) :: par_emis_time_factor !< time factors 378 ! for the parameterized mode: these are fixed for each hour 379 ! of a single day. 380 REAL(wp),ALLOCATABLE, DIMENSION(:) :: xm !< Molecular masses of emission chem species 381 382 !-- 2d emission input variables 383 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: hourly_emis_time_factor !< Time factors for HOURLY emissions (DEFAULT mode) 384 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: mdh_emis_time_factor !< Time factors for MDH emissions (DEFAULT mode) 385 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: nox_comp !< Composition of NO and NO2 386 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: sox_comp !< Composition of SO2 and SO4 387 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: voc_comp !< Composition of different VOC components (number not fixed) 388 389 !-- 3d emission input variables 390 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: pm_comp !< Composition of different PMs components (number not fixed) 391 392 END TYPE chem_emis_att_type 393 394 395 !-- Data type for the values of chemistry emissions ERUSSO 396 TYPE chem_emis_val_type 397 398 !REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: stack_height !< stack height 399 400 !-- 3d emission input variables 401 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: default_emission_data !< Input Values emissions DEFAULT mode 402 403 !-- 4d emission input variables 404 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:,:) :: preproc_emission_data !< Input Values emissions PRE-PROCESSED mode 405 406 END TYPE chem_emis_val_type 343 407 344 408 ! … … 546 610 TYPE(pars) :: water_pars_f !< input variable for water parameters 547 611 612 TYPE(chem_emis_att_type) :: chem_emis_att !< Input Information of Chemistry Emission Data from netcdf 613 TYPE(chem_emis_val_type), ALLOCATABLE, DIMENSION(:) :: chem_emis !< Input Chemistry Emission Data from netcdf 548 614 549 615 CHARACTER(LEN=3) :: char_lod = 'lod' !< name of level-of-detail attribute in NetCDF file … … 553 619 CHARACTER(LEN=100) :: input_file_static = 'PIDS_STATIC' !< Name of file which comprises static input data 554 620 CHARACTER(LEN=100) :: input_file_dynamic = 'PIDS_DYNAMIC' !< Name of file which comprises dynamic input data 621 CHARACTER(LEN=100) :: input_file_chem = 'PIDS_CHEM' !< Name of file which comprises chemistry input data 622 623 CHARACTER (LEN=25), ALLOCATABLE, DIMENSION(:) :: string_values !< output of string variables read from netcdf input files 624 625 INTEGER(iwp) :: id_emis !< NetCDF id of input file for chemistry emissions: TBD: It has to be removed 555 626 556 627 INTEGER(iwp) :: nc_stat !< return value of nf90 function call … … 558 629 LOGICAL :: input_pids_static = .FALSE. !< Flag indicating whether Palm-input-data-standard file containing static information exists 559 630 LOGICAL :: input_pids_dynamic = .FALSE. !< Flag indicating whether Palm-input-data-standard file containing dynamic information exists 631 LOGICAL :: input_pids_chem = .FALSE. !< Flag indicating whether Palm-input-data-standard file containing chemistry information exists 560 632 561 633 LOGICAL :: collective_read = .FALSE. !< Enable NetCDF collective read … … 581 653 MODULE PROCEDURE netcdf_data_input_check_static 582 654 END INTERFACE netcdf_data_input_check_static 655 656 INTERFACE netcdf_data_input_chemistry_data 657 MODULE PROCEDURE netcdf_data_input_chemistry_data 658 END INTERFACE netcdf_data_input_chemistry_data 583 659 584 660 INTERFACE netcdf_data_input_inquire_file … … 611 687 612 688 INTERFACE get_variable 689 MODULE PROCEDURE get_variable_string 613 690 MODULE PROCEDURE get_variable_1d_int 614 691 MODULE PROCEDURE get_variable_1d_real … … 619 696 MODULE PROCEDURE get_variable_3d_real 620 697 MODULE PROCEDURE get_variable_3d_real_dynamic 698 MODULE PROCEDURE get_variable_4d_to_3d_real 621 699 MODULE PROCEDURE get_variable_4d_real 700 MODULE PROCEDURE get_variable_5d_to_4d_real 622 701 END INTERFACE get_variable 623 702 … … 636 715 !-- Public variables 637 716 PUBLIC albedo_pars_f, albedo_type_f, basal_area_density_f, buildings_f, & 638 building_id_f, building_pars_f, building_type_f, init_3d, & 639 init_model, input_file_static, input_pids_static, & 717 building_id_f, building_pars_f, building_type_f, & 718 chem_emis, chem_emis_att, chem_emis_att_type, chem_emis_val_type, & 719 init_3d, init_model, input_file_static, input_pids_static, & 640 720 input_pids_dynamic, leaf_area_density_f, nest_offl, & 641 721 pavement_pars_f, pavement_subsurface_pars_f, pavement_type_f, & … … 648 728 !-- Public subroutines 649 729 PUBLIC netcdf_data_input_check_dynamic, netcdf_data_input_check_static, & 650 netcdf_data_input_ inquire_file, &730 netcdf_data_input_chemistry_data, netcdf_data_input_inquire_file, & 651 731 netcdf_data_input_init, netcdf_data_input_init_lsm, & 652 732 netcdf_data_input_init_3d, & … … 674 754 INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), & 675 755 EXIST = input_pids_dynamic ) 756 INQUIRE( FILE = TRIM( input_file_chem ) // TRIM( coupling_char ), & 757 EXIST = input_pids_chem ) 758 676 759 #endif 677 760 … … 756 839 757 840 END SUBROUTINE netcdf_data_input_init 841 842 !------------------------------------------------------------------------------! 843 ! Description: 844 ! ------------ 845 !> Reads Chemistry NETCDF Input data, such as emission values, emission species, etc. . 846 !------------------------------------------------------------------------------! 847 SUBROUTINE netcdf_data_input_chemistry_data(emt_att,emt) 848 849 USE chem_modules, & 850 ONLY: do_emis, mode_emis, time_fac_type, & 851 surface_csflux_name 852 853 USE control_parameters, & 854 ONLY: message_string 855 856 USE indices, & 857 ONLY: nz, nx, ny, nxl, nxr, nys, nyn, nzb, nzt 858 859 IMPLICIT NONE 860 861 TYPE(chem_emis_att_type), INTENT(INOUT) :: emt_att 862 TYPE(chem_emis_val_type), ALLOCATABLE, DIMENSION(:), INTENT(INOUT) :: emt 863 864 CHARACTER (LEN=80) :: units='' !< units of chemistry inputs 865 866 INTEGER(iwp) :: ispec !< index for number of emission species in input 867 868 INTEGER(iwp), ALLOCATABLE, DIMENSION(:) :: dum_var !< value of variable read from netcdf input 869 INTEGER(iwp) :: errno !< error number NF90_???? function 870 INTEGER(iwp) :: id_var !< variable id 871 ! INTEGER(iwp) :: id_emis !< NetCDF id of input file 872 INTEGER(iwp) :: num_vars !< number of variables in netcdf input file 873 INTEGER(iwp) :: len_dims,len_dims_2 !< Length of dimensions 874 875 INTEGER(iwp) :: max_string_length=25 !< Variable for the maximum length of a string 876 877 CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< Name of Variables 878 879 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: dum_var_3d !< variable for storing temporary data of 3-dimensional 880 ! variables read from netcdf for chemistry emissions 881 882 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: dum_var_4d !< variable for storing temporary data of 5-dimensional 883 !< variables read from netcdf for chemistry emissions 884 !-- 885 !> Start the processing of the data 886 CALL location_message( 'starting allocation of chemistry emissions arrays', .FALSE. ) 887 888 !> Parameterized mode of the emissions 889 IF (TRIM(mode_emis)=="PARAMETERIZED" .OR. TRIM(mode_emis)=="parameterized") THEN 890 891 ispec=1 892 emt_att%nspec=0 893 894 !number of species 895 DO WHILE (TRIM( surface_csflux_name( ispec ) ) /= 'novalue' ) 896 897 emt_att%nspec=emt_att%nspec+1 898 ispec=ispec+1 899 900 ENDDO 901 902 !-- allocate emission values data type arrays 903 ALLOCATE(emt(emt_att%nspec)) 904 905 !-- Read EMISSION SPECIES NAMES 906 907 !Assign values 908 ALLOCATE(emt_att%species_name(emt_att%nspec)) 909 910 DO ispec=1,emt_att%nspec 911 emt_att%species_name(ispec) = TRIM(surface_csflux_name(ispec)) 912 ENDDO 913 914 !Assign Constant Values of time factors: 915 emt_att%par_emis_time_factor( : ) = (/ 0.01, 0.01, 0.01, 0.02, 0.03, 0.07, 0.09, 0.09, 0.05, 0.03, 0.03, 0.03, & 916 0.03, 0.03, 0.03, 0.04, 0.05, 0.09, 0.09, 0.09, 0.04, 0.02, 0.01, 0.01 /) 917 918 !> DEFAULT AND PRE-PROCESSED MODE 919 ELSE 920 921 #if defined ( __netcdf ) 922 IF ( .NOT. input_pids_chem ) RETURN 923 924 !-- Open file in read-only mode 925 CALL open_read_file( TRIM( input_file_chem ) // & 926 TRIM( coupling_char ), id_emis ) 927 !-- inquire number of variables 928 CALL inquire_num_variables( id_emis, num_vars ) 929 930 !-- Get General Dimension Lengths: only number of species and number of categories. 931 ! the other dimensions depend on the mode of the emissions or on the presence of specific components 932 !nspecies 933 CALL get_dimension_length( id_emis, emt_att%nspec, 'nspecies' ) 934 935 936 !-- Allocate emission values data type arrays 937 ALLOCATE(emt(1:emt_att%nspec)) 938 939 940 !-- Read EMISSION SPECIES NAMES 941 !Allocate Arrays 942 ALLOCATE(emt_att%species_name(emt_att%nspec)) 943 944 !Call get Variable 945 CALL get_variable( id_emis, 'emission_name', string_values, emt_att%nspec ) 946 emt_att%species_name=string_values 947 ! If allocated, Deallocate var_string, an array only used for reading-in strings 948 IF (ALLOCATED(string_values)) DEALLOCATE(string_values) 949 950 !-- Read EMISSION SPECIES INDEX 951 !Allocate Arrays 952 ALLOCATE(emt_att%species_index(emt_att%nspec)) 953 !Call get Variable 954 CALL get_variable( id_emis, 'emission_index', emt_att%species_index ) 955 956 957 !-- Now the routine has to distinguish between DEFAULT and PRE-PROCESSED chemistry emission modes 958 959 IF (TRIM(mode_emis)=="DEFAULT" .OR. TRIM(mode_emis)=="default") THEN 960 961 !number of categories 962 CALL get_dimension_length( id_emis, emt_att%ncat, 'ncat' ) 963 964 !-- Read EMISSION CATEGORIES INDEX 965 !Allocate Arrays 966 ALLOCATE(emt_att%cat_index(emt_att%ncat)) 967 !Call get Variable 968 CALL get_variable( id_emis, 'emission_cat_index', emt_att%cat_index ) 969 970 971 DO ispec=1,emt_att%nspec 972 !-- EMISSION_VOC_NAME (1-DIMENSIONAL) 973 IF (TRIM(emt_att%species_name(ispec))=="VOC" .OR. TRIM(emt_att%species_name(ispec))=="voc") THEN 974 !Allocate Array 975 CALL get_dimension_length( id_emis, emt_att%nvoc, 'nvoc' ) 976 ALLOCATE(emt_att%voc_name(1:emt_att%nvoc)) 977 !Read-in Variable 978 CALL get_variable( id_emis,"emission_voc_name",string_values, emt_att%nvoc) 979 emt_att%voc_name=string_values 980 IF (ALLOCATED(string_values)) DEALLOCATE(string_values) 981 982 !-- COMPOSITION VOC (2-DIMENSIONAL) 983 !Allocate Array 984 ALLOCATE(emt_att%voc_comp(1:emt_att%ncat,1:emt_att%nvoc)) 985 !Read-in Variable 986 ! CALL get_variable(id_emis,"composition_voc",emt%voc_comp,1,1,emt%ncat,emt%nvoc) 987 CALL get_variable(id_emis,"composition_voc",emt_att%voc_comp,1,emt_att%ncat,1,emt_att%nvoc) 988 ENDIF 989 990 !-- EMISSION_PM_NAME (1-DIMENSIONAL) 991 IF (TRIM(emt_att%species_name(ispec))=="PM" .OR. TRIM(emt_att%species_name(ispec))=="pm") THEN 992 CALL get_dimension_length( id_emis, emt_att%npm, 'npm' ) 993 ALLOCATE(emt_att%pm_name(1:emt_att%npm)) 994 !Read-in Variable 995 CALL get_variable( id_emis,"pm_name",string_values, emt_att%npm) 996 emt_att%pm_name=string_values 997 IF (ALLOCATED(string_values)) DEALLOCATE(string_values) 998 999 !-- COMPOSITION PM (3-DIMENSIONAL) 1000 !Allocate 1001 len_dims=3 !> number of PMs: PM1, PM2.5 and PM10 1002 ALLOCATE(emt_att%pm_comp(1:emt_att%ncat,1:emt_att%npm,1:len_dims)) 1003 !Read-in Variable 1004 CALL get_variable(id_emis,"composition_pm",emt_att%pm_comp,1,emt_att%ncat,1,emt_att%npm,1,len_dims) 1005 ENDIF 1006 1007 !-- COMPOSITION_NOX (2-DIMENSIONAL) 1008 IF (TRIM(emt_att%species_name(ispec))=="NOx" .OR. TRIM(emt_att%species_name(ispec))=="nox") THEN 1009 !Allocate array 1010 ALLOCATE(emt_att%nox_comp(1:emt_att%ncat,1:emt_att%nnox)) 1011 !Read-in Variable 1012 CALL get_variable(id_emis,"composition_nox",emt_att%nox_comp,1,emt_att%ncat,1,emt_att%nnox) 1013 ENDIF 1014 1015 !-- COMPOSITION-SOX (2-DIMENSIONAL) 1016 IF (TRIM(emt_att%species_name(ispec))=="SOx" .OR. TRIM(emt_att%species_name(ispec))=="sox") THEN 1017 ALLOCATE(emt_att%sox_comp(1:emt_att%ncat,1:emt_att%nsox)) 1018 !Read-in Variable 1019 CALL get_variable(id_emis,"composition_sox",emt_att%sox_comp,1,emt_att%ncat,1,emt_att%nsox) 1020 ENDIF 1021 ENDDO !>ispec 1022 1023 !-- For reading the emission time factors, the distinction between HOUR and MDH data is necessary 1024 1025 !-- EMISSION_TIME_SCALING_FACTORS 1026 !-- HOUR 1027 IF (TRIM(time_fac_type)=="HOUR" .OR. TRIM(time_fac_type)=="hour") THEN 1028 !-- Allocate Array 1029 CALL get_dimension_length( id_emis, emt_att%nhoursyear, 'nhoursyear' ) 1030 ALLOCATE(emt_att%hourly_emis_time_factor(1:emt_att%ncat,1:emt_att%nhoursyear)) 1031 !Read-in Variable 1032 CALL get_variable(id_emis,"emission_time_factors",emt_att%hourly_emis_time_factor,1,emt_att%ncat,1,emt_att%nhoursyear) 1033 1034 !-- MDH 1035 ELSE IF (TRIM(time_fac_type) == "MDH" .OR. TRIM(time_fac_type) == "mdh") THEN 1036 !-- Allocate Array 1037 CALL get_dimension_length( id_emis, emt_att%nmonthdayhour, 'nmonthdayhour' ) 1038 ALLOCATE(emt_att%mdh_emis_time_factor(1:emt_att%ncat,1:emt_att%nmonthdayhour)) 1039 !-- Read-in Variable 1040 CALL get_variable(id_emis,"emission_time_factors",emt_att%mdh_emis_time_factor,1,emt_att%ncat,1,emt_att%nmonthdayhour) 1041 1042 ELSE 1043 1044 message_string = 'We are in the DEFAULT chemistry emissions mode: ' // & 1045 ' !no time-factor type specified!' // & 1046 'Please, specify the value of time_fac_type:' // & 1047 ' either "MDH" or "HOUR"' 1048 CALL message( 'netcdf_data_input_chemistry_data', 'CM0200', 2, 2, 0, 6, 0 ) 1049 1050 1051 ENDIF 1052 1053 !-- Finally read-in the emission values and their units (DEFAULT mode) 1054 1055 DO ispec=1,emt_att%nspec 1056 1057 IF ( .NOT. ALLOCATED( emt(ispec)%default_emission_data ) ) ALLOCATE(emt(ispec)%default_emission_data(1:emt_att%ncat,1:ny+1,1:nx+1)) 1058 1059 ALLOCATE(dum_var_3d(1:emt_att%ncat,nys+1:nyn+1,nxl+1:nxr+1)) 1060 1061 CALL get_variable(id_emis,"emission_values",dum_var_3d,ispec,1,emt_att%ncat,nys,nyn,nxl,nxr) 1062 1063 emt(ispec)%default_emission_data(:,nys+1:nyn+1,nxl+1:nxr+1)=dum_var_3d(1:emt_att%ncat,nys+1:nyn+1,nxl+1:nxr+1) 1064 1065 DEALLOCATE (dum_var_3d) 1066 1067 ENDDO 1068 1069 !-- UNITS 1070 CALL get_attribute(id_emis,"units",emt_att%units,.FALSE.,"emission_values") 1071 1072 1073 !-- PRE-PROCESSED MODE -- 1074 1075 ELSE IF (TRIM(mode_emis)=="PRE-PROCESSED" .OR. TRIM(mode_emis)=="pre-processed") THEN 1076 !-- In the PRE-PROCESSED mode, only the VOC names, the VOC_composition, the emission values and their units remain to be read at this point 1077 1078 DO ispec=1,emt_att%nspec 1079 1080 !-- EMISSION_VOC_NAME (1-DIMENSIONAL) 1081 IF (TRIM(emt_att%species_name(ispec))=="VOC" .OR. TRIM(emt_att%species_name(ispec))=="voc") THEN 1082 !Allocate Array 1083 CALL get_dimension_length( id_emis, emt_att%nvoc, 'nvoc' ) 1084 ALLOCATE(emt_att%voc_name(1:emt_att%nvoc)) 1085 !Read-in Variable 1086 CALL get_variable( id_emis,"emission_voc_name",string_values, emt_att%nvoc) 1087 emt_att%voc_name=string_values 1088 IF (ALLOCATED(string_values)) DEALLOCATE(string_values) 1089 1090 !-- COMPOSITION VOC (2-DIMENSIONAL) 1091 !Allocate Array 1092 ALLOCATE(emt_att%voc_comp(1:emt_att%ncat,1:emt_att%nvoc)) 1093 !Read-in Variable 1094 CALL get_variable(id_emis,"composition_voc",emt_att%voc_comp,1,emt_att%ncat,1,emt_att%nvoc) 1095 ENDIF 1096 1097 ENDDO !> ispec 1098 1099 !-- EMISSION_VALUES (4-DIMENSIONAL) 1100 !Calculate temporal dimension length 1101 CALL get_dimension_length( id_emis, emt_att%dt_emission, 'time' ) 1102 1103 1104 DO ispec=1,emt_att%nspec 1105 1106 !Allocation for the entire domain has to be done only for the first processor between all the subdomains 1107 IF ( .NOT. ALLOCATED( emt(ispec)%preproc_emission_data ) ) ALLOCATE(emt(ispec)%preproc_emission_data(emt_att%dt_emission,1,1:ny+1,1:nx+1)) 1108 1109 !> allocate variable where to pass emission values read from netcdf 1110 ALLOCATE(dum_var_4d(1:emt_att%dt_emission,1,nys+1:nyn+1,nxl+1:nxr+1)) 1111 1112 !Read-in Variable 1113 CALL get_variable(id_emis,"emission_values",dum_var_4d,ispec,1,emt_att%dt_emission,1,1,nys,nyn,nxl,nxr) 1114 1115 1116 emt(ispec)%preproc_emission_data(:,1,nys+1:nyn+1,nxl+1:nxr+1)=dum_var_4d(1:emt_att%dt_emission,1,nys+1:nyn+1,nxl+1:nxr+1) 1117 1118 DEALLOCATE ( dum_var_4d ) 1119 1120 ENDDO 1121 1122 !-- UNITS 1123 CALL get_attribute(id_emis,"units",emt_att%units,.FALSE.,"emission_values") 1124 1125 ENDIF 1126 1127 CALL close_input_file( id_emis ) 1128 1129 #endif 1130 ENDIF 1131 1132 END SUBROUTINE netcdf_data_input_chemistry_data 758 1133 759 1134 !------------------------------------------------------------------------------! … … 4094 4469 ! Description: 4095 4470 ! ------------ 4471 !> Routine for reading-in a character string from the chem emissions netcdf input file. 4472 !------------------------------------------------------------------------------! 4473 4474 SUBROUTINE get_variable_string( id, variable_name, var_string, names_number) 4475 #if defined( __netcdf ) 4476 4477 USE indices 4478 USE pegrid 4479 4480 IMPLICIT NONE 4481 4482 CHARACTER (LEN=25), ALLOCATABLE, DIMENSION(:), INTENT(INOUT) :: var_string 4483 4484 CHARACTER(LEN=*) :: variable_name !> variable name 4485 4486 CHARACTER (LEN=1), ALLOCATABLE, DIMENSION(:,:) :: tmp_var_string !> variable to be read 4487 4488 4489 INTEGER(iwp), INTENT(IN) :: id !> file id 4490 4491 INTEGER(iwp), INTENT(IN) :: names_number !> number of names 4492 4493 INTEGER(iwp) :: id_var !> variable id 4494 4495 INTEGER(iwp) :: i,j !> index to go through the length of the dimensions 4496 4497 INTEGER(iwp) :: max_string_length=25 !> this is both the maximum length of a name, but also 4498 ! the number of the components of the first dimensions 4499 ! (rows) 4500 4501 4502 ALLOCATE(tmp_var_string(max_string_length,names_number)) 4503 4504 ALLOCATE(var_string(names_number)) 4505 4506 !-- Inquire variable id 4507 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4508 4509 4510 !-- Get variable 4511 !-- Start cycle over the emission species 4512 DO i = 1, names_number 4513 !-- read the first letter of each component 4514 nc_stat = NF90_GET_VAR( id, id_var, var_string(i), start = (/ 1,i /), & 4515 count = (/ 1,1 /) ) 4516 CALL handle_error( 'get_variable_string', 701 ) 4517 4518 !-- Start cycle over charachters 4519 DO j = 1, max_string_length 4520 4521 !-- read the rest of the components of the name 4522 nc_stat = NF90_GET_VAR( id, id_var, tmp_var_string(j,i), start = (/ j,i /),& 4523 count = (/ 1,1 /) ) 4524 CALL handle_error( 'get_variable_string', 702 ) 4525 4526 IF ( iachar(tmp_var_string(j,i) ) == 0 ) THEN 4527 tmp_var_string(j,i)='' 4528 ENDIF 4529 4530 IF ( j>1 ) THEN 4531 !-- Concatenate first letter of the name and the others 4532 var_string(i)=TRIM(var_string(i)) // TRIM(tmp_var_string(j,i)) 4533 4534 ENDIF 4535 ENDDO 4536 ENDDO 4537 4538 #endif 4539 END SUBROUTINE get_variable_string 4540 4541 4542 !------------------------------------------------------------------------------! 4543 ! Description: 4544 ! ------------ 4096 4545 !> Reads a 1D integer variable from file. 4097 4546 !------------------------------------------------------------------------------! … … 4233 4682 #endif 4234 4683 ENDIF 4684 4685 4686 !Temporary solution for reading emission chemistry files: TBD: we should discuss whether remove it or not 4687 IF ( id==id_emis ) THEN 4688 4689 !-- Allocate temporary variable according to memory access on file. 4690 ALLOCATE( tmp(is:ie,js:je) ) 4691 4692 !-- Get variable 4693 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4694 start = (/ is, js /), & 4695 count = (/ ie-is+1 , je-js+1 /) ) 4696 4697 var=tmp 4698 4699 CALL handle_error( 'get_variable_2d_real', 530, variable_name ) !TBD: the error number shuld be changed, but since the solution is 4700 ! provisory, we give the same as below 4701 4702 DEALLOCATE( tmp ) 4703 4704 !> Original Subroutine part 4705 ELSE 4235 4706 ! 4236 4707 !-- Allocate temporary variable according to memory access on file. … … 4238 4709 ! 4239 4710 !-- Get variable 4240 nc_stat = NF90_GET_VAR( id, id_var, tmp, &4711 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4241 4712 start = (/ is+1, js+1 /), & 4242 4713 count = (/ ie-is + 1, je-js+1 /) ) 4243 4714 4244 CALL handle_error( 'get_variable_2d_real', 530, variable_name )4715 CALL handle_error( 'get_variable_2d_real', 530, variable_name ) 4245 4716 ! 4246 4717 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4247 DO i = is, ie 4248 DO j = js, je 4249 var(j-js+1,i-is+1) = tmp(i,j) 4718 DO i = is, ie 4719 DO j = js, je 4720 var(j-js+1,i-is+1) = tmp(i,j) 4721 ENDDO 4250 4722 ENDDO 4251 ENDDO4252 4723 4253 DEALLOCATE( tmp ) 4254 4724 DEALLOCATE( tmp ) 4725 4726 ENDIF 4255 4727 #endif 4256 4728 END SUBROUTINE get_variable_2d_real … … 4647 5119 #endif 4648 5120 ENDIF 5121 5122 !Temporary solution for reading emission chemistry files: 5123 IF ( id==id_emis ) THEN 5124 5125 !-- Allocate temporary variable according to memory access on file. 5126 ALLOCATE( tmp(is:ie,js:je,k1s:k1e,k2s:k2e) ) 5127 5128 !-- Get variable 5129 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 5130 start = (/ is, js, k1s+1, k2s+1 /), & 5131 count = (/ ie-is+1 , je-js+1, k1e-k1s+1, k2e-k2s+1 /) ) 5132 5133 var=tmp 5134 5135 CALL handle_error( 'get_variable_4d_real', 535, variable_name ) 5136 5137 DEALLOCATE( tmp ) 5138 5139 !> Original subroutine part 5140 ELSE 4649 5141 ! 4650 5142 !-- Allocate temporary variable according to memory access on file. … … 4652 5144 ! 4653 5145 !-- Get variable 4654 nc_stat = NF90_GET_VAR( id, id_var, tmp, &5146 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4655 5147 start = (/ is+1, js+1, k1s+1, k2s+1 /), & 4656 5148 count = (/ ie-is+1, je-js+1, & 4657 5149 k1e-k1s+1, k2e-k2s+1 /) ) 4658 5150 4659 CALL handle_error( 'get_variable_4d_real', 535, variable_name )5151 CALL handle_error( 'get_variable_4d_real', 535, variable_name ) 4660 5152 ! 4661 5153 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4662 DO i = is, ie 4663 DO j = js, je 4664 DO k1 = k1s, k1e 4665 DO k2 = k2s, k2e 4666 var(k2-k2s+1,k1-k1s+1,j-js+1,i-is+1) = tmp(i,j,k1,k2) 5154 DO i = is, ie 5155 DO j = js, je 5156 DO k1 = k1s, k1e 5157 DO k2 = k2s, k2e 5158 var(k2-k2s+1,k1-k1s+1,j-js+1,i-is+1) = tmp(i,j,k1,k2) 5159 ENDDO 4667 5160 ENDDO 4668 5161 ENDDO 4669 5162 ENDDO 4670 ENDDO4671 5163 4672 DEALLOCATE( tmp ) 5164 DEALLOCATE( tmp ) 5165 ENDIF 4673 5166 #endif 4674 5167 END SUBROUTINE get_variable_4d_real 4675 5168 4676 5169 !------------------------------------------------------------------------------! 5170 ! Description: 5171 ! ------------ 5172 !> Reads a 4D float variable from file and store it to a 3-d variable. 5173 !------------------------------------------------------------------------------! 5174 SUBROUTINE get_variable_4d_to_3d_real( id, variable_name, var, ns, is, ie, js, je, & 5175 ks, ke ) 5176 5177 USE indices 5178 USE pegrid 5179 5180 IMPLICIT NONE 5181 5182 CHARACTER(LEN=*) :: variable_name !< variable name 5183 5184 INTEGER(iwp) :: ns !< start index for subdomain input along n dimension: ns coincides here with ne, since, we select only one value along the 1st dimension n 5185 5186 INTEGER(iwp) :: i !< index along x direction 5187 INTEGER(iwp) :: ie !< end index for subdomain input along x direction 5188 INTEGER(iwp) :: is !< start index for subdomain input along x direction 5189 INTEGER(iwp), INTENT(IN) :: id !< file id 5190 INTEGER(iwp) :: id_var !< variable id 5191 INTEGER(iwp) :: j !< index along y direction 5192 INTEGER(iwp) :: je !< end index for subdomain input along y direction 5193 INTEGER(iwp) :: js !< start index for subdomain input along y direction 5194 INTEGER(iwp) :: k !< index along any 4th dimension 5195 INTEGER(iwp) :: ke !< end index of 4th dimension 5196 INTEGER(iwp) :: ks !< start index of 4th dimension 5197 5198 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 5199 !< to its reverse memory access 5200 5201 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< variable where the read data have to be stored: one dimension is reduced in the process 5202 #if defined( __netcdf ) 5203 5204 ! 5205 !-- Inquire variable id 5206 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 5207 ! 5208 !-- Check for collective read-operation and set respective NetCDF flags if 5209 !-- required. 5210 IF ( collective_read ) THEN 5211 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 5212 ENDIF 5213 5214 !Temporary solution for reading emission chemistry files: 5215 IF ( id==id_emis ) THEN 5216 5217 !-- Allocate temporary variable according to memory access on file. 5218 ALLOCATE( tmp(is:ie,js:je,ks:ke) ) 5219 5220 !-- Get variable 5221 nc_stat = NF90_GET_VAR( id, id_var, tmp(is:ie,js:je,ks:ke), & 5222 start = (/ ns, is, js+1, ks+1 /), & 5223 count = (/ 1, ie-is+1 , je-js+1, ke-ks+1 /) ) 5224 5225 var=tmp(:,:,:) 5226 5227 CALL handle_error( 'get_variable_4d_to_3d_real', 536, variable_name ) 5228 5229 DEALLOCATE( tmp ) 5230 5231 ELSE 5232 ! 5233 !-- Allocate temporary variable according to memory access on file. 5234 ALLOCATE( tmp(is:ie,js:je,ks:ke) ) 5235 ! 5236 !-- Get variable 5237 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 5238 start = (/ ns+1, is+1, js+1, ks+1 /), & 5239 count = (/ 1, ie-is+1, je-js+1, ke-ks+1 /) ) 5240 5241 CALL handle_error( 'get_variable_4d_to_3d_real', 536, variable_name ) 5242 ! 5243 !-- Resort data. Please note, dimension subscripts of var all start at 1. 5244 DO i = is, ie 5245 DO j = js, je 5246 DO k = ks, ke 5247 var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k) 5248 ENDDO 5249 ENDDO 5250 ENDDO 5251 5252 DEALLOCATE( tmp ) 5253 5254 ENDIF 5255 #endif 5256 END SUBROUTINE get_variable_4d_to_3d_real 4677 5257 4678 5258 !------------------------------------------------------------------------------! … … 4755 5335 count = (/ count_1, count_2, count_3 /) ) 4756 5336 4757 CALL handle_error( 'get_variable_3d_real_dynamic', 53 6, variable_name )5337 CALL handle_error( 'get_variable_3d_real_dynamic', 537, variable_name ) 4758 5338 ! 4759 5339 !-- Resort data. Please note, dimension subscripts of var all start at 1. … … 4770 5350 END SUBROUTINE get_variable_3d_real_dynamic 4771 5351 5352 !------------------------------------------------------------------------------! 5353 ! Description: 5354 ! ------------ 5355 !> Reads a 5D float variable from file and store it to a 4-d variable. 5356 !------------------------------------------------------------------------------! 5357 SUBROUTINE get_variable_5d_to_4d_real( id, variable_name, var, & 5358 ns, ts, te, is, ie, js, je, ks, ke ) 5359 5360 USE indices 5361 USE pegrid 5362 5363 IMPLICIT NONE 5364 5365 CHARACTER(LEN=*) :: variable_name !< variable name 5366 5367 INTEGER(iwp) :: ns !< start index for subdomain input along n dimension: ns coincides here with ne, since, we select only one value along the 1st dimension n 5368 5369 INTEGER(iwp) :: t !< index along t direction 5370 INTEGER(iwp) :: te !< end index for subdomain input along t direction 5371 INTEGER(iwp) :: ts !< start index for subdomain input along t direction 5372 5373 INTEGER(iwp) :: i !< index along x direction 5374 INTEGER(iwp) :: ie !< end index for subdomain input along x direction 5375 INTEGER(iwp) :: is !< start index for subdomain input along x direction 5376 INTEGER(iwp), INTENT(IN) :: id !< file id 5377 INTEGER(iwp) :: id_var !< variable id 5378 INTEGER(iwp) :: j !< index along y direction 5379 INTEGER(iwp) :: je !< end index for subdomain input along y direction 5380 INTEGER(iwp) :: js !< start index for subdomain input along y direction 5381 INTEGER(iwp) :: k !< index along any 5th dimension 5382 INTEGER(iwp) :: ke !< end index of 5th dimension 5383 INTEGER(iwp) :: ks !< start index of 5th dimension 5384 5385 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 5386 ! to its reverse memory access 5387 REAL(wp), DIMENSION(:,:,:,:), INTENT(INOUT) :: var !< variable to be read 5388 #if defined( __netcdf ) 5389 ! 5390 !-- Inquire variable id 5391 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 5392 ! 5393 !-- Check for collective read-operation and set respective NetCDF flags if 5394 !-- required. 5395 IF ( collective_read ) THEN 5396 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 5397 ENDIF 5398 5399 !Temporary solution for reading emission chemistry files: 5400 IF ( id==id_emis ) THEN 5401 5402 !-- Allocate temporary variable according to memory access on file. 5403 ALLOCATE( tmp(ts:te,1,js+1:je+1,ks+1:ke+1) ) 5404 5405 !-- Get variable 5406 nc_stat = NF90_GET_VAR( id, id_var, tmp(ts:te,1,js+1:je+1,ks+1:ke+1), & 5407 start = (/ ns, ts, 1, js+1, ks+1 /), & 5408 count = (/ 1, te-ts+1, 1, je-js+1, ke-ks+1 /) ) 5409 5410 var=tmp 5411 5412 CALL handle_error( 'get_variable_5d_to_4d_real', 538, variable_name ) 5413 5414 DEALLOCATE( tmp ) 5415 5416 !> Original Subroutine part 5417 ELSE 5418 ! 5419 !-- Allocate temporary variable according to memory access on file. 5420 ALLOCATE( tmp(ks:ke,js:je,is:is,ts:te) ) 5421 ! 5422 !-- Get variable 5423 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 5424 start = (/ ks+1, js+1, is+1, ts+1, ns /), & 5425 count = (/ ke-ks+1, je-js+1, ie-is+1, te-ts+1, 1 /) ) 5426 5427 CALL handle_error( 'get_variable_5d_to_4d_real', 538, variable_name ) 5428 ! 5429 !-- Resort data. Please note, dimension subscripts of var all start at 1. 5430 5431 DO t = ts, te 5432 DO i = is, ie 5433 DO j = js, je 5434 DO k = ks, ke 5435 var(t-ts+1,i-is+1,j-js+1,k-ks+1) = tmp(k,j,i,t) 5436 ENDDO 5437 ENDDO 5438 ENDDO 5439 ENDDO 5440 5441 DEALLOCATE( tmp ) 5442 5443 ENDIF 5444 #endif 5445 END SUBROUTINE get_variable_5d_to_4d_real 4772 5446 4773 5447 … … 4789 5463 4790 5464 nc_stat = NF90_INQUIRE( id, NVARIABLES = num_vars ) 4791 CALL handle_error( 'inquire_num_variables', 53 7)5465 CALL handle_error( 'inquire_num_variables', 539 ) 4792 5466 4793 5467 #endif … … 4816 5490 ALLOCATE( varids(1:SIZE(var_names)) ) 4817 5491 nc_stat = NF90_INQ_VARIDS( id, NVARS = num_vars, VARIDS = varids ) 4818 CALL handle_error( 'inquire_variable_names', 5 38)5492 CALL handle_error( 'inquire_variable_names', 540 ) 4819 5493 4820 5494 DO i = 1, SIZE(var_names) 4821 5495 nc_stat = NF90_INQUIRE_VARIABLE( id, varids(i), NAME = var_names(i) ) 4822 CALL handle_error( 'inquire_variable_names', 5 38)5496 CALL handle_error( 'inquire_variable_names', 540 ) 4823 5497 ENDDO 4824 5498
Note: See TracChangeset
for help on using the changeset viewer.
