- Timestamp:
- Jul 24, 2019 3:17:16 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/data_output_module.f90 (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/data_output_module.f90
r4113 r4116 142 142 143 143 INTEGER(iwp) :: debug_output_unit !< Fortran Unit Number of the debug-output file 144 INTEGER (iwp) :: nf!< number of files144 INTEGER :: nf = 0 !< number of files 145 145 INTEGER :: master_rank = 0 !< master rank for tasks to be executed by single PE only 146 146 INTEGER :: output_group_comm !< MPI communicator addressing all MPI ranks which participate in output … … 282 282 WRITE( debug_output_unit, '(A)' ) REPEAT( separation_string // ' ', 4 ) 283 283 284 IF ( .NOT. ALLOCATED( files )) THEN284 IF ( .NOT. ALLOCATED( files ) .OR. nf == 0 ) THEN 285 285 286 286 WRITE( debug_output_unit, '(A)' ) 'database is empty' … … 293 293 ',(": ")' 294 294 295 nf = SIZE( files )296 295 DO f = 1, nf 297 296 … … 679 678 return_value = 0 680 679 680 CALL internal_message( 'debug', routine_name // ': define file "' // TRIM( filename ) // '"' ) 681 681 682 !-- Allocate file list or extend it by 1 682 683 IF ( .NOT. ALLOCATED( files ) ) THEN … … 768 769 return_value = 0 769 770 771 CALL internal_message( 'debug', routine_name // & 772 ': define dimension "' // TRIM( name ) // & 773 '" in file "' // TRIM( filename ) // '"' ) 774 770 775 dimension%name = TRIM( name ) 771 776 dimension%data_type = TRIM( output_type ) … … 782 787 IF ( PRESENT( mask ) ) THEN 783 788 return_value = 1 784 CALL internal_message( 'error', routine_name // &785 ': unlimited dimension ' // TRIM( name ) // &786 ' in file ' // TRIM( filename ) // 'cannot be masked' )789 CALL internal_message( 'error', routine_name // & 790 ': unlimited dimension "' // TRIM( name ) // & 791 '" in file "' // TRIM( filename ) // '" cannot be masked' ) 787 792 ENDIF 788 793 … … 982 987 983 988 return_value = 1 984 CALL internal_message( 'error', routine_name // & 985 ': dimension ' // TRIM( name ) // & 986 ': At least one but no more than two bounds must be given' ) 989 CALL internal_message( 'error', routine_name // & 990 ': at least one but no more than two bounds must be given ' // & 991 '(dimension "' // TRIM( name ) // & 992 '", file "' // TRIM( filename ) // & 993 '")!' ) 987 994 988 995 ENDIF … … 1065 1072 IF ( f > nf ) THEN 1066 1073 return_value = 1 1067 CALL internal_message( 'error', routine_name // & 1068 ': file "' // TRIM( filename ) // '" not found' ) 1074 CALL internal_message( 'error', routine_name // & 1075 ': file not found (dimension "' // TRIM( name ) // & 1076 '", file "' // TRIM( filename ) // '")!' ) 1069 1077 ENDIF 1070 1078 … … 1104 1112 1105 1113 return_value = 0 1114 1115 CALL internal_message( 'debug', routine_name // & 1116 ': define variable "' // TRIM( name ) // & 1117 '" in file "' // TRIM( filename ) // '"' ) 1106 1118 1107 1119 variable%name = TRIM( name ) … … 1158 1170 IF ( .NOT. found ) THEN 1159 1171 return_value = 1 1160 CALL internal_message( 'error', &1161 routine_name // &1162 ': variable "' // TRIM( name ) //&1163 '" in file "' // TRIM( filename ) //&1164 '" : required dimension "' //&1165 TRIM( variable%dimension_names(i)) // &1166 '" not defined' )1172 CALL internal_message( 'error', & 1173 routine_name // & 1174 ': required dimension "' // & 1175 TRIM( variable%dimension_names(i) ) // & 1176 '" for variable "' // TRIM( name ) // & 1177 '" is not defined in file "' // TRIM( filename ) // & 1178 '"!' ) 1167 1179 EXIT 1168 1180 ENDIF … … 1173 1185 1174 1186 return_value = 1 1175 CALL internal_message( 'error', routine_name // & 1176 ': file "' // TRIM( filename ) // & 1177 '" has no dimensions defined' ) 1187 CALL internal_message( 'error', routine_name // & 1188 ': cannot define variable "' // TRIM( name ) // & 1189 '" in file "' // TRIM( filename ) // & 1190 '" because no dimensions defined in file.' ) 1178 1191 1179 1192 ENDIF … … 1193 1206 IF ( files(f)%variables(i)%name == variable%name ) THEN 1194 1207 return_value = 1 1195 CALL internal_message( 'error', routine_name // 1196 ': variable "' // TRIM( name ) //&1197 '" in file "' // TRIM( filename ) //&1198 '": variable already exists' )1208 CALL internal_message( 'error', routine_name // & 1209 ': variable "' // TRIM( name ) // & 1210 '" already exists in file "' // & 1211 TRIM( filename ) // '"!' ) 1199 1212 EXIT 1200 1213 ENDIF … … 1227 1240 IF ( f > nf ) THEN 1228 1241 return_value = 1 1229 CALL internal_message( 'error', routine_name // & 1230 ': variable "' // TRIM( name ) // & 1231 '": file "' // TRIM( filename ) // & 1232 '" not found' ) 1242 CALL internal_message( 'error', routine_name // & 1243 ': file not found (variable "' // TRIM( name ) // & 1244 '", file "' // TRIM( filename ) // '")!' ) 1233 1245 ENDIF 1234 1246 … … 1271 1283 IF ( PRESENT( variable ) ) THEN 1272 1284 return_value = dom_def_att_save( TRIM( filename ), TRIM( variable ), & 1273 1285 attribute=attribute, append=append_internal ) 1274 1286 ELSE 1275 1287 return_value = dom_def_att_save( TRIM( filename ), & 1276 1288 attribute=attribute, append=append_internal ) 1277 1289 ENDIF 1278 1290 … … 1574 1586 return_value = 0 1575 1587 found = .FALSE. 1588 1589 IF ( PRESENT( variable_name ) ) THEN 1590 CALL internal_message( 'debug', routine_name // & 1591 ': define attribute "' // TRIM( attribute%name ) // & 1592 '" of variable "' // TRIM( variable_name ) // & 1593 '" in file "' // TRIM( filename ) // '"' ) 1594 ELSE 1595 CALL internal_message( 'debug', routine_name // & 1596 ': define attribute "' // TRIM( attribute%name ) // & 1597 '" in file "' // TRIM( filename ) // '"' ) 1598 ENDIF 1576 1599 1577 1600 DO f = 1, nf … … 1772 1795 CALL internal_message( 'error', & 1773 1796 routine_name // & 1774 ': requested file "' // TRIM( variable_name ) //&1797 ': requested file "' // TRIM( filename ) // & 1775 1798 '" for attribute "' // TRIM( attribute%name ) // & 1776 1799 '" does not exist' ) … … 1815 1838 1816 1839 1840 return_value = 0 1841 CALL internal_message( 'debug', routine_name // ': start' ) 1842 1817 1843 !-- Clear database from empty files and unused dimensions 1818 return_value = cleanup_database()1844 IF ( nf > 0 ) return_value = cleanup_database() 1819 1845 1820 1846 IF ( return_value == 0 ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
