Changeset 4724 for palm/trunk/SOURCE/netcdf_data_input_mod.f90
- Timestamp:
- Oct 6, 2020 5:20:39 PM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/netcdf_data_input_mod.f90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/netcdf_data_input_mod.f90
r4641 r4724 25 25 ! ----------------- 26 26 ! $Id$ 27 ! - New routines to read LOD=1 variables from dynamic input file 28 ! - add no_abort option to all get_attribute routines 29 ! 30 ! 4641 2020-08-13 09:57:07Z suehring 27 31 ! To follow (UC)2 standard, change default of attribute data_content 28 32 ! … … 741 745 MODULE PROCEDURE get_variable_2d_int32 742 746 MODULE PROCEDURE get_variable_2d_real 747 MODULE PROCEDURE get_variable_2d_real_dynamic 743 748 MODULE PROCEDURE get_variable_3d_int8 744 749 MODULE PROCEDURE get_variable_3d_real … … 3996 4001 !------------------------------------------------------------------------------! 3997 4002 SUBROUTINE get_attribute_int32( id, attribute_name, value, global, & 3998 variable_name )4003 variable_name, no_abort ) 3999 4004 4000 4005 USE pegrid … … 4009 4014 INTEGER(iwp), INTENT(INOUT) :: value !< read value 4010 4015 4011 LOGICAL, INTENT(IN) :: global !< flag indicating global attribute 4016 LOGICAL :: check_error !< flag indicating if handle_error shall be checked 4017 LOGICAL, INTENT(IN) :: global !< flag indicating global attribute 4018 LOGICAL, INTENT(IN), OPTIONAL :: no_abort !< flag indicating if errors should be checked 4012 4019 #if defined( __netcdf ) 4013 4020 4021 IF ( PRESENT( no_abort ) ) THEN 4022 check_error = no_abort 4023 ELSE 4024 check_error = .TRUE. 4025 ENDIF 4014 4026 ! 4015 4027 !-- Read global attribute 4016 4028 IF ( global ) THEN 4017 4029 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 4018 CALL handle_error( 'get_attribute_int32 global', 522, attribute_name )4030 IF ( check_error) CALL handle_error( 'get_attribute_int32 global', 522, attribute_name ) 4019 4031 ! 4020 4032 !-- Read attributes referring to a single variable. Therefore, first inquire … … 4022 4034 ELSE 4023 4035 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4024 CALL handle_error( 'get_attribute_int32', 522, attribute_name )4036 IF ( check_error) CALL handle_error( 'get_attribute_int32', 522, attribute_name ) 4025 4037 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 4026 CALL handle_error( 'get_attribute_int32', 522, attribute_name )4038 IF ( check_error) CALL handle_error( 'get_attribute_int32', 522, attribute_name ) 4027 4039 ENDIF 4028 4040 #endif … … 4035 4047 !------------------------------------------------------------------------------! 4036 4048 SUBROUTINE get_attribute_int8( id, attribute_name, value, global, & 4037 variable_name )4049 variable_name, no_abort ) 4038 4050 4039 4051 USE pegrid … … 4048 4060 INTEGER(KIND=1), INTENT(INOUT) :: value !< read value 4049 4061 4050 LOGICAL, INTENT(IN) :: global !< flag indicating global attribute 4062 LOGICAL :: check_error !< flag indicating if handle_error shall be checked 4063 LOGICAL, INTENT(IN), OPTIONAL :: no_abort !< flag indicating if errors should be checked 4064 LOGICAL, INTENT(IN) :: global !< flag indicating global attribute 4051 4065 #if defined( __netcdf ) 4052 4066 4067 IF ( PRESENT( no_abort ) ) THEN 4068 check_error = no_abort 4069 ELSE 4070 check_error = .TRUE. 4071 ENDIF 4053 4072 ! 4054 4073 !-- Read global attribute 4055 4074 IF ( global ) THEN 4056 4075 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 4057 CALL handle_error( 'get_attribute_int8 global', 523, attribute_name )4076 IF ( check_error) CALL handle_error( 'get_attribute_int8 global', 523, attribute_name ) 4058 4077 ! 4059 4078 !-- Read attributes referring to a single variable. Therefore, first inquire … … 4061 4080 ELSE 4062 4081 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4063 CALL handle_error( 'get_attribute_int8', 523, attribute_name )4082 IF ( check_error) CALL handle_error( 'get_attribute_int8', 523, attribute_name ) 4064 4083 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 4065 CALL handle_error( 'get_attribute_int8', 523, attribute_name )4084 IF ( check_error) CALL handle_error( 'get_attribute_int8', 523, attribute_name ) 4066 4085 ENDIF 4067 4086 #endif … … 4074 4093 !------------------------------------------------------------------------------! 4075 4094 SUBROUTINE get_attribute_real( id, attribute_name, value, global, & 4076 variable_name )4095 variable_name, no_abort ) 4077 4096 4078 4097 USE pegrid … … 4086 4105 INTEGER(iwp) :: id_var !< variable id 4087 4106 4088 LOGICAL, INTENT(IN) :: global !< flag indicating global attribute 4107 LOGICAL :: check_error !< flag indicating if handle_error shall be checked 4108 LOGICAL, INTENT(IN) :: global !< flag indicating global attribute 4109 LOGICAL, INTENT(IN), OPTIONAL :: no_abort !< flag indicating if errors should be checked 4089 4110 4090 4111 REAL(wp), INTENT(INOUT) :: value !< read value 4091 4112 #if defined( __netcdf ) 4092 4113 4093 4094 ! 4095 !-- Read global attribute 4114 IF ( PRESENT( no_abort ) ) THEN 4115 check_error = no_abort 4116 ELSE 4117 check_error = .TRUE. 4118 ENDIF 4119 ! 4120 !-- Read global attribute 4096 4121 IF ( global ) THEN 4097 4122 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 4098 CALL handle_error( 'get_attribute_real global', 524, attribute_name )4099 ! 4100 !-- Read attributes referring to a single variable. Therefore, first inquire4101 !-- variable id4123 IF ( check_error) CALL handle_error( 'get_attribute_real global', 524, attribute_name ) 4124 ! 4125 !-- Read attributes referring to a single variable. Therefore, first inquire 4126 !-- variable id 4102 4127 ELSE 4103 4128 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4104 CALL handle_error( 'get_attribute_real', 524, attribute_name )4129 IF ( check_error) CALL handle_error( 'get_attribute_real', 524, attribute_name ) 4105 4130 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 4106 CALL handle_error( 'get_attribute_real', 524, attribute_name )4131 IF ( check_error) CALL handle_error( 'get_attribute_real', 524, attribute_name ) 4107 4132 ENDIF 4108 4133 #endif … … 4332 4357 4333 4358 !------------------------------------------------------------------------------! 4334 ! Description:4335 ! ------------4336 !> Reads a character variable in a 1D array4359 ! Description: 4360 ! ------------ 4361 !> Reads a character variable in a 1D array 4337 4362 !------------------------------------------------------------------------------! 4338 4363 SUBROUTINE get_variable_1d_char( id, variable_name, var ) … … 4405 4430 CALL handle_error( 'get_variable_1d_int', 527, variable_name ) 4406 4431 ! 4407 !-- Inquire dimension length4432 !-- Read variable 4408 4433 nc_stat = NF90_GET_VAR( id, id_var, var ) 4409 4434 CALL handle_error( 'get_variable_1d_int', 527, variable_name ) … … 4417 4442 !> Reads a 1D float variable from file. 4418 4443 !------------------------------------------------------------------------------! 4419 SUBROUTINE get_variable_1d_real( id, variable_name, var )4444 SUBROUTINE get_variable_1d_real( id, variable_name, var, is, count_elements ) 4420 4445 4421 4446 USE pegrid … … 4428 4453 INTEGER(iwp) :: id_var !< dimension id 4429 4454 4455 INTEGER(iwp), INTENT(IN), OPTIONAL :: count_elements !< number of elements to be read 4456 INTEGER(iwp), INTENT(IN), OPTIONAL :: is !< start index 4457 4430 4458 REAL(wp), DIMENSION(:), INTENT(INOUT) :: var !< variable to be read 4431 4459 #if defined( __netcdf ) 4432 4433 4460 ! 4434 4461 !-- First, inquire variable ID … … 4436 4463 CALL handle_error( 'get_variable_1d_real', 528, variable_name ) 4437 4464 ! 4438 !-- Inquire dimension length 4439 nc_stat = NF90_GET_VAR( id, id_var, var ) 4440 CALL handle_error( 'get_variable_1d_real', 528, variable_name ) 4465 !-- Read variable 4466 IF ( PRESENT( is ) ) THEN 4467 nc_stat = NF90_GET_VAR( id, id_var, var, start = (/ is /), count = (/ count_elements /) ) 4468 CALL handle_error( 'get_variable_1d_real', 528, variable_name ) 4469 ELSE 4470 nc_stat = NF90_GET_VAR( id, id_var, var ) 4471 CALL handle_error( 'get_variable_1d_real', 528, variable_name ) 4472 ENDIF 4441 4473 4442 4474 #endif … … 4463 4495 INTEGER(iwp), INTENT(IN) :: t !< timestep number 4464 4496 4465 REAL(wp), DIMENSION(:), INTENT(INOUT) :: var !< variable to be read4497 REAL(wp), DIMENSION(:), INTENT(INOUT) :: var !< variable to be read 4466 4498 4467 4499 #if defined( __netcdf ) … … 4743 4775 4744 4776 ! 4745 !-- Allocate temporary variable according to memory access on file.4777 !-- Allocate temporary variable according to memory access on file. 4746 4778 ALLOCATE( tmp(is:ie,js:je) ) 4747 4779 ! 4748 !-- Get variable4780 !-- Get variable 4749 4781 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4750 4782 start = (/ is+1, js+1 /), & 4751 4783 count = (/ ie-is + 1, je-js+1 /) ) 4752 CALL handle_error( 'get_variable_2d_real', 530, variable_name ) 4753 ! 4754 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4755 DO i = is, ie 4756 DO j = js, je 4757 var(j-js+1,i-is+1) = tmp(i,j) 4758 ENDDO 4784 CALL handle_error( 'get_variable_2d_real', 530, variable_name ) 4785 ! 4786 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4787 DO i = is, ie 4788 DO j = js, je 4789 var(j-js+1,i-is+1) = tmp(i,j) 4759 4790 ENDDO 4791 ENDDO 4760 4792 4761 4793 DEALLOCATE( tmp ) 4762 4794 4763 4795 #endif … … 5171 5203 #endif 5172 5204 END SUBROUTINE get_variable_4d_to_3d_real 5205 5206 !------------------------------------------------------------------------------! 5207 ! Description: 5208 ! ------------ 5209 !> Reads a 3D float variables from dynamic driver with the last dimension only 5210 !> having 1 entry (time,z). Please note, 5211 !> the passed arguments are start indices and number of elements in each 5212 !> dimension, which is in contrast to the other 3d versions where start- and 5213 !> end indices are passed. The different handling compared to get_variable_2d_real 5214 !> is due to its different start-index treatment. 5215 !------------------------------------------------------------------------------! 5216 SUBROUTINE get_variable_2d_real_dynamic( id, variable_name, var, & 5217 i1s, i2s, & 5218 count_1, count_2 ) 5219 5220 USE indices 5221 USE pegrid 5222 5223 IMPLICIT NONE 5224 5225 CHARACTER(LEN=*) :: variable_name !< variable name 5226 5227 INTEGER(iwp) :: count_1 !< number of elements to be read along 1st dimension (with respect to file) 5228 INTEGER(iwp) :: count_2 !< number of elements to be read along 2nd dimension (with respect to file) 5229 INTEGER(iwp) :: i1 !< running index along 1st dimension on file 5230 INTEGER(iwp) :: i1s !< start index for subdomain input along 1st dimension (with respect to file) 5231 INTEGER(iwp) :: i2 !< running index along 2nd dimension on file 5232 INTEGER(iwp) :: i2s !< start index for subdomain input along 2nd dimension (with respect to file) 5233 INTEGER(iwp), INTENT(IN) :: id !< file id 5234 INTEGER(iwp) :: id_var !< variable id 5235 INTEGER(iwp) :: lb1 !< lower bound of 1st dimension (with respect to file) 5236 INTEGER(iwp) :: lb2 !< lower bound of 2nd dimension (with respect to file) 5237 INTEGER(iwp) :: ub1 !< upper bound of 1st dimension (with respect to file) 5238 INTEGER(iwp) :: ub2 !< upper bound of 2nd dimension (with respect to file) 5239 5240 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according to its reverse memory access 5241 5242 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< input variable 5243 5244 #if defined( __netcdf ) 5245 ! 5246 !-- Inquire variable id. 5247 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 5248 ! 5249 !-- Allocate temporary variable according to memory access on file. 5250 !-- Therefore, determine dimension bounds of input array. 5251 lb1 = LBOUND(var,2) 5252 ub1 = UBOUND(var,2) 5253 lb2 = LBOUND(var,1) 5254 ub2 = UBOUND(var,1) 5255 5256 ALLOCATE( tmp(lb1:ub1,lb2:ub2) ) 5257 ! 5258 !-- Get variable 5259 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 5260 start = (/ i1s, i2s /), & 5261 count = (/ count_1, count_2 /) ) 5262 5263 CALL handle_error( 'get_variable_2d_real_dynamic', 537, variable_name ) 5264 ! 5265 !-- Resort data. Please note, dimension subscripts of var all start at 1. 5266 DO i2 = lb2, ub2 5267 DO i1 = lb1, ub1 5268 var(i2,i1,1) = tmp(i1,i2) 5269 ENDDO 5270 ENDDO 5271 5272 DEALLOCATE( tmp ) 5273 #endif 5274 END SUBROUTINE get_variable_2d_real_dynamic 5173 5275 5174 5276 !------------------------------------------------------------------------------!
Note: See TracChangeset
for help on using the changeset viewer.
