Changeset 4792 for palm/trunk/SOURCE
- Timestamp:
- Nov 23, 2020 1:02:38 PM (4 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
data_output_particle_mod.f90 (modified) (3 diffs)
-
netcdf_interface_mod.f90 (modified) (308 diffs)
Legend:
- Unmodified
- Added
- Removed
-
TabularUnified palm/trunk/SOURCE/data_output_particle_mod.f90 ¶
r4779 r4792 24 24 ! ----------------- 25 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4779 2020-11-09 17:45:22Z suehring 26 29 ! Avoid overlong lines and unused variables 27 30 ! … … 30 33 ! 31 34 ! 35 !--------------------------------------------------------------------------------------------------! 32 36 ! Description: 33 37 ! ------------ … … 37 41 38 42 #if defined( __parallel ) 39 USE MPI43 USE MPI 40 44 #endif 41 45 42 46 #if defined( __netcdf4 ) 43 USE NETCDF 44 #endif 45 46 USE, INTRINSIC :: ISO_C_BINDING 47 48 USE kinds, & 49 ONLY: wp, iwp, sp, dp, idp, isp 50 51 USE indices, & 52 ONLY: nbgp, nnx, nny, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz, nzb, nzt 53 54 USE control_parameters, & 55 ONLY: end_time, simulated_time, dt_dopts 56 57 USE pegrid, & 58 ONLY: comm1dx, comm1dy, comm2d, myid, myidx, myidy, npex, npey, numprocs, pdims 59 60 USE particle_attributes, & 61 ONLY: particle_type, particles, grid_particle_def, grid_particles, prt_count, & 62 unlimited_dimension, pts_id_file, data_output_pts, pts_increment, pts_percentage, & 63 oversize, number_of_output_particles 64 65 USE shared_memory_io_mod, & 66 ONLY: sm_class 67 68 USE data_output_netcdf4_module, & 69 ONLY: netcdf4_init_dimension, netcdf4_get_error_message, netcdf4_stop_file_header_definition, & 70 netcdf4_init_module, netcdf4_init_variable, netcdf4_finalize, & 71 netcdf4_open_file, netcdf4_write_attribute, netcdf4_write_variable 72 73 USE cpulog, & 74 ONLY: cpu_log, log_point_s 75 76 IMPLICIT NONE 77 78 PRIVATE 79 SAVE 80 81 82 LOGICAL, PUBLIC :: dop_active = .FALSE. 83 84 85 ! Variables for restart 86 87 INTEGER(iwp), PUBLIC :: dop_prt_axis_dimension 88 INTEGER(iwp), PUBLIC :: dop_last_active_particle 89 90 91 92 93 !kk Private module variables can be declared inside the submodule 94 95 INTEGER,PARAMETER :: MAX_NR_VARIABLES = 128 96 INTEGER,PARAMETER :: NR_FIXED_VARIABLES = 16 97 98 CHARACTER(LEN=32) :: file_name !< Name of NetCDF file 99 INTEGER(iwp) :: nr_time_values !< Number of values on time axis 100 REAL(sp),ALLOCATABLE,DIMENSION(:) :: time_axis_values !< time axis Values 101 INTEGER(iwp),ALLOCATABLE,DIMENSION(:,:) :: rma_particles !< Start address and number of remote particles 102 INTEGER(iwp) :: nr_particles_PE !< Number of particles assigned for output on this thread 103 INTEGER(iwp) :: nr_particles_out !< total number od particles assigned for output 104 105 INTEGER(iwp),ALLOCATABLE,DIMENSION(:,:) :: sh_indices !< Indices in shared memory group 106 INTEGER(iwp),ALLOCATABLE,DIMENSION(:,:) :: io_indices !< Indices on IO processes 107 INTEGER(iwp),ALLOCATABLE,DIMENSION(:,:) :: mo_indices !< Indices for model communicator 108 INTEGER(iwp),ALLOCATABLE,DIMENSION(:,:) :: remote_nr_particles 109 INTEGER(iwp) :: start_local_numbering !< start increment 1 numbering on this thread 110 INTEGER(iwp) :: end_local_numbering 111 INTEGER(iwp) :: pe_start_index !< start index of the output area on this thread 112 INTEGER(iwp) :: pe_end_index 113 INTEGER(iwp) :: io_start_index !< start index of the output area on IO thread 114 INTEGER(iwp) :: io_end_index 115 INTEGER(iwp) :: nr_particles_rest !< Numbere of rest Particle (ireg. distribution) 116 LOGICAL :: irregular_distribubtion !< irregular distribution of output particlesexit 117 118 TYPE var_def 119 INTEGER(iwp) :: var_id 120 CHARACTER(len=32) :: name 121 CHARACTER(len=32) :: units 122 LOGICAL :: is_integer = .FALSE. 123 END TYPE var_def 124 125 TYPE(var_def),DIMENSION(MAX_NR_VARIABLES) :: variables 126 TYPE(var_def),DIMENSION(NR_FIXED_VARIABLES) :: fix_variables 127 128 TYPE(sm_class) :: part_io !< manage communicator for particle IO 129 130 ! 131 ! NetCDF 132 133 INTEGER(iwp) :: file_id = -1 !< id of Netcdf file 134 INTEGER(iwp) :: nr_fix_variables !< Number of fixed variables scheduled for output 135 INTEGER(iwp) :: nr_variables !< Number of variables scheduled for output 136 137 TYPE dimension_id 138 INTEGER(iwp) :: prt 139 INTEGER(iwp) :: time 140 END TYPE dimension_id 141 142 TYPE variable_id 143 INTEGER(iwp) :: prt 144 INTEGER(iwp) :: time 145 END TYPE variable_id 146 147 TYPE(dimension_id) :: did 148 TYPE(variable_id) :: var_id 149 150 ! shared memory buffer 151 INTEGER(iwp) :: win_prt_i = -1 ! integer MPI shared Memory window 152 INTEGER(iwp) :: win_prt_r = -1 !< real MPI shared Memory window 153 INTEGER(iwp), POINTER, CONTIGUOUS, DIMENSION(:) :: out_buf_i !< integer output buffer 154 REAL(sp), POINTER, CONTIGUOUS, DIMENSION(:) :: out_buf_r !< real output buffer 155 156 ! 157 ! Particle list in file 158 159 LOGICAL :: part_list_in_file 160 INTEGER(idp),ALLOCATABLE, DIMENSION(:) :: part_id_list_file 161 ! 162 ! RMA window 163 #if defined( __parallel ) 164 INTEGER(iwp) :: win_rma_buf_i 165 INTEGER(iwp) :: win_rma_buf_r 166 #endif 167 168 INTEGER(iwp),POINTER,DIMENSION(:) :: transfer_buffer_i !< rma window to provide data, which can be fetch via MPI_Get 169 REAL(sp),POINTER,DIMENSION(:) :: transfer_buffer_r !< Same for REAL 170 INTEGER(iwp),ALLOCATABLE,DIMENSION(:) :: remote_indices !< particle nubmer of the remodte partices, used as indices in the output array 171 INTEGER(iwp) :: initial_number_of_active_particles 172 173 ! Public subroutine Interface 174 175 INTERFACE dop_init 176 MODULE PROCEDURE dop_init 177 END INTERFACE dop_init 178 179 INTERFACE dop_output_tseries 180 MODULE PROCEDURE dop_output_tseries 181 END INTERFACE dop_output_tseries 182 183 INTERFACE dop_finalize 184 MODULE PROCEDURE dop_finalize 185 END INTERFACE dop_finalize 186 187 #if defined( __parallel ) 188 INTERFACE dop_alloc_rma_mem 189 MODULE PROCEDURE dop_alloc_rma_mem_i1 190 MODULE PROCEDURE dop_alloc_rma_mem_r1 191 END INTERFACE dop_alloc_rma_mem 192 #endif 193 194 PUBLIC dop_init, dop_output_tseries, dop_finalize 195 #if defined( __parallel ) 196 PUBLIC dop_alloc_rma_mem ! Must be PUBLIC on NEC, although it is only used in Submodule 197 #endif 198 47 USE NETCDF 48 #endif 49 50 USE, INTRINSIC :: ISO_C_BINDING 51 52 USE kinds, & 53 ONLY: dp, idp, isp, iwp, sp, wp 54 55 USE indices, & 56 ONLY: nbgp, nnx, nny, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz, nzb, nzt 57 58 USE control_parameters, & 59 ONLY: dt_dopts, end_time, simulated_time 60 61 USE pegrid, & 62 ONLY: comm1dx, comm1dy, comm2d, myid, myidx, myidy, npex, npey, numprocs, pdims 63 64 USE particle_attributes, & 65 ONLY: data_output_pts, grid_particles, grid_particle_def, number_of_output_particles, & 66 particles, particle_type, prt_count, pts_id_file, pts_increment, pts_percentage, & 67 oversize, unlimited_dimension 68 69 USE shared_memory_io_mod, & 70 ONLY: sm_class 71 72 USE data_output_netcdf4_module, & 73 ONLY: netcdf4_finalize, netcdf4_get_error_message, netcdf4_init_dimension, & 74 netcdf4_init_module, netcdf4_init_variable, netcdf4_open_file, & 75 netcdf4_stop_file_header_definition, netcdf4_write_attribute, netcdf4_write_variable 76 77 USE cpulog, & 78 ONLY: cpu_log, log_point_s 79 80 IMPLICIT NONE 81 82 PRIVATE 83 SAVE 84 85 86 LOGICAL, PUBLIC :: dop_active = .FALSE. 87 88 ! 89 !-- Variables for restart 90 INTEGER(iwp), PUBLIC :: dop_prt_axis_dimension 91 INTEGER(iwp), PUBLIC :: dop_last_active_particle 92 93 ! 94 !-- kk Private module variables can be declared inside the submodule 95 INTEGER, PARAMETER :: max_nr_variables = 128 96 INTEGER, PARAMETER :: nr_fixed_variables = 16 97 98 CHARACTER(LEN=32) :: file_name !< Name of NetCDF file 99 100 INTEGER(iwp) :: end_local_numbering 101 INTEGER(iwp) :: io_end_index 102 INTEGER(iwp) :: io_start_index !< Start index of the output area on IO thread 103 INTEGER(iwp) :: nr_particles_pe !< Number of particles assigned for output on this thread 104 INTEGER(iwp) :: nr_particles_rest !< Numbere of rest Particle (ireg. distribution) 105 INTEGER(iwp) :: nr_particles_out !< Total number od particles assigned for output 106 INTEGER(iwp) :: nr_time_values !< Number of values on time axis 107 INTEGER(iwp) :: pe_end_index 108 INTEGER(iwp) :: pe_start_index !< Start index of the output area on this thread 109 INTEGER(iwp) :: start_local_numbering !< Start increment 1 numbering on this thread 110 111 INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) :: io_indices !< Indices on IO processes 112 INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) :: mo_indices !< Indices for model communicator 113 INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) :: remote_nr_particles 114 INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) :: rma_particles !< Start address and number of remote particles 115 INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) :: sh_indices !< Indices in shared memory group 116 117 LOGICAL :: irregular_distribubtion !< irregular distribution of output particlesexit 118 119 REAL(sp), ALLOCATABLE, DIMENSION(:) :: time_axis_values !< time axis Values 120 121 TYPE var_def 122 INTEGER(iwp) :: var_id 123 CHARACTER(LEN=32) :: name 124 CHARACTER(LEN=32) :: units 125 LOGICAL :: is_integer = .FALSE. 126 END TYPE var_def 127 128 TYPE(sm_class) :: part_io !< manage communicator for particle IO 129 130 TYPE(var_def), DIMENSION(nr_fixed_variables) :: fix_variables 131 TYPE(var_def), DIMENSION(max_nr_variables) :: variables 132 133 ! 134 !-- NetCDF 135 INTEGER(iwp) :: file_id = -1 !< id of Netcdf file 136 INTEGER(iwp) :: nr_fix_variables !< Number of fixed variables scheduled for output 137 INTEGER(iwp) :: nr_variables !< Number of variables scheduled for output 138 139 TYPE dimension_id 140 INTEGER(iwp) :: prt 141 INTEGER(iwp) :: time 142 END TYPE dimension_id 143 144 TYPE variable_id 145 INTEGER(iwp) :: prt 146 INTEGER(iwp) :: time 147 END TYPE variable_id 148 149 TYPE(dimension_id) :: did 150 TYPE(variable_id) :: var_id 151 152 ! 153 !-- Shared memory buffer 154 INTEGER(iwp) :: win_prt_i = -1 !< integer MPI shared Memory window 155 INTEGER(iwp) :: win_prt_r = -1 !< real MPI shared Memory window 156 INTEGER(iwp), POINTER, CONTIGUOUS, DIMENSION(:) :: out_buf_i !< integer output buffer 157 REAL(sp), POINTER, CONTIGUOUS, DIMENSION(:) :: out_buf_r !< real output buffer 158 159 ! 160 !-- Particle list in file 161 INTEGER(idp), ALLOCATABLE, DIMENSION(:) :: part_id_list_file 162 163 LOGICAL :: part_list_in_file 164 165 ! 166 !-- RMA window 167 #if defined( __parallel ) 168 INTEGER(iwp) :: win_rma_buf_i 169 INTEGER(iwp) :: win_rma_buf_r 170 #endif 171 172 INTEGER(iwp) :: initial_number_of_active_particles 173 INTEGER(iwp), ALLOCATABLE, DIMENSION(:) :: remote_indices !< particle nubmer of the remodte partices, 174 !< used as indices in the output array 175 INTEGER(iwp), POINTER, DIMENSION(:) :: transfer_buffer_i !< rma window to provide data, which can be 176 !< fetch via MPI_Get 177 REAL(sp), POINTER, DIMENSION(:) :: transfer_buffer_r !< Same for REAL 178 179 ! 180 !-- Public subroutine Interface 181 INTERFACE dop_init 182 MODULE PROCEDURE dop_init 183 END INTERFACE dop_init 184 185 INTERFACE dop_output_tseries 186 MODULE PROCEDURE dop_output_tseries 187 END INTERFACE dop_output_tseries 188 189 INTERFACE dop_finalize 190 MODULE PROCEDURE dop_finalize 191 END INTERFACE dop_finalize 192 193 #if defined( __parallel ) 194 INTERFACE dop_alloc_rma_mem 195 MODULE PROCEDURE dop_alloc_rma_mem_i1 196 MODULE PROCEDURE dop_alloc_rma_mem_r1 197 END INTERFACE dop_alloc_rma_mem 198 #endif 199 200 PUBLIC dop_init, dop_output_tseries, dop_finalize 201 #if defined( __parallel ) 202 PUBLIC dop_alloc_rma_mem ! Must be PUBLIC on NEC, although it is only used in submodule 203 #endif 199 204 200 205 201 206 CONTAINS 202 207 203 SUBROUTINE dop_init (read_restart) 204 IMPLICIT NONE 205 LOGICAL,INTENT(IN) :: read_restart 206 207 INTEGER(iwp) :: i !< 208 INTEGER(iwp) :: nr_particles_local !< total number of particles scheduled for output on this thread 209 #if defined( __parallel ) 210 INTEGER(iwp) :: ierr !< MPI error code 211 #endif 212 INTEGER(idp) :: nr_particles_8 !< Total number of particles in 64 bit 213 REAL(dp) :: xnr_part !< Must be 64 Bit REAL 214 INTEGER(iwp) :: nr_local_last_pe !< Number of output particles on myid == numprocs-2 215 216 INTEGER(iwp),DIMENSION(0:numprocs-1) :: nr_particles_all_s 217 INTEGER(iwp),DIMENSION(0:numprocs-1) :: nr_particles_all_r 218 INTEGER(idp),DIMENSION(0:numprocs-1) :: nr_particles_all_8 219 220 INTEGER(iwp),ALLOCATABLE,DIMENSION(:,:) :: sh_indices_s 221 INTEGER(iwp),ALLOCATABLE,DIMENSION(:,:) :: io_indices_s 222 INTEGER(iwp),ALLOCATABLE,DIMENSION(:,:) :: mo_indices_s 223 224 part_list_in_file = (pts_id_file /= ' ') 225 226 IF(.NOT. part_list_in_file) THEN 227 IF(.NOT. read_restart) THEN 228 229 CALL set_indef_particle_nr 230 231 CALL count_output_particles (nr_particles_local) 232 233 nr_particles_all_s = 0 234 nr_particles_all_s(myid) = nr_particles_local 235 236 #if defined( __parallel ) 237 CALL MPI_ALLREDUCE( nr_particles_all_s, nr_particles_all_r, SIZE( nr_particles_all_s ), MPI_INTEGER, & 238 MPI_SUM, comm2d, ierr ) 208 209 !--------------------------------------------------------------------------------------------------! 210 ! Description: 211 ! ------------ 212 ! 213 !--------------------------------------------------------------------------------------------------! 214 SUBROUTINE dop_init( read_restart ) 215 IMPLICIT NONE 216 217 INTEGER(iwp) :: i !< 218 #if defined( __parallel ) 219 INTEGER(iwp) :: ierr !< MPI error code 220 #endif 221 INTEGER(iwp) :: nr_local_last_pe !< Number of output particles on myid == numprocs-2 222 INTEGER(idp) :: nr_particles_8 !< Total number of particles in 64 bit 223 INTEGER(iwp) :: nr_particles_local !< total number of particles scheduled for output on this thread 224 225 INTEGER(idp), DIMENSION(0:numprocs-1) :: nr_particles_all_8 226 INTEGER(iwp), DIMENSION(0:numprocs-1) :: nr_particles_all_s 227 INTEGER(iwp), DIMENSION(0:numprocs-1) :: nr_particles_all_r 228 229 INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) :: io_indices_s 230 INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) :: mo_indices_s 231 INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) :: sh_indices_s 232 233 LOGICAL, INTENT(IN) :: read_restart 234 235 REAL(dp) :: xnr_part !< Must be 64 Bit REAL 236 237 238 part_list_in_file = (pts_id_file /= ' ') 239 240 IF ( .NOT. part_list_in_file ) THEN 241 IF ( .NOT. read_restart) THEN 242 243 CALL set_indef_particle_nr 244 245 CALL count_output_particles( nr_particles_local ) 246 247 nr_particles_all_s = 0 248 nr_particles_all_s(myid) = nr_particles_local 249 250 #if defined( __parallel ) 251 CALL MPI_ALLREDUCE( nr_particles_all_s, nr_particles_all_r, SIZE( nr_particles_all_s ), & 252 MPI_INTEGER, MPI_SUM, comm2d, ierr ) 239 253 #else 240 nr_particles_all_r = nr_particles_all_s 241 #endif 242 243 initial_number_of_active_particles = SUM(nr_particles_all_r) 244 245 start_local_numbering = 1 246 end_local_numbering = nr_particles_all_r(0) 247 248 IF ( myid > 0) THEN 249 DO i=1,numprocs-1 250 start_local_numbering = start_local_numbering+nr_particles_all_r(i-1) 251 end_local_numbering = start_local_numbering+nr_particles_all_r(i)-1 252 IF(myid == i) EXIT 253 ENDDO 254 END IF 255 256 nr_particles_all_8 = nr_particles_all_r ! Use 64 INTEGER, maybe more than 2 GB particles 257 nr_particles_8 = SUM(nr_particles_all_8) 258 IF (nr_particles_8 > 2000000000_8) THEN ! This module works only with 32 Bit INTEGER 259 write(9,*) 'Number of particles too large ',nr_particles_8; flush(9) 260 #if defined( __parallel ) 261 CALL MPI_ABORT (MPI_COMM_WORLD, 1, ierr) 262 #endif 263 ENDIF 264 nr_particles_out = nr_particles_8 ! Total number of particles scheduled for output 265 266 ! 267 !-- reserve space for additional particle 268 IF(number_of_output_particles > 0) THEN 269 nr_particles_out = MAX(number_of_output_particles, nr_particles_out) 270 ELSE IF(oversize > 100.) THEN 271 xnr_part = nr_particles_out*oversize/100. 272 nr_particles_out = xnr_part 273 ENDIF 274 ELSE 275 nr_particles_out = dop_prt_axis_dimension ! Get Number from restart file 276 initial_number_of_active_particles = dop_last_active_particle 277 ENDIF 278 279 ELSE 280 CALL set_indef_particle_nr 281 CALL dop_read_output_particle_list (nr_particles_out) 282 ENDIF 283 dop_prt_axis_dimension = nr_particles_out 284 ! 285 !-- The number of particles must be at least the number of MPI processes 286 287 nr_particles_out = MAX(nr_particles_out, numprocs) 288 289 290 nr_particles_PE = (nr_particles_out+numprocs-1)/numprocs ! Number of paricles scheduled for ouput on this thread 291 292 pe_start_index = myid*nr_particles_PE+1 !Output numberimng on this thread 293 pe_end_index = MIN((myid+1)*nr_particles_PE,nr_particles_out) 294 295 irregular_distribubtion = .FALSE. 296 #if defined( __parallel ) 297 ! 298 !-- In case of few particles, it can happen that not only the last thread gets fewer output particles. 299 !-- In this case, the local number of particles on thread numprocs-1 will be < 1 300 !-- If this happens, irregular distribution of output particles will be used 301 302 IF(myid == numprocs-1) Then 303 nr_local_last_pe = pe_end_index-pe_start_index+1 304 ELSE 305 nr_local_last_pe = 0 306 ENDIF 307 CALL MPI_BCAST (nr_local_last_pe, 1, MPI_INTEGER, numprocs-1, comm2d, ierr) 254 nr_particles_all_r = nr_particles_all_s 255 #endif 256 257 initial_number_of_active_particles = SUM( nr_particles_all_r ) 258 259 start_local_numbering = 1 260 end_local_numbering = nr_particles_all_r(0) 261 262 IF ( myid > 0 ) THEN 263 DO i = 1, numprocs-1 264 start_local_numbering = start_local_numbering+nr_particles_all_r(i-1) 265 end_local_numbering = start_local_numbering+nr_particles_all_r(i)-1 266 IF ( myid == i ) EXIT 267 ENDDO 268 ENDIF 269 270 nr_particles_all_8 = nr_particles_all_r ! Use 64 INTEGER, maybe more than 2 GB particles 271 nr_particles_8 = SUM( nr_particles_all_8 ) 272 IF ( nr_particles_8 > 2000000000_idp ) THEN ! This module works only with 32 Bit INTEGER 273 WRITE( 9, * ) 'Number of particles too large ', nr_particles_8 ; FLUSH( 9 ) 274 #if defined( __parallel ) 275 CALL MPI_ABORT( MPI_COMM_WORLD, 1, ierr ) 276 #endif 277 ENDIF 278 nr_particles_out = nr_particles_8 ! Total number of particles scheduled for output 279 280 ! 281 !-- Reserve space for additional particle 282 IF ( number_of_output_particles > 0 ) THEN 283 nr_particles_out = MAX( number_of_output_particles, nr_particles_out ) 284 ELSEIF ( oversize > 100.0_wp ) THEN 285 xnr_part = nr_particles_out * oversize / 100.0_wp 286 nr_particles_out = xnr_part 287 ENDIF 288 ELSE 289 nr_particles_out = dop_prt_axis_dimension ! Get Number from restart file 290 initial_number_of_active_particles = dop_last_active_particle 291 ENDIF 292 293 ELSE 294 CALL set_indef_particle_nr 295 CALL dop_read_output_particle_list( nr_particles_out ) 296 ENDIF 297 dop_prt_axis_dimension = nr_particles_out 298 299 ! 300 !-- The number of particles must be at least the number of MPI processes 301 nr_particles_out = MAX( nr_particles_out, numprocs ) 302 303 304 nr_particles_pe = ( nr_particles_out + numprocs - 1 ) / numprocs ! Number of paricles scheduled for ouput on this thread 305 306 pe_start_index = myid * nr_particles_pe + 1 !Output numberimng on this thread 307 pe_end_index = MIN( ( myid + 1 ) * nr_particles_pe, nr_particles_out ) 308 309 irregular_distribubtion = .FALSE. 310 #if defined( __parallel ) 311 ! 312 !-- In case of few particles, it can happen that not only the last thread gets fewer output 313 !-- particles. In this case, the local number of particles on thread numprocs-1 will be < 1. 314 !-- If this happens, irregular distribution of output particles will be used. 315 IF ( myid == numprocs-1 ) THEN 316 nr_local_last_pe = pe_end_index-pe_start_index + 1 317 ELSE 318 nr_local_last_pe = 0 319 ENDIF 320 CALL MPI_BCAST( nr_local_last_pe, 1, MPI_INTEGER, numprocs-1, comm2d, ierr ) 308 321 #else 309 nr_local_last_pe = nr_particles_PE310 #endif 311 IF(nr_local_last_pe < 1)THEN312 313 314 315 316 317 IF(.NOT. read_restart .AND. .NOT. part_list_in_file)THEN318 319 320 321 IF(part_list_in_file)THEN322 323 324 325 CALL part_io%sm_init_data_output_particles ()326 327 ALLOCATE (sh_indices_s(2,0:part_io%sh_npes-1))328 ALLOCATE (sh_indices(2,0:part_io%sh_npes-1))329 330 331 #if defined( __parallel ) 332 333 334 335 336 CALL MPI_ALLREDUCE( sh_indices_s, sh_indices, 2*part_io%sh_npes, MPI_INTEGER,&337 MPI_SUM,part_io%comm_shared, ierr )338 339 340 322 nr_local_last_pe = nr_particles_pe 323 #endif 324 IF ( nr_local_last_pe < 1 ) THEN 325 irregular_distribubtion = .TRUE. 326 CALL dop_setup_ireg_distribution 327 ENDIF 328 329 330 IF ( .NOT. read_restart .AND. .NOT. part_list_in_file ) THEN 331 CALL set_particle_number 332 ENDIF 333 334 IF ( part_list_in_file ) THEN 335 CALL dop_find_particle_in_outlist 336 ENDIF 337 338 CALL part_io%sm_init_data_output_particles( ) 339 340 ALLOCATE( sh_indices_s(2,0:part_io%sh_npes-1) ) 341 ALLOCATE( sh_indices(2,0:part_io%sh_npes-1) ) 342 343 344 #if defined( __parallel ) 345 sh_indices_s = 0 346 sh_indices_s(1,part_io%sh_rank) = pe_start_index 347 sh_indices_s(2,part_io%sh_rank) = pe_end_index 348 349 CALL MPI_ALLREDUCE( sh_indices_s, sh_indices, 2*part_io%sh_npes, MPI_INTEGER, MPI_SUM, & 350 part_io%comm_shared, ierr ) 351 352 io_start_index = sh_indices(1,0) ! output numbering on actual IO thread 353 io_end_index = sh_indices(2,part_io%sh_npes-1) 341 354 #else 342 io_start_index = pe_start_index ! output numbering 343 io_end_index = pe_end_index 344 #endif 345 346 347 #if defined( __parallel ) 348 CALL MPI_BCAST (part_io%io_npes, 1, MPI_INTEGER, 0, part_io%comm_shared, ierr) 349 #endif 350 ALLOCATE (io_indices(2,0:part_io%io_npes-1)) 351 IF (part_io%iam_io_pe) THEN 352 ALLOCATE (io_indices_s(2,0:part_io%io_npes-1)) 353 354 355 io_indices_s = 0 356 io_indices_s(1,part_io%io_rank) = io_start_index 357 io_indices_s(2,part_io%io_rank) = io_end_index 358 359 #if defined( __parallel ) 360 CALL MPI_ALLREDUCE( io_indices_s, io_indices, 2*part_io%io_npes, MPI_INTEGER, & 361 MPI_SUM, part_io%comm_io, ierr ) 355 io_start_index = pe_start_index ! output numbering 356 io_end_index = pe_end_index 357 #endif 358 359 360 #if defined( __parallel ) 361 CALL MPI_BCAST( part_io%io_npes, 1, MPI_INTEGER, 0, part_io%comm_shared, ierr ) 362 #endif 363 ALLOCATE( io_indices(2,0:part_io%io_npes-1) ) 364 IF ( part_io%iam_io_pe ) THEN 365 ALLOCATE( io_indices_s(2,0:part_io%io_npes-1) ) 366 367 io_indices_s = 0 368 io_indices_s(1,part_io%io_rank) = io_start_index 369 io_indices_s(2,part_io%io_rank) = io_end_index 370 371 #if defined( __parallel ) 372 CALL MPI_ALLREDUCE( io_indices_s, io_indices, 2 * part_io%io_npes, MPI_INTEGER, MPI_SUM, & 373 part_io%comm_io, ierr ) 362 374 #else 363 io_indices = io_indices_s 364 #endif 365 366 ENDIF 367 368 #if defined( __parallel ) 369 CALL MPI_BCAST (io_indices, size(io_indices), MPI_INTEGER, 0, part_io%comm_shared, ierr) 370 #endif 371 372 ALLOCATE (remote_nr_particles(2,0:numprocs-1)) 373 ALLOCATE (rma_particles(2,0:numprocs-1)) 374 375 ALLOCATE (mo_indices(2,0:numprocs-1)) 376 ALLOCATE (mo_indices_s(2,0:numprocs-1)) 377 378 379 mo_indices_s = 0 380 mo_indices_s(1,myid) = pe_start_index 381 mo_indices_s(2,myid) = pe_end_index 382 383 #if defined( __parallel ) 384 CALL MPI_ALLREDUCE( mo_indices_s, mo_indices, 2*numprocs, MPI_INTEGER, MPI_SUM, comm2d, ierr ) 375 io_indices = io_indices_s 376 #endif 377 378 ENDIF 379 380 #if defined( __parallel ) 381 CALL MPI_BCAST( io_indices, SIZE( io_indices ), MPI_INTEGER, 0, part_io%comm_shared, ierr ) 382 #endif 383 384 ALLOCATE( remote_nr_particles(2,0:numprocs-1) ) 385 ALLOCATE( rma_particles(2,0:numprocs-1) ) 386 387 ALLOCATE( mo_indices(2,0:numprocs-1) ) 388 ALLOCATE( mo_indices_s(2,0:numprocs-1) ) 389 390 mo_indices_s = 0 391 mo_indices_s(1,myid) = pe_start_index 392 mo_indices_s(2,myid) = pe_end_index 393 394 #if defined( __parallel ) 395 CALL MPI_ALLREDUCE( mo_indices_s, mo_indices, 2 * numprocs, MPI_INTEGER, MPI_SUM, comm2d, ierr ) 385 396 #else 386 mo_indices = mo_indices_s 387 #endif 388 389 !-- Allocate output buffer 390 391 #if defined( __parallel ) 392 CALL part_io%sm_allocate_shared (out_buf_r, io_start_index, io_end_index, win_prt_r) 393 CALL part_io%sm_allocate_shared (out_buf_i, io_start_index, io_end_index, win_prt_i) 397 mo_indices = mo_indices_s 398 #endif 399 400 !-- Allocate output buffer 401 #if defined( __parallel ) 402 CALL part_io%sm_allocate_shared( out_buf_r, io_start_index, io_end_index, win_prt_r ) 403 CALL part_io%sm_allocate_shared( out_buf_i, io_start_index, io_end_index, win_prt_i ) 394 404 #else 395 ALLOCATE(out_buf_r(io_start_index:io_end_index)) 396 ALLOCATE(out_buf_i(io_start_index:io_end_index)) 397 #endif 398 399 !-- NetCDF 400 401 CALL dop_netcdf_setup () 402 403 #if defined( __parallel ) 404 CALL MPI_BCAST (nr_fix_variables, 1, MPI_INTEGER, 0, part_io%comm_shared, ierr) 405 CALL MPI_BCAST (nr_variables, 1, MPI_INTEGER, 0, part_io%comm_shared, ierr) 406 #endif 407 408 CALL dop_count_remote_particles 409 410 CALL dop_write_fixed_variables 411 412 CALL deallocate_and_free 413 414 CALL dop_output_tseries 415 416 RETURN 417 CONTAINS 418 SUBROUTINE dop_setup_ireg_distribution 419 IMPLICIT NONE 420 421 422 nr_particles_PE = (nr_particles_out)/numprocs ! Number of paricles scheduled for ouput on this thread 423 424 nr_particles_rest = nr_particles_out - numprocs * nr_particles_PE 425 426 nr_particles_PE = nr_particles_PE+1 427 IF(myid < nr_particles_rest) THEN 428 pe_start_index = myid*nr_particles_PE+1 !Output numberimng on this thread 429 pe_end_index = MIN((myid+1)*nr_particles_PE,nr_particles_out) 430 ELSE 431 pe_start_index = nr_particles_rest*(nr_particles_PE)+(myid-nr_particles_rest)*(nr_particles_PE-1)+1 !Output numberimng on this thread 432 pe_end_index = MIN(pe_start_index+nr_particles_PE-2,nr_particles_out) 433 ENDIF 434 435 436 END SUBROUTINE dop_setup_ireg_distribution 437 438 END SUBROUTINE dop_init 439 ! 440 ! particle output on selected time steps 441 442 SUBROUTINE dop_output_tseries 443 IMPLICIT NONE 444 445 INTEGER(iwp) :: i !< 446 INTEGER(iwp) :: return_value !< Return value data_output_netcdf4 .. routines 447 #if defined( __parallel ) 448 INTEGER(iwp) :: ierr !< MPI error code 449 #endif 450 INTEGER(iwp),SAVE :: icount=0 !< count output steps 451 452 INTEGER(iwp),DIMENSION(2) :: bounds_origin, bounds_start, value_counts 453 REAl(wp),POINTER, CONTIGUOUS, DIMENSION(:) :: my_time 454 455 icount = icount+1 456 457 CALL dop_delete_particle_number 458 459 IF(part_list_in_file) THEN 460 461 CALL dop_find_particle_in_outlist 462 ELSE 463 CALL dop_newly_generated_particles 464 ENDIF 465 466 CALL dop_count_remote_particles 467 468 bounds_origin = 1 469 470 bounds_start(1) = io_start_index 471 bounds_start(2) = icount 472 473 value_counts(1) = io_end_index-io_start_index+1 474 value_counts(2) = 1 475 476 DO i=1,nr_variables 405 ALLOCATE( out_buf_r(io_start_index:io_end_index) ) 406 ALLOCATE( out_buf_i(io_start_index:io_end_index) ) 407 #endif 408 409 ! 410 !-- NetCDF 411 CALL dop_netcdf_setup( ) 412 413 #if defined( __parallel ) 414 CALL MPI_BCAST( nr_fix_variables, 1, MPI_INTEGER, 0, part_io%comm_shared, ierr ) 415 CALL MPI_BCAST( nr_variables, 1, MPI_INTEGER, 0, part_io%comm_shared, ierr ) 416 #endif 417 418 CALL dop_count_remote_particles 419 420 CALL dop_write_fixed_variables 421 422 CALL deallocate_and_free 423 424 CALL dop_output_tseries 425 426 RETURN 427 428 CONTAINS 429 430 431 !--------------------------------------------------------------------------------------------------! 432 ! Description: 433 ! ------------ 434 ! 435 !--------------------------------------------------------------------------------------------------! 436 SUBROUTINE dop_setup_ireg_distribution 437 438 IMPLICIT NONE 439 440 nr_particles_pe = ( nr_particles_out ) / numprocs ! Number of paricles scheduled for ouput on this thread 441 442 nr_particles_rest = nr_particles_out - numprocs * nr_particles_pe 443 444 nr_particles_pe = nr_particles_pe + 1 445 IF ( myid < nr_particles_rest ) THEN 446 pe_start_index = myid * nr_particles_pe + 1 ! Output numberimng on this thread 447 pe_end_index = MIN( ( myid + 1 ) * nr_particles_pe, nr_particles_out) 448 ELSE 449 pe_start_index = nr_particles_rest * ( nr_particles_pe ) & 450 + ( myid - nr_particles_rest ) * ( nr_particles_pe - 1 ) + 1 !Output numberimng on this thread 451 pe_end_index = MIN( pe_start_index + nr_particles_pe - 2, nr_particles_out ) 452 ENDIF 453 454 455 END SUBROUTINE dop_setup_ireg_distribution 456 457 END SUBROUTINE dop_init 458 459 460 !--------------------------------------------------------------------------------------------------! 461 ! Description: 462 ! ------------ 463 !> Particle output on selected time steps 464 !--------------------------------------------------------------------------------------------------! 465 SUBROUTINE dop_output_tseries 466 467 IMPLICIT NONE 468 469 INTEGER(iwp) :: i !< 470 INTEGER(iwp) :: return_value !< Return value data_output_netcdf4 .. routines 471 #if defined( __parallel ) 472 INTEGER(iwp) :: ierr !< MPI error code 473 #endif 474 INTEGER(iwp), SAVE :: icount=0 !< count output steps 475 476 INTEGER(iwp), DIMENSION(2) :: bounds_origin, bounds_start, value_counts 477 478 REAl(wp), POINTER, CONTIGUOUS, DIMENSION(:) :: my_time 479 480 icount = icount + 1 481 482 CALL dop_delete_particle_number 483 484 IF ( part_list_in_file ) THEN 485 486 CALL dop_find_particle_in_outlist 487 ELSE 488 CALL dop_newly_generated_particles 489 ENDIF 490 491 CALL dop_count_remote_particles 492 493 bounds_origin = 1 494 495 bounds_start(1) = io_start_index 496 bounds_start(2) = icount 497 498 value_counts(1) = io_end_index-io_start_index + 1 499 value_counts(2) = 1 500 501 DO i = 1, nr_variables 477 502 #if defined( __netcdf4 ) 478 IF(variables(i)%is_integer) THEN 479 out_buf_i = NF90_FILL_INT 480 ELSE 481 out_buf_r = NF90_FILL_REAL 482 ENDIF 483 #endif 484 485 CALL cpu_log( log_point_s(99), 'dop_fill_out_buf', 'start' ) 486 CALL dop_fill_out_buf (variables(i)) 487 CALL cpu_log( log_point_s(99), 'dop_fill_out_buf', 'stop' ) 488 489 CALL cpu_log( log_point_s(88), 'dop_get_remote_particle', 'start' ) 490 #if defined( __parallel ) 491 CALL dop_get_remote_particle (variables(i)%is_integer) 492 #endif 493 CALL cpu_log( log_point_s(88), 'dop_get_remote_particle', 'stop' ) 494 495 CALL cpu_log( log_point_s(89), 'particle NetCDF output', 'start' ) 496 CALL part_io%sm_node_barrier() 497 IF (part_io%iam_io_pe) THEN 498 IF(variables(i)%is_integer) THEN 499 CALL netcdf4_write_variable('parallel', file_id, variables(i)%var_id, bounds_start,& 500 value_counts, bounds_origin, & 501 .FALSE., values_int32_1d=out_buf_i, return_value=return_value) 502 ELSE 503 CALL netcdf4_write_variable('parallel', file_id, variables(i)%var_id, bounds_start,& 504 value_counts, bounds_origin, & 505 .FALSE., values_real32_1d=out_buf_r, return_value=return_value) 506 ENDIF 507 ENDIF 508 CALL part_io%sm_node_barrier() 509 CALL cpu_log( log_point_s(89), 'particle NetCDF output', 'stop' ) 510 511 #if defined( __parallel ) 512 CALL MPI_BARRIER(comm2d, ierr) !kk This Barrier is necessary, not sure why 513 #endif 514 END DO 515 516 CALL deallocate_and_free 517 518 ! write Time value 519 IF(myid == 0) THEN 520 ALLOCATE(my_time(1)) 521 bounds_start(1) = icount 522 value_counts(1) = 1 523 my_time(1) = simulated_time 524 IF(unlimited_dimension) THEN ! For workaround described in dop finalize 525 time_axis_values(icount) = my_time(1) 526 ELSE 527 CALL netcdf4_write_variable('parallel', file_id, var_id%time, bounds_start(1:1), & 528 value_counts(1:1), bounds_origin(1:1), & 529 .TRUE., values_realwp_1d=my_time, return_value=return_value) 530 ENDIF 531 DEALLOCATE(my_time) 532 ENDIF 533 534 RETURN 535 END SUBROUTINE dop_output_tseries 536 537 SUBROUTINE dop_finalize 538 IMPLICIT NONE 503 IF ( variables(i)%is_integer ) THEN 504 out_buf_i = NF90_FILL_INT 505 ELSE 506 out_buf_r = NF90_FILL_REAL 507 ENDIF 508 #endif 509 510 CALL cpu_log( log_point_s(99), 'dop_fill_out_buf', 'start' ) 511 CALL dop_fill_out_buf (variables(i)) 512 CALL cpu_log( log_point_s(99), 'dop_fill_out_buf', 'stop' ) 513 514 CALL cpu_log( log_point_s(88), 'dop_get_remote_particle', 'start' ) 515 #if defined( __parallel ) 516 CALL dop_get_remote_particle( variables(i)%is_integer ) 517 #endif 518 CALL cpu_log( log_point_s(88), 'dop_get_remote_particle', 'stop' ) 519 520 CALL cpu_log( log_point_s(89), 'particle NetCDF output', 'start' ) 521 CALL part_io%sm_node_barrier( ) 522 IF ( part_io%iam_io_pe ) THEN 523 IF ( variables(i)%is_integer) THEN 524 CALL netcdf4_write_variable( 'parallel', file_id, variables(i)%var_id, bounds_start, & 525 value_counts, bounds_origin, .FALSE., & 526 values_int32_1d=out_buf_i, return_value=return_value ) 527 ELSE 528 CALL netcdf4_write_variable( 'parallel', file_id, variables(i)%var_id, bounds_start, & 529 value_counts, bounds_origin, .FALSE., & 530 values_real32_1d=out_buf_r, return_value=return_value) 531 ENDIF 532 ENDIF 533 CALL part_io%sm_node_barrier( ) 534 CALL cpu_log( log_point_s(89), 'particle NetCDF output', 'stop' ) 535 536 #if defined( __parallel ) 537 CALL MPI_BARRIER( comm2d, ierr ) !kk This Barrier is necessary, not sure why 538 #endif 539 ENDDO 540 541 CALL deallocate_and_free 542 543 ! 544 !-- Write Time value 545 IF ( myid == 0 ) THEN 546 ALLOCATE( my_time(1) ) 547 bounds_start(1) = icount 548 value_counts(1) = 1 549 my_time(1) = simulated_time 550 IF ( unlimited_dimension ) THEN ! For workaround described in dop finalize 551 time_axis_values(icount) = my_time(1) 552 ELSE 553 CALL netcdf4_write_variable( 'parallel', file_id, var_id%time, bounds_start(1:1), & 554 value_counts(1:1), bounds_origin(1:1), .TRUE., & 555 values_realwp_1d=my_time, return_value=return_value ) 556 ENDIF 557 DEALLOCATE( my_time ) 558 ENDIF 559 560 RETURN 561 END SUBROUTINE dop_output_tseries 562 563 !--------------------------------------------------------------------------------------------------! 564 ! Description: 565 ! ------------ 566 ! 567 !--------------------------------------------------------------------------------------------------! 568 SUBROUTINE dop_finalize 569 570 IMPLICIT NONE 571 539 572 #if defined( __netcdf4 ) 540 INTEGER(iwp) :: var_len541 #endif 542 573 INTEGER(iwp) :: ierr !< MPI error code 574 #endif 575 INTEGER(iwp) :: return_value !< Return value data_output_netcdf4 .. routines 543 576 #if defined( __netcdf4 ) 544 INTEGER(iwp) :: ierr !< MPI error code545 #endif 546 547 IF( win_prt_i /= -1)THEN548 CALL part_io%sm_free_shared (win_prt_i)549 550 IF( win_prt_r /= -1)THEN551 CALL part_io%sm_free_shared (win_prt_r)552 553 554 IF( file_id /= -1 .AND. part_io%iam_io_pe)THEN555 556 577 INTEGER(iwp) :: var_len 578 #endif 579 580 IF ( win_prt_i /= -1 ) THEN 581 CALL part_io%sm_free_shared( win_prt_i ) 582 ENDIF 583 IF ( win_prt_r /= -1 ) THEN 584 CALL part_io%sm_free_shared( win_prt_r ) 585 ENDIF 586 587 IF ( file_id /= -1 .AND. part_io%iam_io_pe ) THEN 588 CALL netcdf4_finalize( 'parallel', file_id, return_value ) 589 file_id = -1 557 590 558 591 #if defined( __netcdf4 ) 559 592 ! 560 !-- For yet unknown reasons it is not possible to write in parallel mode the time values to NetCDF variable time 561 !-- This workaround closes the parallel file and writes the time values in sequential mode on PE0 562 !kk This is a real quick and dirty workaround and the problem should be solved in the final version !!! 563 564 If(myid == 0 .AND. unlimited_dimension) THEN 565 ierr = nf90_open (TRIM(file_name),NF90_WRITE, file_id) 566 ierr = nf90_inquire_dimension(file_id, did%time, len = var_len) 567 568 ierr = nf90_put_var (file_id, var_id%time, time_axis_values(1:var_len)) 569 570 ierr = nf90_close (file_id) 571 ENDIF 572 #endif 573 ENDIF 574 575 RETURN 576 END SUBROUTINE dop_finalize 577 578 ! Private subroutines 579 580 581 ! 582 ! kk Not sure if necessary, but set ALL particle numnber to -1 583 584 SUBROUTINE set_indef_particle_nr 585 586 IMPLICIT NONE 587 INTEGER(iwp) :: i !< 588 INTEGER(iwp) :: j !< 589 INTEGER(iwp) :: k !< 590 INTEGER(iwp) :: n !< 591 592 DO i=nxl,nxr 593 DO j=nys,nyn 594 DO k=nzb+1,nzt 595 DO n=1,SIZE(grid_particles(k,j,i)%particles) 596 grid_particles(k,j,i)%particles(n)%particle_nr = -1 597 END DO 598 END DO 599 ENDDO 600 ENDDO 601 602 RETURN 603 END SUBROUTINE set_indef_particle_nr 604 ! 605 !-- Count particles scheduled for output 606 !-- here are pts_increment and pts_percentage are used to select output particles 607 608 SUBROUTINE count_output_particles (pcount) 609 IMPLICIT NONE 610 611 INTEGER(iwp), INTENT(OUT) :: pcount !< 612 613 INTEGER(iwp) :: i !< 614 INTEGER(iwp) :: j !< 615 INTEGER(iwp) :: k !< 616 INTEGER(iwp) :: n !< 617 INTEGER(iwp) :: n_all !< count all particles for MOD function 618 REAL(dp) :: fcount 619 REAL(dp) :: finc 620 621 pcount = 0 622 IF(pts_increment == 1) THEN 623 pcount = SUM(prt_count) 624 ELSE 625 n_all = 0 626 DO i=nxl,nxr 627 DO j=nys,nyn 628 DO k=nzb+1,nzt 629 DO n=1,prt_count(k,j,i) 630 IF(MOD(n_all,pts_increment) == 0) THEN 631 pcount = pcount+1 632 ENDIF 633 n_all = n_all+1 634 END DO 635 END DO 636 ENDDO 637 ENDDO 638 ENDIF 639 640 IF(pts_percentage < 100. ) THEN 641 642 finc = pts_percentage/100 643 644 pcount = 0 645 fcount = 0.0 646 647 DO i=nxl,nxr 648 DO j=nys,nyn 649 DO k=nzb+1,nzt 650 DO n=1,prt_count(k,j,i) 651 fcount = fcount + finc 652 IF(pcount < int(fcount) ) THEN 653 pcount = pcount+1 654 ENDIF 655 END DO 656 END DO 657 ENDDO 658 ENDDO 659 660 ENDIF 661 662 RETURN 663 END SUBROUTINE count_output_particles 664 665 SUBROUTINE dop_read_output_particle_list (nr_particles_out) 666 IMPLICIT NONE 667 INTEGER(iwp),INTENT(OUT) :: nr_particles_out 668 669 INTEGER(iwp) :: i !< 670 INTEGER(iwp) :: iu !< 671 INTEGER(iwp) :: istat !< 672 INTEGER(idp) :: dummy !< 673 674 iu = 345 675 istat = 0 676 nr_particles_out = 0 677 678 OPEN(unit=iu, file=TRIM(pts_id_file)) !kk should be changed to check_open 679 680 ! First stridem cout output particle 681 682 DO WHILE (istat == 0) 683 READ(iu,*,iostat=istat) dummy 684 nr_particles_out = nr_particles_out+1 685 END DO 686 687 nr_particles_out = nr_particles_out-1 ! subtract 1 for end of file read 688 689 ALLOCATE(part_id_list_file(nr_particles_out)) 690 691 REWIND(iu) 692 693 !-- second stride, read particle ids for scheduled output particle 694 695 DO i=1,nr_particles_out 696 READ(iu,*) part_id_list_file(i) 697 END DO 698 699 700 CLOSE (iu) 701 702 END SUBROUTINE dop_read_output_particle_list 703 ! 704 !-- Setb output particle number for selected active particles 705 706 SUBROUTINE set_particle_number 707 IMPLICIT NONE 708 709 INTEGER(iwp) :: i !< 710 INTEGER(iwp) :: j !< 711 INTEGER(iwp) :: k !< 712 INTEGER(iwp) :: n !< 713 INTEGER(iwp) :: n_all !< count all particles for MOD function 714 INTEGER(iwp) :: particle_nr !< output particle number 715 INTEGER(iwp) :: pcount !< local particle count in case of pts_percentage 716 REAL(dp) :: fcount !< partical progress in %/100 717 REAL(dp) :: finc !< increment of particle 718 719 pcount = 0 720 fcount = 0.0 721 722 particle_nr = start_local_numbering 723 n_all = 0 724 DO i=nxl,nxr 725 DO j=nys,nyn 726 DO k=nzb+1,nzt 727 IF(pts_increment > 1) THEN 728 DO n=1,prt_count(k,j,i) 729 IF(MOD(n_all,pts_increment) == 0) THEN 730 grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr 731 particle_nr = particle_nr+1 732 ELSE 733 grid_particles(k,j,i)%particles(n)%particle_nr = -2 734 ENDIF 735 n_all = n_all+1 736 END DO 737 ELSE IF(pts_percentage < 100. ) THEN 738 finc = pts_percentage/100 739 740 DO n=1,prt_count(k,j,i) 741 ! 742 !-- Every particle move fraction on particle axis (i.e part percent == 80; move 0.8) 743 !-- if increases next whole number, the particle is taken for output 744 fcount = fcount + finc 745 IF(pcount < int(fcount) ) THEN 746 pcount = pcount+1 747 grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr 748 particle_nr = particle_nr+1 749 ELSE 750 grid_particles(k,j,i)%particles(n)%particle_nr = -2 751 ENDIF 752 END DO 753 ELSE 754 DO n=1,prt_count(k,j,i) 755 grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr 756 particle_nr = particle_nr+1 757 END DO 758 ENDIF 759 END DO 760 ENDDO 761 ENDDO 762 763 RETURN 764 END SUBROUTINE set_particle_number 765 766 SUBROUTINE dop_find_particle_in_outlist 767 IMPLICIT NONE 768 769 INTEGER(iwp) :: i !< 770 #if defined( __parallel ) 771 INTEGER(iwp) :: ierr !< MPI error code 772 #endif 773 INTEGER(iwp) :: j !< 774 INTEGER(iwp) :: k !< 775 INTEGER(iwp) :: l !< 776 INTEGER(iwp) :: n !< 777 INTEGER(iwp) :: nr_part !< 593 !-- For yet unknown reasons it is not possible to write in parallel mode the time values to 594 !-- NetCDF variable time. 595 !-- This workaround closes the parallel file and writes the time values in sequential mode on 596 !-- PE0. 597 !-- kk This is a real quick and dirty workaround and the problem should be solved in the final 598 !-- version !!! 599 IF ( myid == 0 .AND. unlimited_dimension ) THEN 600 ierr = NF90_OPEN( TRIM( file_name ), NF90_WRITE, file_id ) 601 ierr = NF90_INQUIRE_DIMENSION( file_id, did%time, LEN = var_len) 602 603 ierr = NF90_PUT_VAR( file_id, var_id%time, time_axis_values(1:var_len) ) 604 605 ierr = NF90_CLOSE( file_id ) 606 ENDIF 607 #endif 608 ENDIF 609 610 RETURN 611 END SUBROUTINE dop_finalize 612 613 ! 614 !--Private subroutines 615 616 !--------------------------------------------------------------------------------------------------! 617 ! Description: 618 ! ------------ 619 ! 620 !--------------------------------------------------------------------------------------------------! 621 ! 622 !-- kk Not sure if necessary, but set ALL particle number to -1 623 SUBROUTINE set_indef_particle_nr 624 625 IMPLICIT NONE 626 627 INTEGER(iwp) :: i !< 628 INTEGER(iwp) :: j !< 629 INTEGER(iwp) :: k !< 630 INTEGER(iwp) :: n !< 631 632 DO i = nxl, nxr 633 DO j = nys, nyn 634 DO k = nzb+1, nzt 635 DO n = 1, SIZE( grid_particles(k,j,i)%particles ) 636 grid_particles(k,j,i)%particles(n)%particle_nr = -1 637 ENDDO 638 ENDDO 639 ENDDO 640 ENDDO 641 642 RETURN 643 END SUBROUTINE set_indef_particle_nr 644 645 !--------------------------------------------------------------------------------------------------! 646 ! Description: 647 ! ------------ 648 !> Count particles scheduled for output. 649 !> Here pts_increment and pts_percentage are used to select output particles. 650 !--------------------------------------------------------------------------------------------------! 651 SUBROUTINE count_output_particles (pcount) 652 653 IMPLICIT NONE 654 655 INTEGER(iwp) :: i !< 656 INTEGER(iwp) :: j !< 657 INTEGER(iwp) :: k !< 658 INTEGER(iwp) :: n !< 659 INTEGER(iwp) :: n_all !< count all particles for MOD function 660 INTEGER(iwp), INTENT(OUT) :: pcount !< 661 662 REAL(dp) :: finc 663 REAL(dp) :: fcount 664 665 666 pcount = 0 667 IF ( pts_increment == 1 ) THEN 668 pcount = SUM( prt_count ) 669 ELSE 670 n_all = 0 671 DO i = nxl, nxr 672 DO j = nys, nyn 673 DO k = nzb+1, nzt 674 DO n = 1, prt_count(k,j,i) 675 IF ( MOD( n_all, pts_increment ) == 0 ) THEN 676 pcount = pcount + 1 677 ENDIF 678 n_all = n_all + 1 679 ENDDO 680 ENDDO 681 ENDDO 682 ENDDO 683 ENDIF 684 685 IF ( pts_percentage < 100.0_wp ) THEN 686 687 finc = pts_percentage / 100 688 689 pcount = 0 690 fcount = 0.0_wp 691 692 DO i = nxl, nxr 693 DO j = nys, nyn 694 DO k = nzb+1, nzt 695 DO n = 1, prt_count(k,j,i) 696 fcount = fcount + finc 697 IF ( pcount < INT( fcount ) ) THEN 698 pcount = pcount + 1 699 ENDIF 700 ENDDO 701 ENDDO 702 ENDDO 703 ENDDO 704 705 ENDIF 706 707 RETURN 708 END SUBROUTINE count_output_particles 709 710 !--------------------------------------------------------------------------------------------------! 711 ! Description: 712 ! ------------ 713 ! 714 !--------------------------------------------------------------------------------------------------! 715 SUBROUTINE dop_read_output_particle_list( nr_particles_out ) 716 717 IMPLICIT NONE 718 719 INTEGER(idp) :: dummy !< 720 INTEGER(iwp) :: i !< 721 INTEGER(iwp) :: istat !< 722 INTEGER(iwp) :: iu !< 723 INTEGER(iwp), INTENT(OUT) :: nr_particles_out 724 725 726 iu = 345 727 istat = 0 728 nr_particles_out = 0 729 730 OPEN( UNIT=iu, FILE=TRIM( pts_id_file ) ) !kk should be changed to check_open 731 732 ! 733 !-- First stridem cout output particle 734 DO WHILE( istat == 0 ) 735 READ( iu, *, iostat=istat ) dummy 736 nr_particles_out = nr_particles_out + 1 737 ENDDO 738 739 nr_particles_out = nr_particles_out - 1 ! subtract 1 for end of file read 740 741 ALLOCATE( part_id_list_file(nr_particles_out) ) 742 743 REWIND( iu ) 744 ! 745 !-- Second stride, read particle ids for scheduled output particle. 746 DO i = 1, nr_particles_out 747 READ( iu, * ) part_id_list_file(i) 748 ENDDO 749 750 CLOSE( iu ) 751 752 END SUBROUTINE dop_read_output_particle_list 753 754 !--------------------------------------------------------------------------------------------------! 755 ! Description: 756 ! ------------ 757 !> Set output particle number for selected active particles 758 !--------------------------------------------------------------------------------------------------! 759 SUBROUTINE set_particle_number 760 761 IMPLICIT NONE 762 763 INTEGER(iwp) :: i !< 764 INTEGER(iwp) :: j !< 765 INTEGER(iwp) :: k !< 766 INTEGER(iwp) :: n !< 767 INTEGER(iwp) :: n_all !< count all particles for MOD function 768 INTEGER(iwp) :: particle_nr !< output particle number 769 INTEGER(iwp) :: pcount !< local particle count in case of pts_percentage 770 771 REAL(dp) :: fcount !< partical progress in %/100 772 REAL(dp) :: finc !< increment of particle 773 774 775 pcount = 0 776 fcount = 0.0 777 778 particle_nr = start_local_numbering 779 n_all = 0 780 DO i = nxl, nxr 781 DO j = nys, nyn 782 DO k = nzb+1, nzt 783 IF ( pts_increment > 1 ) THEN 784 DO n = 1, prt_count(k,j,i) 785 IF ( MOD( n_all, pts_increment ) == 0 ) THEN 786 grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr 787 particle_nr = particle_nr + 1 788 ELSE 789 grid_particles(k,j,i)%particles(n)%particle_nr = -2 790 ENDIF 791 n_all = n_all + 1 792 ENDDO 793 ELSEIF ( pts_percentage < 100.0_wp ) THEN 794 finc = pts_percentage / 100 795 796 DO n = 1, prt_count(k,j,i) 797 ! 798 !-- Eeach particle moves fraction on particle axis (i.e part percent == 80; move 0.8) 799 !-- if increases next whole number, the particle is taken for output. 800 fcount = fcount + finc 801 IF ( pcount < INT( fcount ) ) THEN 802 pcount = pcount + 1 803 grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr 804 particle_nr = particle_nr + 1 805 ELSE 806 grid_particles(k,j,i)%particles(n)%particle_nr = -2 807 ENDIF 808 ENDDO 809 ELSE 810 DO n = 1, prt_count(k,j,i) 811 grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr 812 particle_nr = particle_nr + 1 813 ENDDO 814 ENDIF 815 ENDDO 816 ENDDO 817 ENDDO 818 819 RETURN 820 END SUBROUTINE set_particle_number 821 822 !--------------------------------------------------------------------------------------------------! 823 ! Description: 824 ! ------------ 825 ! 826 !--------------------------------------------------------------------------------------------------! 827 SUBROUTINE dop_find_particle_in_outlist 828 829 IMPLICIT NONE 830 831 INTEGER(iwp) :: i !< 832 #if defined( __parallel ) 833 INTEGER(iwp) :: ierr !< MPI error code 834 #endif 835 INTEGER(iwp) :: j !< 836 INTEGER(iwp) :: k !< 837 INTEGER(iwp) :: l !< 838 INTEGER(iwp) :: n !< 839 INTEGER(iwp) :: nr_part !< 778 840 ! INTEGER, save :: icount=0 779 841 780 nr_part = 0 781 782 ! 783 !-- If there is a long particle output list, for performance reason it may become necessary to optimize the 784 !-- following loop. 785 ! 786 !-- Decode the particle id in i,j,k,n 787 !-- Split serach, i.e search first in i, then in j ... 788 789 DO i=nxl,nxr 790 DO j=nys,nyn 791 DO k=nzb+1,nzt 792 DO n=1,prt_count(k,j,i) 793 DO l=1,SIZE(part_id_list_file) 794 IF(grid_particles(k,j,i)%particles(n)%id == part_id_list_file(l)) THEN 795 grid_particles(k,j,i)%particles(n)%particle_nr = l 796 nr_part = nr_part+1 797 ENDIF 798 END DO 799 END DO 800 END DO 801 ENDDO 802 ENDDO 803 804 #if defined( __parallel ) 805 CALL MPI_ALLREDUCE( nr_part, initial_number_of_active_particles, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr ) 842 843 nr_part = 0 844 845 ! 846 !-- If there is a long particle output list, for performance reason it may become necessary to 847 !-- optimize the following loop. 848 ! 849 !-- Decode the particle id in i,j,k,n. 850 !-- Split serach, i.e search first in i, then in j ... 851 DO i = nxl, nxr 852 DO j = nys, nyn 853 DO k = nzb+1, nzt 854 DO n = 1, prt_count(k,j,i) 855 DO l = 1, SIZE( part_id_list_file ) 856 IF ( grid_particles(k,j,i)%particles(n)%id == part_id_list_file(l) ) THEN 857 grid_particles(k,j,i)%particles(n)%particle_nr = l 858 nr_part = nr_part + 1 859 ENDIF 860 ENDDO 861 ENDDO 862 ENDDO 863 ENDDO 864 ENDDO 865 866 #if defined( __parallel ) 867 CALL MPI_ALLREDUCE( nr_part, initial_number_of_active_particles, 1, MPI_INTEGER, MPI_SUM, & 868 comm2d, ierr ) 806 869 #else 807 initial_number_of_active_particles = nr_part 808 #endif 809 810 END SUBROUTINE dop_find_particle_in_outlist 811 870 initial_number_of_active_particles = nr_part 871 #endif 872 873 END SUBROUTINE dop_find_particle_in_outlist 874 875 ! 812 876 !-- Netcdf Setup 813 877 ! 814 !-- Open NetCDF File DATA_1D_PTS_NETCDF 815 !-- Define Dimensions and variables 816 !-- Write constant variables 817 818 SUBROUTINE dop_netcdf_setup 819 IMPLICIT NONE 820 821 INTEGER,PARAMETER :: global_id_in_file = -1 822 INTEGER(iwp) :: i 823 INTEGER(iwp) :: fix_ind 824 INTEGER(iwp) :: var_ind 825 826 INTEGER(iwp) :: return_value 827 LOGICAL :: const_flag 828 829 INTEGER, DIMENSION(2) :: dimension_ids 830 831 nr_time_values = end_time/dt_dopts+1 !kk has to be adapted to formular of 3d output 832 833 IF (part_io%iam_io_pe) THEN 834 CALL netcdf4_init_module( "", part_io%comm_io, 0, 9, .TRUE., -1 ) 835 836 file_name = 'DATA_1D_PTS_NETCDF' 837 #if defined( __parallel ) 838 CALL netcdf4_open_file( 'parallel', trim(file_name), file_id, return_value ) 878 !--------------------------------------------------------------------------------------------------! 879 ! Description: 880 ! ------------ 881 !> Open NetCDF File DATA_1D_PTS_NETCDF 882 !> Define Dimensions and variables 883 !> Write constant variables 884 !--------------------------------------------------------------------------------------------------! 885 SUBROUTINE dop_netcdf_setup 886 887 IMPLICIT NONE 888 889 INTEGER, PARAMETER :: global_id_in_file = -1 890 891 INTEGER(iwp) :: i 892 INTEGER(iwp) :: fix_ind 893 INTEGER(iwp) :: return_value 894 INTEGER(iwp) :: var_ind 895 896 INTEGER, DIMENSION(2) :: dimension_ids 897 898 LOGICAL :: const_flag 899 900 901 nr_time_values = end_time / dt_dopts + 1 !kk has to be adapted to formular of 3d output 902 903 IF ( part_io%iam_io_pe ) THEN 904 CALL netcdf4_init_module( "", part_io%comm_io, 0, 9, .TRUE., -1 ) 905 906 file_name = 'DATA_1D_PTS_NETCDF' 907 #if defined( __parallel ) 908 CALL netcdf4_open_file( 'parallel', TRIM( file_name ), file_id, return_value ) 839 909 #else 840 CALL netcdf4_open_file( 'serial', trim(file_name), file_id, return_value ) 841 #endif 842 ! 843 !-- global attributes 844 845 CALL netcdf4_write_attribute( 'parallel', file_id, global_id_in_file, 'comment', & 846 'Particle ouput created by PALM module data_output_particle', return_value=return_value ) 847 848 CALL netcdf4_write_attribute( 'parallel', file_id, global_id_in_file, 'initial_nr_particles', & 849 value_int32=initial_number_of_active_particles, return_value=return_value ) 850 ! 851 !-- define dimensions 852 CALL netcdf4_init_dimension( 'parallel', file_id, did%prt, var_id%prt, & 853 'prt','int32' , nr_particles_out, .TRUE., return_value ) 854 855 IF(unlimited_dimension) THEN 856 CALL netcdf4_init_dimension( 'parallel', file_id, did%time, var_id%time, & 857 'time','real32' , -1, .TRUE., return_value ) 858 ALLOCATE (time_axis_values(nr_time_values)) 859 ELSE 860 CALL netcdf4_init_dimension( 'parallel', file_id, did%time, var_id%time, & 861 'time','real32' , nr_time_values, .TRUE., return_value ) 862 ENDIF 863 END IF 864 ! 865 !-- Variables without time axis 866 !-- These variables will always be written only once at the beginning of the file 867 868 dimension_ids(1) = did%prt 869 870 fix_ind = 1 871 fix_variables(fix_ind)%name = 'origin_x' 872 fix_variables(fix_ind)%units = 'meter' 873 874 IF (part_io%iam_io_pe) THEN 875 CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id, fix_variables(fix_ind)%name, 'real32', & 876 dimension_ids(1:1), .FALSE., return_value ) 877 878 CALL netcdf4_write_attribute( 'parallel', file_id, fix_variables(fix_ind)%var_id, 'units', & 879 value_char=trim(fix_variables(fix_ind)%units), return_value=return_value ) 880 ENDIF 881 882 fix_ind = fix_ind+1 883 fix_variables(fix_ind)%name = 'origin_y' 884 fix_variables(fix_ind)%units = 'meter' 885 886 IF (part_io%iam_io_pe) THEN 887 CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id, fix_variables(fix_ind)%name, 'real32', & 888 dimension_ids(1:1), .FALSE., return_value ) 889 890 CALL netcdf4_write_attribute( 'parallel', file_id, fix_variables(fix_ind)%var_id, 'units', & 891 value_char=trim(fix_variables(fix_ind)%units), return_value=return_value ) 892 893 ENDIF 894 895 fix_ind = fix_ind+1 896 fix_variables(fix_ind)%name = 'origin_z' 897 fix_variables(fix_ind)%units = 'meter' 898 899 IF (part_io%iam_io_pe) THEN 900 CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id, fix_variables(fix_ind)%name, 'real32', & 901 dimension_ids(1:1), .FALSE., return_value ) 902 903 CALL netcdf4_write_attribute( 'parallel', file_id, fix_variables(fix_ind)%var_id, 'units', & 904 value_char=trim(fix_variables(fix_ind)%units), return_value=return_value ) 905 ENDIF 906 907 ! 908 !-- These variables are written if name end with _const' 909 DO i=1,size(data_output_pts) 910 const_flag = (INDEX(TRIM(data_output_pts(i)),'_const') > 0) 911 IF(LEN(TRIM(data_output_pts(i))) > 0 .AND. const_flag) THEN 912 fix_ind = fix_ind+1 913 fix_variables(fix_ind)%name = TRIM(data_output_pts(i)) 914 915 SELECT CASE (TRIM(fix_variables(fix_ind)%name)) 916 CASE('radius_const') 917 fix_variables(fix_ind)%units = 'meter' 918 fix_variables(fix_ind)%is_integer = .FALSE. 919 CASE('aux1_const') 920 fix_variables(fix_ind)%units = 'depend_on_setup' 921 fix_variables(fix_ind)%is_integer = .FALSE. 922 CASE('aux2_const') 923 fix_variables(fix_ind)%units = 'depend_on_setup' 924 fix_variables(fix_ind)%is_integer = .FALSE. 925 CASE('rvar1_const') 926 fix_variables(fix_ind)%units = 'depend_on_setup' 927 fix_variables(fix_ind)%is_integer = .FALSE. 928 CASE('rvar2_const') 929 fix_variables(fix_ind)%units = 'depend_on_setup' 930 fix_variables(fix_ind)%is_integer = .FALSE. 931 CASE('rvar3_const') 932 fix_variables(fix_ind)%units = 'depend_on_setup' 933 fix_variables(fix_ind)%is_integer = .FALSE. 934 END SELECT 935 936 IF (part_io%iam_io_pe) THEN 937 IF(fix_variables(fix_ind)%is_integer) THEN 938 CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id, & 939 fix_variables(fix_ind)%name, 'int32', & 940 dimension_ids(1:1), .FALSE., return_value ) 941 ELSE 942 CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id, & 943 fix_variables(fix_ind)%name, 'real32', & 944 dimension_ids(1:1), .FALSE., return_value ) 945 ENDIF 946 947 CALL netcdf4_write_attribute( 'parallel', file_id, fix_variables(fix_ind)%var_id, 'units', & 948 value_char=trim(fix_variables(fix_ind)%units), return_value=return_value ) 949 ENDIF 950 951 ENDIF 952 ENDDO 953 954 nr_fix_variables = fix_ind 955 ! 956 !-- Variables time axis 957 !-- These variables will always be written in the time loop 958 959 dimension_ids(1) = did%prt 960 dimension_ids(2) = did%time 961 962 var_ind = 0 963 964 DO i=1,size(data_output_pts) 965 const_flag = (INDEX(TRIM(data_output_pts(i)),'_const') > 0) 966 IF(LEN(TRIM(data_output_pts(i))) > 0 .AND. .NOT. const_flag) THEN 967 var_ind = var_ind+1 968 variables(var_ind)%name = TRIM(data_output_pts(i)) 969 970 SELECT CASE (TRIM(variables(var_ind)%name)) 971 CASE('id') 972 variables(var_ind)%name = TRIM(data_output_pts(i)) // '_low' 973 variables(var_ind)%units = 'Number' 974 variables(var_ind)%is_integer = .TRUE. 975 IF (part_io%iam_io_pe) THEN 976 CALL netcdf4_init_variable( 'parallel', file_id, variables(var_ind)%var_id, variables(var_ind)%name, & 977 'int32', dimension_ids(1:2), .FALSE., return_value ) 978 CALL netcdf4_write_attribute( 'parallel', file_id, variables(var_ind)%var_id, 'units', & 979 value_char=trim(variables(var_ind)%units), return_value=return_value ) 980 ENDIF 981 982 var_ind = var_ind+1 983 variables(var_ind)%name = TRIM(data_output_pts(i)) // '_high' 984 variables(var_ind)%units = 'Number' 985 variables(var_ind)%is_integer = .TRUE. 986 CASE('particle_nr') 987 variables(var_ind)%units = 'Number' 988 variables(var_ind)%is_integer = .TRUE. 989 CASE('class') 990 variables(var_ind)%units = 'Number' 991 variables(var_ind)%is_integer = .TRUE. 992 CASE('group') 993 variables(var_ind)%units = 'Number' 994 variables(var_ind)%is_integer = .TRUE. 995 CASE('x') 996 variables(var_ind)%units = 'meter' 997 variables(var_ind)%is_integer = .FALSE. 998 CASE('y') 999 variables(var_ind)%units = 'meter' 1000 variables(var_ind)%is_integer = .FALSE. 1001 CASE('z') 1002 variables(var_ind)%units = 'meter' 1003 variables(var_ind)%is_integer = .FALSE. 1004 CASE('speed_x') 1005 variables(var_ind)%units = 'm/s' 1006 variables(var_ind)%is_integer = .FALSE. 1007 CASE('speed_y') 1008 variables(var_ind)%units = 'm/s' 1009 variables(var_ind)%is_integer = .FALSE. 1010 CASE('speed_z') 1011 variables(var_ind)%units = 'm/s' 1012 variables(var_ind)%is_integer = .FALSE. 1013 CASE('radius') 1014 variables(var_ind)%units = 'meter' 1015 variables(var_ind)%is_integer = .FALSE. 1016 CASE('age') 1017 variables(var_ind)%units = 'sec' 1018 variables(var_ind)%is_integer = .FALSE. 1019 CASE('age_m') 1020 variables(var_ind)%units = 'sec' 1021 variables(var_ind)%is_integer = .FALSE. 1022 CASE('dt_sum') 1023 variables(var_ind)%units = 'sec' 1024 variables(var_ind)%is_integer = .FALSE. 1025 CASE('e_m') 1026 variables(var_ind)%units = 'Ws' 1027 variables(var_ind)%is_integer = .FALSE. 1028 CASE('weight_factor') 1029 variables(var_ind)%units = 'factor' 1030 variables(var_ind)%is_integer = .FALSE. 1031 CASE('aux1') 1032 variables(var_ind)%units = 'depend_on_setup' 1033 variables(var_ind)%is_integer = .FALSE. 1034 CASE('aux2') 1035 variables(var_ind)%units = 'depend_on_setup' 1036 variables(var_ind)%is_integer = .FALSE. 1037 CASE('rvar1') 1038 variables(var_ind)%units = 'depend_on_setup' 1039 variables(var_ind)%is_integer = .FALSE. 1040 CASE('rvar2') 1041 variables(var_ind)%units = 'depend_on_setup' 1042 variables(var_ind)%is_integer = .FALSE. 1043 CASE('rvar3') 1044 variables(var_ind)%units = 'depend_on_setup' 1045 variables(var_ind)%is_integer = .FALSE. 1046 END SELECT 1047 1048 IF (part_io%iam_io_pe) THEN 1049 IF(variables(var_ind)%is_integer) THEN 1050 CALL netcdf4_init_variable( 'parallel', file_id, variables(var_ind)%var_id, variables(var_ind)%name, 'int32', & 1051 dimension_ids(1:2), .FALSE., return_value ) 1052 ELSE 1053 CALL netcdf4_init_variable( 'parallel', file_id, variables(var_ind)%var_id, variables(var_ind)%name, 'real32', & 1054 dimension_ids(1:2), .FALSE., return_value ) 1055 ENDIF 1056 1057 CALL netcdf4_write_attribute( 'parallel', file_id, variables(var_ind)%var_id, 'units', & 1058 value_char=trim(variables(var_ind)%units), return_value=return_value ) 1059 ENDIF 1060 1061 ENDIF 1062 ENDDO 1063 1064 nr_variables = var_ind 1065 1066 IF (part_io%iam_io_pe) THEN 1067 CALL netcdf4_stop_file_header_definition( 'parallel', file_id, return_value ) 1068 ENDIF 1069 1070 CALL dop_write_axis 1071 1072 RETURN 1073 1074 CONTAINS 1075 SUBROUTINE dop_write_axis 1076 IMPLICIT NONE 1077 INTEGER(iwp) :: i 1078 INTEGER,DIMENSION(1) :: bounds_start, value_counts, bounds_origin 1079 INTEGER(iwp) :: return_value !< Return value data_output_netcdf4 .. routines 1080 1081 INTEGER, POINTER, CONTIGUOUS, DIMENSION(:) :: prt_val 1082 1083 bounds_origin = 1 1084 bounds_start(1) = 1 1085 1086 IF(myid == 0) THEN 1087 1088 ALLOCATE(prt_val(nr_particles_out)) 1089 DO i=1,nr_particles_out 1090 prt_val(i) = i 1091 ENDDO 1092 value_counts(1) = nr_particles_out 1093 1094 CALL netcdf4_write_variable('parallel', file_id, var_id%prt, bounds_start, value_counts, bounds_origin, & 1095 .TRUE., values_int32_1d=prt_val, return_value=return_value) 1096 1097 DEALLOCATE(prt_val) 1098 END IF 1099 1100 RETURN 1101 END SUBROUTINE dop_write_axis 1102 1103 END SUBROUTINE dop_netcdf_setup 1104 ! 1105 !- write constant variables 1106 1107 SUBROUTINE dop_write_fixed_variables 1108 IMPLICIT NONE 1109 1110 INTEGER(iwp) :: i ! 1111 INTEGER(iwp) :: return_value ! 1112 1113 INTEGER(iwp),DIMENSION(1) :: bounds_origin, bounds_start, value_counts 1114 1115 bounds_origin(1) = 1 1116 bounds_start(1) = io_start_index 1117 value_counts(1) = io_end_index-io_start_index+1 1118 1119 1120 DO i=1,nr_fix_variables 910 CALL netcdf4_open_file( 'serial', TRIM( file_name ), file_id, return_value ) 911 #endif 912 913 ! 914 !-- Global attributes 915 CALL netcdf4_write_attribute( 'parallel', file_id, global_id_in_file, 'comment', & 916 'Particle ouput created by PALM module data_output_particle', & 917 return_value=return_value ) 918 919 CALL netcdf4_write_attribute( 'parallel', file_id, global_id_in_file, & 920 'initial_nr_particles', & 921 value_int32=initial_number_of_active_particles, & 922 return_value=return_value ) 923 ! 924 !-- Define dimensions 925 CALL netcdf4_init_dimension( 'parallel', file_id, did%prt, var_id%prt, 'prt','int32' , & 926 nr_particles_out, .TRUE., return_value ) 927 928 IF ( unlimited_dimension ) THEN 929 CALL netcdf4_init_dimension( 'parallel', file_id, did%time, var_id%time, 'time','real32',& 930 -1, .TRUE., return_value ) 931 ALLOCATE( time_axis_values(nr_time_values) ) 932 ELSE 933 CALL netcdf4_init_dimension( 'parallel', file_id, did%time, var_id%time, 'time','real32',& 934 nr_time_values, .TRUE., return_value ) 935 ENDIF 936 ENDIF 937 ! 938 !-- Variables without time axis 939 !-- These variables will always be written only once at the beginning of the file 940 dimension_ids(1) = did%prt 941 942 fix_ind = 1 943 fix_variables(fix_ind)%name = 'origin_x' 944 fix_variables(fix_ind)%units = 'meter' 945 946 IF ( part_io%iam_io_pe ) THEN 947 CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id, & 948 fix_variables(fix_ind)%name, 'real32', dimension_ids(1:1), & 949 .FALSE., return_value ) 950 951 CALL netcdf4_write_attribute( 'parallel', file_id, fix_variables(fix_ind)%var_id, 'units', & 952 value_char=TRIM( fix_variables(fix_ind)%units ), & 953 return_value=return_value ) 954 ENDIF 955 956 fix_ind = fix_ind + 1 957 fix_variables(fix_ind)%name = 'origin_y' 958 fix_variables(fix_ind)%units = 'meter' 959 960 IF ( part_io%iam_io_pe ) THEN 961 CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id, & 962 fix_variables(fix_ind)%name, 'real32', dimension_ids(1:1), & 963 .FALSE., return_value ) 964 965 CALL netcdf4_write_attribute( 'parallel', file_id, fix_variables(fix_ind)%var_id, 'units', & 966 value_char=TRIM( fix_variables(fix_ind)%units ), & 967 return_value=return_value ) 968 969 ENDIF 970 971 fix_ind = fix_ind + 1 972 fix_variables(fix_ind)%name = 'origin_z' 973 fix_variables(fix_ind)%units = 'meter' 974 975 IF ( part_io%iam_io_pe ) THEN 976 CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id, & 977 fix_variables(fix_ind)%name, 'real32', dimension_ids(1:1), & 978 .FALSE., return_value ) 979 980 CALL netcdf4_write_attribute( 'parallel', file_id, fix_variables(fix_ind)%var_id, 'units', & 981 value_char=TRIM( fix_variables(fix_ind)%units ), & 982 return_value=return_value ) 983 ENDIF 984 985 ! 986 !-- These variables are written if name end with _const' 987 DO i = 1, SIZE( data_output_pts ) 988 const_flag = ( INDEX( TRIM( data_output_pts(i) ), '_const' ) > 0 ) 989 IF ( LEN( TRIM( data_output_pts(i) ) ) > 0 .AND. const_flag) THEN 990 fix_ind = fix_ind + 1 991 fix_variables(fix_ind)%name = TRIM( data_output_pts(i) ) 992 993 SELECT CASE ( TRIM( fix_variables(fix_ind)%name ) ) 994 CASE ( 'radius_const' ) 995 fix_variables(fix_ind)%units = 'meter' 996 fix_variables(fix_ind)%is_integer = .FALSE. 997 CASE ( 'aux1_const' ) 998 fix_variables(fix_ind)%units = 'depend_on_setup' 999 fix_variables(fix_ind)%is_integer = .FALSE. 1000 CASE ( 'aux2_const' ) 1001 fix_variables(fix_ind)%units = 'depend_on_setup' 1002 fix_variables(fix_ind)%is_integer = .FALSE. 1003 CASE ( 'rvar1_const' ) 1004 fix_variables(fix_ind)%units = 'depend_on_setup' 1005 fix_variables(fix_ind)%is_integer = .FALSE. 1006 CASE ( 'rvar2_const' ) 1007 fix_variables(fix_ind)%units = 'depend_on_setup' 1008 fix_variables(fix_ind)%is_integer = .FALSE. 1009 CASE ( 'rvar3_const' ) 1010 fix_variables(fix_ind)%units = 'depend_on_setup' 1011 fix_variables(fix_ind)%is_integer = .FALSE. 1012 END SELECT 1013 1014 IF ( part_io%iam_io_pe ) THEN 1015 IF ( fix_variables(fix_ind)%is_integer ) THEN 1016 CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id, & 1017 fix_variables(fix_ind)%name, 'int32', & 1018 dimension_ids(1:1), .FALSE., return_value ) 1019 ELSE 1020 CALL netcdf4_init_variable( 'parallel', file_id, fix_variables(fix_ind)%var_id, & 1021 fix_variables(fix_ind)%name, 'real32', & 1022 dimension_ids(1:1), .FALSE., return_value ) 1023 ENDIF 1024 1025 CALL netcdf4_write_attribute( 'parallel', file_id, fix_variables(fix_ind)%var_id, & 1026 'units', & 1027 value_char=TRIM( fix_variables(fix_ind)%units ), & 1028 return_value=return_value ) 1029 ENDIF 1030 1031 ENDIF 1032 ENDDO 1033 1034 nr_fix_variables = fix_ind 1035 ! 1036 !-- Variables time axis 1037 !-- These variables will always be written in the time loop 1038 dimension_ids(1) = did%prt 1039 dimension_ids(2) = did%time 1040 1041 var_ind = 0 1042 1043 DO i = 1, SIZE( data_output_pts ) 1044 const_flag = ( INDEX( TRIM( data_output_pts(i) ), '_const' ) > 0 ) 1045 IF ( LEN( TRIM( data_output_pts(i) ) ) > 0 .AND. .NOT. const_flag ) THEN 1046 var_ind = var_ind + 1 1047 variables(var_ind)%name = TRIM( data_output_pts(i) ) 1048 1049 SELECT CASE ( TRIM( variables(var_ind)%name) ) 1050 CASE ( 'id' ) 1051 variables(var_ind)%name = TRIM( data_output_pts(i) ) // '_low' 1052 variables(var_ind)%units = 'Number' 1053 variables(var_ind)%is_integer = .TRUE. 1054 IF ( part_io%iam_io_pe ) THEN 1055 CALL netcdf4_init_variable( 'parallel', file_id, variables(var_ind)%var_id, & 1056 variables(var_ind)%name, 'int32', & 1057 dimension_ids(1:2), .FALSE., return_value ) 1058 CALL netcdf4_write_attribute( 'parallel', file_id, variables(var_ind)%var_id, & 1059 'units', & 1060 value_char=TRIM( variables(var_ind)%units ), & 1061 return_value=return_value ) 1062 ENDIF 1063 1064 var_ind = var_ind + 1 1065 variables(var_ind)%name = TRIM( data_output_pts(i) ) // '_high' 1066 variables(var_ind)%units = 'Number' 1067 variables(var_ind)%is_integer = .TRUE. 1068 CASE ( 'particle_nr' ) 1069 variables(var_ind)%units = 'Number' 1070 variables(var_ind)%is_integer = .TRUE. 1071 CASE ( 'class' ) 1072 variables(var_ind)%units = 'Number' 1073 variables(var_ind)%is_integer = .TRUE. 1074 CASE ( 'group' ) 1075 variables(var_ind)%units = 'Number' 1076 variables(var_ind)%is_integer = .TRUE. 1077 CASE ( 'x' ) 1078 variables(var_ind)%units = 'meter' 1079 variables(var_ind)%is_integer = .FALSE. 1080 CASE ( 'y' ) 1081 variables(var_ind)%units = 'meter' 1082 variables(var_ind)%is_integer = .FALSE. 1083 CASE ( 'z' ) 1084 variables(var_ind)%units = 'meter' 1085 variables(var_ind)%is_integer = .FALSE. 1086 CASE ( 'speed_x' ) 1087 variables(var_ind)%units = 'm/s' 1088 variables(var_ind)%is_integer = .FALSE. 1089 CASE ( 'speed_y' ) 1090 variables(var_ind)%units = 'm/s' 1091 variables(var_ind)%is_integer = .FALSE. 1092 CASE ( 'speed_z' ) 1093 variables(var_ind)%units = 'm/s' 1094 variables(var_ind)%is_integer = .FALSE. 1095 CASE ( 'radius' ) 1096 variables(var_ind)%units = 'meter' 1097 variables(var_ind)%is_integer = .FALSE. 1098 CASE ( 'age' ) 1099 variables(var_ind)%units = 'sec' 1100 variables(var_ind)%is_integer = .FALSE. 1101 CASE ( 'age_m' ) 1102 variables(var_ind)%units = 'sec' 1103 variables(var_ind)%is_integer = .FALSE. 1104 CASE ( 'dt_sum' ) 1105 variables(var_ind)%units = 'sec' 1106 variables(var_ind)%is_integer = .FALSE. 1107 CASE ( 'e_m' ) 1108 variables(var_ind)%units = 'Ws' 1109 variables(var_ind)%is_integer = .FALSE. 1110 CASE( 'weight_factor' ) 1111 variables(var_ind)%units = 'factor' 1112 variables(var_ind)%is_integer = .FALSE. 1113 CASE ( 'aux1' ) 1114 variables(var_ind)%units = 'depend_on_setup' 1115 variables(var_ind)%is_integer = .FALSE. 1116 CASE ( 'aux2' ) 1117 variables(var_ind)%units = 'depend_on_setup' 1118 variables(var_ind)%is_integer = .FALSE. 1119 CASE ( 'rvar1' ) 1120 variables(var_ind)%units = 'depend_on_setup' 1121 variables(var_ind)%is_integer = .FALSE. 1122 CASE ( 'rvar2' ) 1123 variables(var_ind)%units = 'depend_on_setup' 1124 variables(var_ind)%is_integer = .FALSE. 1125 CASE ( 'rvar3' ) 1126 variables(var_ind)%units = 'depend_on_setup' 1127 variables(var_ind)%is_integer = .FALSE. 1128 END SELECT 1129 1130 IF ( part_io%iam_io_pe ) THEN 1131 IF ( variables(var_ind)%is_integer ) THEN 1132 CALL netcdf4_init_variable( 'parallel', file_id, variables(var_ind)%var_id, & 1133 variables(var_ind)%name, 'int32', dimension_ids(1:2), & 1134 .FALSE., return_value ) 1135 ELSE 1136 CALL netcdf4_init_variable( 'parallel', file_id, variables(var_ind)%var_id, & 1137 variables(var_ind)%name, 'real32', dimension_ids(1:2), & 1138 .FALSE., return_value ) 1139 ENDIF 1140 1141 CALL netcdf4_write_attribute( 'parallel', file_id, variables(var_ind)%var_id, 'units',& 1142 value_char=TRIM( variables(var_ind)%units ), & 1143 return_value=return_value ) 1144 ENDIF 1145 1146 ENDIF 1147 ENDDO 1148 1149 nr_variables = var_ind 1150 1151 IF ( part_io%iam_io_pe ) THEN 1152 CALL netcdf4_stop_file_header_definition( 'parallel', file_id, return_value ) 1153 ENDIF 1154 1155 CALL dop_write_axis 1156 1157 RETURN 1158 1159 CONTAINS 1160 1161 !--------------------------------------------------------------------------------------------------! 1162 ! Description: 1163 ! ------------ 1164 ! 1165 !--------------------------------------------------------------------------------------------------! 1166 SUBROUTINE dop_write_axis 1167 1168 IMPLICIT NONE 1169 1170 INTEGER(iwp) :: i 1171 INTEGER(iwp) :: return_value !< Return value data_output_netcdf4 .. routines 1172 1173 INTEGER,DIMENSION(1) :: bounds_origin, bounds_start, value_counts 1174 1175 INTEGER, POINTER, CONTIGUOUS, DIMENSION(:) :: prt_val 1176 1177 1178 bounds_origin = 1 1179 bounds_start(1) = 1 1180 1181 IF ( myid == 0 ) THEN 1182 1183 ALLOCATE( prt_val(nr_particles_out) ) 1184 DO i = 1, nr_particles_out 1185 prt_val(i) = i 1186 ENDDO 1187 value_counts(1) = nr_particles_out 1188 1189 CALL netcdf4_write_variable( 'parallel', file_id, var_id%prt, bounds_start, & 1190 value_counts, bounds_origin, .TRUE., & 1191 values_int32_1d=prt_val, return_value=return_value) 1192 1193 DEALLOCATE( prt_val ) 1194 ENDIF 1195 1196 RETURN 1197 END SUBROUTINE dop_write_axis 1198 1199 END SUBROUTINE dop_netcdf_setup 1200 1201 !--------------------------------------------------------------------------------------------------! 1202 ! Description: 1203 ! ------------ 1204 !> Write constant variables 1205 !--------------------------------------------------------------------------------------------------! 1206 SUBROUTINE dop_write_fixed_variables 1207 1208 IMPLICIT NONE 1209 1210 INTEGER(iwp) :: i ! 1211 INTEGER(iwp) :: return_value ! 1212 1213 INTEGER(iwp),DIMENSION(1) :: bounds_origin, bounds_start, value_counts 1214 1215 1216 bounds_origin(1) = 1 1217 bounds_start(1) = io_start_index 1218 value_counts(1) = io_end_index - io_start_index + 1 1219 1220 1221 DO i = 1, nr_fix_variables 1121 1222 1122 1223 #if defined( __netcdf4 ) 1123 IF(fix_variables(i)%is_integer) THEN 1124 out_buf_i = NF90_FILL_INT 1125 ELSE 1126 out_buf_r = NF90_FILL_REAL 1127 ENDIF 1128 #endif 1129 1130 CALL dop_fill_out_buf (fix_variables(i)) 1131 1132 CALL dop_get_remote_particle (fix_variables(i)%is_integer) 1133 1134 CALL part_io%sm_node_barrier() 1135 IF (part_io%iam_io_pe) THEN 1136 IF(fix_variables(i)%is_integer) THEN 1137 CALL netcdf4_write_variable('parallel', file_id, fix_variables(i)%var_id, bounds_start, value_counts, & 1138 bounds_origin, .FALSE., values_int32_1d=out_buf_i, return_value=return_value) 1139 ELSE 1140 CALL netcdf4_write_variable('parallel', file_id, fix_variables(i)%var_id, bounds_start, value_counts, & 1141 bounds_origin, .FALSE., values_real32_1d=out_buf_r, return_value=return_value) 1142 ENDIF 1143 ENDIF 1144 CALL part_io%sm_node_barrier() 1145 ENDDO 1146 1147 RETURN 1148 END SUBROUTINE dop_write_fixed_variables 1149 1150 SUBROUTINE dop_delete_particle_number 1151 IMPLICIT NONE 1152 1153 INTEGER(iwp) :: i !< 1154 INTEGER(iwp) :: j !< 1155 INTEGER(iwp) :: k !< 1156 INTEGER(iwp) :: n !< 1157 1158 ! 1159 !-- delete inactive particles, i.e. all particles with particle_mask == .FALSE. 1160 !-- get an output particle nr of -1 1161 !kk Not sure if it is required here or already done in lagrangian_particle_model_mod before this call 1162 1163 remote_nr_particles = 0 1164 DO i=nxl,nxr 1165 DO j=nys,nyn 1166 DO k=nzb+1,nzt 1167 DO n=1,prt_count(k,j,i) 1168 IF( .NOT. grid_particles(k,j,i)%particles(n)%particle_mask) THEN 1169 grid_particles(k,j,i)%particles(n)%particle_nr = -1 1170 END IF 1171 END DO 1172 END DO 1173 ENDDO 1174 ENDDO 1175 1176 RETURN 1177 END SUBROUTINE dop_delete_particle_number 1178 1179 SUBROUTINE dop_newly_generated_particles 1180 IMPLICIT NONE 1181 1182 INTEGER(iwp) :: i !< 1183 INTEGER(iwp) :: j !< 1184 INTEGER(iwp) :: k !< 1185 INTEGER(iwp) :: n !< 1186 INTEGER(iwp) :: n_all !< count all particles for MOD function 1187 INTEGER(iwp) :: nr_new_particle !< 1188 INTEGER(iwp) :: particle_nr !< 1189 #if defined( __parallel ) 1190 INTEGER(iwp) :: ierr !< MPI error code 1191 #endif 1192 REAL(dp) :: fcount 1193 REAL(dp) :: finc 1194 INTEGER(iwp),DIMENSION(0:numprocs-1) :: nr_particles_new_s 1195 INTEGER(iwp),DIMENSION(0:numprocs-1) :: nr_particles_new_r 1196 INTEGER(iwp) :: start_new_numbering 1197 1198 1199 ! 1200 !-- Count Number of Newly Generated particles 1201 !-- Condition for a newparticle: particle_mask = .TRUE. and particle nr of -1 1202 ! 1203 !-- For performance reasons, this subroutine may be combined later with dop_delete_particle_number 1204 1205 nr_new_particle = 0 1206 1207 IF(pts_increment > 1) THEN 1208 n_all = 0 1209 DO i=nxl,nxr 1210 DO j=nys,nyn 1211 DO k=nzb+1,nzt 1212 DO n=1,prt_count(k,j,i) 1213 IF( grid_particles(k,j,i)%particles(n)%particle_mask) THEN 1214 IF(grid_particles(k,j,i)%particles(n)%particle_nr == -1) THEN 1215 IF(MOD(n_all,pts_increment) == 0) THEN 1216 nr_new_particle = nr_new_particle+1 1217 ENDIF 1218 n_all = n_all+1 1219 ENDIF 1220 END IF 1221 END DO 1222 END DO 1223 ENDDO 1224 ENDDO 1225 ELSEIF(pts_percentage < 100. ) THEN 1226 finc = pts_percentage/100 1227 fcount = 0.0 1228 1229 DO i=nxl,nxr 1230 DO j=nys,nyn 1231 DO k=nzb+1,nzt 1232 DO n=1,prt_count(k,j,i) 1233 IF( grid_particles(k,j,i)%particles(n)%particle_mask) THEN 1234 IF(grid_particles(k,j,i)%particles(n)%particle_nr == -1) THEN 1235 fcount = fcount + finc 1236 IF(nr_new_particle < int(fcount) ) THEN 1237 nr_new_particle = nr_new_particle+1 1238 ENDIF 1239 ENDIF 1240 END IF 1241 END DO 1242 END DO 1243 ENDDO 1244 ENDDO 1245 1246 ELSE 1247 DO i=nxl,nxr 1248 DO j=nys,nyn 1249 DO k=nzb+1,nzt 1250 DO n=1,prt_count(k,j,i) 1251 IF( grid_particles(k,j,i)%particles(n)%particle_mask) THEN 1252 IF(grid_particles(k,j,i)%particles(n)%particle_nr == -1) THEN 1253 nr_new_particle = nr_new_particle+1 1254 ENDIF 1255 END IF 1256 END DO 1257 END DO 1258 ENDDO 1259 ENDDO 1260 ENDIF 1261 ! 1262 !-- Determine start number of new particles on every thread 1263 1264 nr_particles_new_s = 0 1265 nr_particles_new_s(myid) = nr_new_particle 1266 1267 #if defined( __parallel ) 1268 CALL MPI_ALLREDUCE( nr_particles_new_s, nr_particles_new_r, SIZE( nr_particles_new_s ), MPI_INTEGER, & 1269 MPI_SUM, comm2d, ierr ) 1224 IF ( fix_variables(i)%is_integer ) THEN 1225 out_buf_i = NF90_FILL_INT 1226 ELSE 1227 out_buf_r = NF90_FILL_REAL 1228 ENDIF 1229 #endif 1230 1231 CALL dop_fill_out_buf( fix_variables(i) ) 1232 1233 CALL dop_get_remote_particle( fix_variables(i)%is_integer ) 1234 1235 CALL part_io%sm_node_barrier( ) 1236 IF ( part_io%iam_io_pe ) THEN 1237 IF ( fix_variables(i)%is_integer ) THEN 1238 CALL netcdf4_write_variable( 'parallel', file_id, fix_variables(i)%var_id, & 1239 bounds_start, value_counts, bounds_origin, .FALSE., & 1240 values_int32_1d=out_buf_i, return_value=return_value) 1241 ELSE 1242 CALL netcdf4_write_variable( 'parallel', file_id, fix_variables(i)%var_id, & 1243 bounds_start, value_counts, bounds_origin, .FALSE., & 1244 values_real32_1d=out_buf_r, return_value=return_value) 1245 ENDIF 1246 ENDIF 1247 CALL part_io%sm_node_barrier( ) 1248 ENDDO 1249 1250 RETURN 1251 END SUBROUTINE dop_write_fixed_variables 1252 1253 !--------------------------------------------------------------------------------------------------! 1254 ! Description: 1255 ! ------------ 1256 ! 1257 !--------------------------------------------------------------------------------------------------! 1258 SUBROUTINE dop_delete_particle_number 1259 1260 IMPLICIT NONE 1261 1262 INTEGER(iwp) :: i !< 1263 INTEGER(iwp) :: j !< 1264 INTEGER(iwp) :: k !< 1265 INTEGER(iwp) :: n !< 1266 1267 ! 1268 !-- Delete inactive particles, i.e. all particles with particle_mask == .FALSE.. 1269 !-- Get an output particle nr of -1. 1270 !-- kk Not sure if it is required here or already done in lagrangian_particle_model_mod before 1271 !-- this call. 1272 remote_nr_particles = 0 1273 DO i = nxl, nxr 1274 DO j = nys, nyn 1275 DO k = nzb+1, nzt 1276 DO n = 1, prt_count(k,j,i) 1277 IF ( .NOT. grid_particles(k,j,i)%particles(n)%particle_mask ) THEN 1278 grid_particles(k,j,i)%particles(n)%particle_nr = -1 1279 ENDIF 1280 ENDDO 1281 ENDDO 1282 ENDDO 1283 ENDDO 1284 1285 RETURN 1286 END SUBROUTINE dop_delete_particle_number 1287 1288 !--------------------------------------------------------------------------------------------------! 1289 ! Description: 1290 ! ------------ 1291 ! 1292 !--------------------------------------------------------------------------------------------------! 1293 SUBROUTINE dop_newly_generated_particles 1294 1295 IMPLICIT NONE 1296 1297 INTEGER(iwp) :: i !< 1298 #if defined( __parallel ) 1299 INTEGER(iwp) :: ierr !< MPI error code 1300 #endif 1301 INTEGER(iwp) :: j !< 1302 INTEGER(iwp) :: k !< 1303 INTEGER(iwp) :: n !< 1304 INTEGER(iwp) :: n_all !< count all particles for MOD function 1305 INTEGER(iwp) :: nr_new_particle !< 1306 INTEGER(iwp) :: particle_nr !< 1307 INTEGER(iwp) :: start_new_numbering 1308 1309 INTEGER(iwp),DIMENSION(0:numprocs-1) :: nr_particles_new_r 1310 INTEGER(iwp),DIMENSION(0:numprocs-1) :: nr_particles_new_s 1311 1312 REAL(dp) :: fcount 1313 REAL(dp) :: finc 1314 1315 1316 ! 1317 !-- Count Number of Newly Generated particles. 1318 !-- Condition for a newparticle: particle_mask = .TRUE. and particle nr of -1. 1319 ! 1320 !-- For performance reasons, this subroutine may be combined later with dop_delete_particle_number. 1321 nr_new_particle = 0 1322 1323 IF ( pts_increment > 1 ) THEN 1324 n_all = 0 1325 DO i = nxl, nxr 1326 DO j = nys, nyn 1327 DO k = nzb+1, nzt 1328 DO n = 1, prt_count(k,j,i) 1329 IF ( grid_particles(k,j,i)%particles(n)%particle_mask ) THEN 1330 IF ( grid_particles(k,j,i)%particles(n)%particle_nr == -1 ) THEN 1331 IF ( MOD( n_all, pts_increment ) == 0 ) THEN 1332 nr_new_particle = nr_new_particle + 1 1333 ENDIF 1334 n_all = n_all + 1 1335 ENDIF 1336 ENDIF 1337 ENDDO 1338 ENDDO 1339 ENDDO 1340 ENDDO 1341 ELSEIF ( pts_percentage < 100.0_wp ) THEN 1342 finc = pts_percentage / 100 1343 fcount = 0.0 1344 1345 DO i = nxl, nxr 1346 DO j = nys, nyn 1347 DO k = nzb+1, nzt 1348 DO n = 1, prt_count(k,j,i) 1349 IF ( grid_particles(k,j,i)%particles(n)%particle_mask ) THEN 1350 IF ( grid_particles(k,j,i)%particles(n)%particle_nr == -1 ) THEN 1351 fcount = fcount + finc 1352 IF ( nr_new_particle < INT( fcount ) ) THEN 1353 nr_new_particle = nr_new_particle + 1 1354 ENDIF 1355 ENDIF 1356 ENDIF 1357 ENDDO 1358 ENDDO 1359 ENDDO 1360 ENDDO 1361 1362 ELSE 1363 DO i = nxl, nxr 1364 DO j = nys, nyn 1365 DO k = nzb+1, nzt 1366 DO n = 1, prt_count(k,j,i) 1367 IF ( grid_particles(k,j,i)%particles(n)%particle_mask ) THEN 1368 IF ( grid_particles(k,j,i)%particles(n)%particle_nr == -1 ) THEN 1369 nr_new_particle = nr_new_particle + 1 1370 ENDIF 1371 ENDIF 1372 ENDDO 1373 ENDDO 1374 ENDDO 1375 ENDDO 1376 ENDIF 1377 ! 1378 !-- Determine start number of new particles on eac thread. 1379 nr_particles_new_s = 0 1380 nr_particles_new_s(myid) = nr_new_particle 1381 1382 #if defined( __parallel ) 1383 CALL MPI_ALLREDUCE( nr_particles_new_s, nr_particles_new_r, SIZE( nr_particles_new_s ), & 1384 MPI_INTEGER, MPI_SUM, comm2d, ierr ) 1270 1385 #else 1271 nr_particles_new_r = nr_particles_new_s 1272 #endif 1273 ! 1274 !-- Abortion if selected particles from new particle set would exceed particle axis of output 1275 !-- changed by JS 1276 IF ( ( SUM(nr_particles_new_r) + initial_number_of_active_particles) > nr_particles_out ) THEN 1277 RETURN 1278 ENDIF 1279 1280 start_new_numbering = initial_number_of_active_particles+1 1281 1282 IF ( myid > 0) THEN 1283 DO i=1,numprocs-1 1284 start_new_numbering = start_new_numbering+nr_particles_new_r(i-1) 1285 IF(myid == i) EXIT 1286 ENDDO 1287 END IF 1288 1289 initial_number_of_active_particles = initial_number_of_active_particles+SUM(nr_particles_new_r) 1290 1291 dop_last_active_particle = initial_number_of_active_particles 1292 ! 1293 !-- Set number of new particles 1294 1295 particle_nr = start_new_numbering 1296 nr_new_particle = 0 1297 1298 IF(pts_increment > 1) THEN 1299 n_all = 0 1300 DO i=nxl,nxr 1301 DO j=nys,nyn 1302 DO k=nzb+1,nzt 1303 DO n=1,prt_count(k,j,i) 1304 IF( grid_particles(k,j,i)%particles(n)%particle_mask) THEN 1305 IF(grid_particles(k,j,i)%particles(n)%particle_nr == -1) THEN 1306 IF(MOD(n_all,pts_increment) == 0) THEN 1307 grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr 1308 particle_nr = particle_nr+1 1309 ELSE 1310 grid_particles(k,j,i)%particles(n)%particle_nr = -2 1311 ENDIF 1312 n_all = n_all+1 1313 ENDIF 1314 END IF 1315 END DO 1316 END DO 1317 ENDDO 1318 ENDDO 1319 ELSEIF(pts_percentage < 100. ) THEN 1320 finc = pts_percentage/100 1321 fcount = 0.0 1322 1323 DO i=nxl,nxr 1324 DO j=nys,nyn 1325 DO k=nzb+1,nzt 1326 DO n=1,prt_count(k,j,i) 1327 IF( grid_particles(k,j,i)%particles(n)%particle_mask) THEN 1328 IF(grid_particles(k,j,i)%particles(n)%particle_nr == -1) THEN 1329 fcount = fcount + finc 1330 IF(nr_new_particle < int(fcount) ) THEN 1331 grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr 1332 particle_nr = particle_nr+1 1333 nr_new_particle = nr_new_particle+1 1334 ELSE 1335 grid_particles(k,j,i)%particles(n)%particle_nr = -2 1336 ENDIF 1337 ENDIF 1338 END IF 1339 END DO 1340 END DO 1341 ENDDO 1342 ENDDO 1343 ELSE 1344 DO i=nxl,nxr 1345 DO j=nys,nyn 1346 DO k=nzb+1,nzt 1347 DO n=1,prt_count(k,j,i) 1348 IF( grid_particles(k,j,i)%particles(n)%particle_mask) THEN 1349 IF(grid_particles(k,j,i)%particles(n)%particle_nr == -1) THEN 1386 nr_particles_new_r = nr_particles_new_s 1387 #endif 1388 ! 1389 !-- Abortion if selected particles from new particle set would exceed particle axis of output 1390 !-- changed by JS. 1391 IF ( ( SUM( nr_particles_new_r ) + initial_number_of_active_particles ) > nr_particles_out ) & 1392 THEN 1393 RETURN 1394 ENDIF 1395 1396 start_new_numbering = initial_number_of_active_particles + 1 1397 1398 IF ( myid > 0) THEN 1399 DO i = 1, numprocs-1 1400 start_new_numbering = start_new_numbering + nr_particles_new_r(i-1) 1401 IF ( myid == i ) EXIT 1402 ENDDO 1403 ENDIF 1404 1405 initial_number_of_active_particles = initial_number_of_active_particles + & 1406 SUM( nr_particles_new_r ) 1407 1408 dop_last_active_particle = initial_number_of_active_particles 1409 ! 1410 !-- Set number of new particles 1411 particle_nr = start_new_numbering 1412 nr_new_particle = 0 1413 1414 IF ( pts_increment > 1 ) THEN 1415 n_all = 0 1416 DO i = nxl, nxr 1417 DO j = nys, nyn 1418 DO k = nzb+1, nzt 1419 DO n = 1, prt_count(k,j,i) 1420 IF ( grid_particles(k,j,i)%particles(n)%particle_mask) THEN 1421 IF ( grid_particles(k,j,i)%particles(n)%particle_nr == -1 ) THEN 1422 IF ( MOD( n_all, pts_increment ) == 0 ) THEN 1350 1423 grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr 1351 particle_nr = particle_nr+1 1352 ENDIF 1353 END IF 1354 END DO 1355 END DO 1356 ENDDO 1357 ENDDO 1358 1359 1360 ENDIF 1361 1362 1363 1364 RETURN 1365 END SUBROUTINE dop_newly_generated_particles 1366 1367 SUBROUTINE dop_count_remote_particles 1368 IMPLICIT NONE 1369 1370 #if defined( __parallel ) 1371 INTEGER(iwp) :: i !< 1372 INTEGER(iwp) :: j !< 1373 INTEGER(iwp) :: k !< 1374 INTEGER(iwp) :: n !< 1375 INTEGER(iwp) :: iop !< 1376 INTEGER(iwp) :: particle_nr 1377 INTEGER(iwp) :: pe_nr 1378 INTEGER(iwp) :: win_size 1379 INTEGER(iwp) :: ierr !< MPI error code 1380 INTEGER(iwp), DIMENSION(0:numprocs-1) :: part_ind 1381 1382 ! 1383 !-- Count remote particles 1384 1385 remote_nr_particles = 0 1386 DO i=nxl,nxr 1387 DO j=nys,nyn 1388 DO k=nzb+1,nzt 1389 DO n=1,prt_count(k,j,i) 1390 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1391 IF ( particle_nr > 0) THEN 1392 DO iop=0,numprocs-1 !kk this loop has to be optimized 1393 ! 1394 !-- Although the counting is local PE based, the following if is io processor based 1395 !-- because particles in MPI shared memory do not have to be transfered 1396 IF(particle_nr < io_start_index .OR. particle_nr > io_end_index) THEN 1397 IF(particle_nr >= mo_indices(1,iop) .AND. particle_nr <= mo_indices(2,iop)) THEN 1398 remote_nr_particles(2,iop) = remote_nr_particles(2,iop)+1 1399 ENDIF 1400 ENDIF 1401 ENDDO 1402 END IF 1403 END DO 1404 END DO 1405 ENDDO 1406 ENDDO 1407 1408 remote_nr_particles(1,0) = 0 1409 DO i=1,numprocs-1 1410 remote_nr_particles(1,i) = remote_nr_particles(1,i-1) + remote_nr_particles(2,i-1) 1411 END DO 1412 1413 win_size = sum(remote_nr_particles(2,:)) 1414 CALL dop_alloc_rma_mem (transfer_buffer_i, win_size, win_rma_buf_i) 1415 CALL dop_alloc_rma_mem (transfer_buffer_r, win_size, win_rma_buf_r) 1416 1417 CALL MPI_ALLTOALL (remote_nr_particles, 2, MPI_INTEGER, rma_particles, 2, MPI_INTEGER, comm2d, ierr) 1418 1419 ! 1420 !-- The particles indices are the same for all output variables during one time step 1421 !-- therefore, the indices are transfered only once here 1422 1423 part_ind = remote_nr_particles(1,:) 1424 transfer_buffer_i = -9999 1425 1426 DO i=nxl,nxr 1427 DO j=nys,nyn 1428 DO k=nzb+1,nzt 1429 1430 DO n=1,prt_count(k,j,i) 1431 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1432 IF(particle_nr < io_start_index .OR. particle_nr > io_end_index) THEN 1433 IF (particle_nr > 0) THEN 1434 pe_nr = find_pe_from_particle_nr (particle_nr) 1435 transfer_buffer_i (part_ind(pe_nr)) = particle_nr 1436 part_ind(pe_nr) = part_ind(pe_nr)+1 1437 ENDIF 1438 ENDIF 1439 END DO 1440 END DO 1441 ENDDO 1442 ENDDO 1443 1444 CALL MPI_Barrier (MPI_COMM_WORLD, ierr) 1445 1446 CALL dop_get_remote_indices 1447 1448 #endif 1449 RETURN 1450 END SUBROUTINE dop_count_remote_particles 1451 1452 ! 1453 !- Fill ouput buffer 1454 ! 1455 ! local variables values are copied into output buffer 1456 ! local here means local to shared memory group 1457 ! remote variable values are copied into transfer buffer 1458 ! this is done by all threads 1459 1460 SUBROUTINE dop_fill_out_buf (var) 1461 IMPLICIT NONE 1462 1463 TYPE(var_def),INTENT(IN) :: var 1464 1465 INTEGER(iwp) :: i !< 1466 INTEGER(iwp) :: j !< 1467 INTEGER(iwp) :: k !< 1468 INTEGER(iwp) :: n !< 1469 INTEGER(idp) :: pval !< 1470 INTEGER(iwp) :: particle_nr 1471 INTEGER(iwp) :: pe_nr 1472 INTEGER(iwp) :: local_len 1473 CHARACTER(len=32) :: local_name 1474 INTEGER(iwp), DIMENSION(0:numprocs-1) :: part_ind 1475 1476 part_ind = remote_nr_particles(1,:) 1477 transfer_buffer_i = -9998 1478 ! 1479 !-- filling output buffer is the same for variable name and variable name_const 1480 !-- therefore set local_name without 1481 1482 local_len = INDEX(TRIM(var%name),'_const') 1483 IF(local_len == 0) THEN 1484 local_name = var%name 1485 ELSE 1486 local_name = var%name(1:local_len-1) 1487 END IF 1488 ! 1489 !-- In this subroutine the particles are seperated: 1490 ! 1491 !-- All particles which are located in the share memory area of the respective IO thread are copied into 1492 !-- the output buffer. The other output particle are copied into the transfer buffer. 1493 1494 SELECT CASE (TRIM(local_name)) 1495 CASE('origin_x') 1496 DO i=nxl,nxr 1497 DO j=nys,nyn 1498 DO k=nzb+1,nzt 1499 DO n=1,prt_count(k,j,i) 1500 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1501 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1502 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%origin_x 1503 ELSE IF (particle_nr > 0) THEN 1504 pe_nr = find_pe_from_particle_nr (particle_nr) 1505 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%origin_x 1506 part_ind(pe_nr) = part_ind(pe_nr)+1 1507 ENDIF 1508 END DO 1509 END DO 1510 ENDDO 1511 ENDDO 1512 CASE('origin_y') 1513 DO i=nxl,nxr 1514 DO j=nys,nyn 1515 DO k=nzb+1,nzt 1516 DO n=1,prt_count(k,j,i) 1517 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1518 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1519 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%origin_y 1520 ELSE IF (particle_nr > 0) THEN 1521 pe_nr = find_pe_from_particle_nr (particle_nr) 1522 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%origin_y 1523 part_ind(pe_nr) = part_ind(pe_nr)+1 1524 ENDIF 1525 END DO 1526 END DO 1527 ENDDO 1528 ENDDO 1529 CASE('origin_z') 1530 DO i=nxl,nxr 1531 DO j=nys,nyn 1532 DO k=nzb+1,nzt 1533 DO n=1,prt_count(k,j,i) 1534 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1535 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1536 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%origin_z 1537 ELSE IF (particle_nr > 0) THEN 1538 pe_nr = find_pe_from_particle_nr (particle_nr) 1539 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%origin_z 1540 part_ind(pe_nr) = part_ind(pe_nr)+1 1541 ENDIF 1542 END DO 1543 END DO 1544 ENDDO 1545 ENDDO 1546 CASE('id_low') 1547 DO i=nxl,nxr 1548 DO j=nys,nyn 1549 DO k=nzb+1,nzt 1550 DO n=1,prt_count(k,j,i) 1551 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1552 pval = IBITS(grid_particles(k,j,i)%particles(n)%id,0,32) 1553 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1554 out_buf_i(particle_nr) = INT(pval,4) 1555 ELSE IF (particle_nr > 0) THEN 1556 pe_nr = find_pe_from_particle_nr (particle_nr) 1557 transfer_buffer_i (part_ind(pe_nr)) = INT(pval,4) 1558 part_ind(pe_nr) = part_ind(pe_nr)+1 1559 ENDIF 1560 END DO 1561 END DO 1562 ENDDO 1563 ENDDO 1564 CASE('id_high') 1565 DO i=nxl,nxr 1566 DO j=nys,nyn 1567 DO k=nzb+1,nzt 1568 DO n=1,prt_count(k,j,i) 1569 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1570 pval = IBITS(grid_particles(k,j,i)%particles(n)%id,32,32) 1571 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1572 out_buf_i(particle_nr) = INT(pval,4) 1573 ELSE IF (particle_nr > 0) THEN 1574 pe_nr = find_pe_from_particle_nr (particle_nr) 1575 transfer_buffer_i (part_ind(pe_nr)) = INT(pval,4) 1576 part_ind(pe_nr) = part_ind(pe_nr)+1 1577 ENDIF 1578 END DO 1579 END DO 1580 ENDDO 1581 ENDDO 1582 CASE('particle_nr') 1583 DO i=nxl,nxr 1584 DO j=nys,nyn 1585 DO k=nzb+1,nzt 1586 DO n=1,prt_count(k,j,i) 1587 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1588 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1589 out_buf_i(particle_nr) = grid_particles(k,j,i)%particles(n)%particle_nr 1590 ELSE IF (particle_nr > 0) THEN 1591 pe_nr = find_pe_from_particle_nr (particle_nr) 1592 transfer_buffer_i (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%particle_nr 1593 part_ind(pe_nr) = part_ind(pe_nr)+1 1594 ENDIF 1595 END DO 1596 END DO 1597 ENDDO 1598 ENDDO 1599 CASE('class') 1600 DO i=nxl,nxr 1601 DO j=nys,nyn 1602 DO k=nzb+1,nzt 1603 DO n=1,prt_count(k,j,i) 1604 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1605 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1606 out_buf_i(particle_nr) = grid_particles(k,j,i)%particles(n)%class 1607 ELSE IF (particle_nr > 0) THEN 1608 pe_nr = find_pe_from_particle_nr (particle_nr) 1609 transfer_buffer_i (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%class 1610 part_ind(pe_nr) = part_ind(pe_nr)+1 1611 ENDIF 1612 END DO 1613 END DO 1614 ENDDO 1615 ENDDO 1616 CASE('group') 1617 DO i=nxl,nxr 1618 DO j=nys,nyn 1619 DO k=nzb+1,nzt 1620 DO n=1,prt_count(k,j,i) 1621 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1622 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1623 out_buf_i(particle_nr) = grid_particles(k,j,i)%particles(n)%group 1624 ELSE IF (particle_nr > 0) THEN 1625 pe_nr = find_pe_from_particle_nr (particle_nr) 1626 transfer_buffer_i (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%group 1627 part_ind(pe_nr) = part_ind(pe_nr)+1 1628 ENDIF 1629 END DO 1630 END DO 1631 ENDDO 1632 ENDDO 1633 CASE('x') 1634 DO i=nxl,nxr 1635 DO j=nys,nyn 1636 DO k=nzb+1,nzt 1637 DO n=1,prt_count(k,j,i) 1638 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1639 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1640 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%x 1641 ELSE IF (particle_nr > 0) THEN 1642 pe_nr = find_pe_from_particle_nr (particle_nr) 1643 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%x 1644 part_ind(pe_nr) = part_ind(pe_nr)+1 1645 ENDIF 1646 END DO 1647 END DO 1648 ENDDO 1649 ENDDO 1650 CASE('y') 1651 DO i=nxl,nxr 1652 DO j=nys,nyn 1653 DO k=nzb+1,nzt 1654 DO n=1,prt_count(k,j,i) 1655 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1656 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1657 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%y 1658 ELSE IF (particle_nr > 0) THEN 1659 pe_nr = find_pe_from_particle_nr (particle_nr) 1660 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%y 1661 part_ind(pe_nr) = part_ind(pe_nr)+1 1662 ENDIF 1663 END DO 1664 END DO 1665 ENDDO 1666 ENDDO 1667 CASE('z') 1668 DO i=nxl,nxr 1669 DO j=nys,nyn 1670 DO k=nzb+1,nzt 1671 DO n=1,prt_count(k,j,i) 1672 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1673 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1674 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%z 1675 ELSE IF (particle_nr > 0) THEN 1676 pe_nr = find_pe_from_particle_nr (particle_nr) 1677 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%z 1678 part_ind(pe_nr) = part_ind(pe_nr)+1 1679 ENDIF 1680 END DO 1681 END DO 1682 ENDDO 1683 ENDDO 1684 CASE('speed_x') 1685 DO i=nxl,nxr 1686 DO j=nys,nyn 1687 DO k=nzb+1,nzt 1688 DO n=1,prt_count(k,j,i) 1689 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1690 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1691 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%speed_x 1692 ELSE IF (particle_nr > 0) THEN 1693 pe_nr = find_pe_from_particle_nr (particle_nr) 1694 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%speed_x 1695 part_ind(pe_nr) = part_ind(pe_nr)+1 1696 ENDIF 1697 END DO 1698 END DO 1699 ENDDO 1700 ENDDO 1701 CASE('speed_y') 1702 DO i=nxl,nxr 1703 DO j=nys,nyn 1704 DO k=nzb+1,nzt 1705 DO n=1,prt_count(k,j,i) 1706 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1707 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1708 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%speed_y 1709 ELSE IF (particle_nr > 0) THEN 1710 pe_nr = find_pe_from_particle_nr (particle_nr) 1711 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%speed_y 1712 part_ind(pe_nr) = part_ind(pe_nr)+1 1713 ENDIF 1714 END DO 1715 END DO 1716 ENDDO 1717 ENDDO 1718 CASE('speed_z') 1719 DO i=nxl,nxr 1720 DO j=nys,nyn 1721 DO k=nzb+1,nzt 1722 DO n=1,prt_count(k,j,i) 1723 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1724 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1725 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%speed_z 1726 ELSE IF (particle_nr > 0) THEN 1727 pe_nr = find_pe_from_particle_nr (particle_nr) 1728 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%speed_z 1729 part_ind(pe_nr) = part_ind(pe_nr)+1 1730 ENDIF 1731 END DO 1732 END DO 1733 ENDDO 1734 ENDDO 1735 CASE('radius') 1736 DO i=nxl,nxr 1737 DO j=nys,nyn 1738 DO k=nzb+1,nzt 1739 DO n=1,prt_count(k,j,i) 1740 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1741 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1742 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%radius 1743 ELSE IF (particle_nr > 0) THEN 1744 pe_nr = find_pe_from_particle_nr (particle_nr) 1745 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%radius 1746 part_ind(pe_nr) = part_ind(pe_nr)+1 1747 ENDIF 1748 END DO 1749 END DO 1750 ENDDO 1751 ENDDO 1752 CASE('age') 1753 DO i=nxl,nxr 1754 DO j=nys,nyn 1755 DO k=nzb+1,nzt 1756 DO n=1,prt_count(k,j,i) 1757 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1758 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1759 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%age 1760 ELSE IF (particle_nr > 0) THEN 1761 pe_nr = find_pe_from_particle_nr (particle_nr) 1762 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%age 1763 part_ind(pe_nr) = part_ind(pe_nr)+1 1764 ENDIF 1765 END DO 1766 END DO 1767 ENDDO 1768 ENDDO 1769 CASE('age_m') 1770 DO i=nxl,nxr 1771 DO j=nys,nyn 1772 DO k=nzb+1,nzt 1773 DO n=1,prt_count(k,j,i) 1774 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1775 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1776 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%age_m 1777 ELSE IF (particle_nr > 0) THEN 1778 pe_nr = find_pe_from_particle_nr (particle_nr) 1779 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%age_m 1780 part_ind(pe_nr) = part_ind(pe_nr)+1 1781 ENDIF 1782 END DO 1783 END DO 1784 ENDDO 1785 ENDDO 1786 CASE('dt_sum') 1787 DO i=nxl,nxr 1788 DO j=nys,nyn 1789 DO k=nzb+1,nzt 1790 DO n=1,prt_count(k,j,i) 1791 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1792 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1793 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%dt_sum 1794 ELSE IF (particle_nr > 0) THEN 1795 pe_nr = find_pe_from_particle_nr (particle_nr) 1796 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%dt_sum 1797 part_ind(pe_nr) = part_ind(pe_nr)+1 1798 ENDIF 1799 END DO 1800 END DO 1801 ENDDO 1802 ENDDO 1803 CASE('e_m') 1804 DO i=nxl,nxr 1805 DO j=nys,nyn 1806 DO k=nzb+1,nzt 1807 DO n=1,prt_count(k,j,i) 1808 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1809 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1810 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%e_m 1811 ELSE IF (particle_nr > 0) THEN 1812 pe_nr = find_pe_from_particle_nr (particle_nr) 1813 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%e_m 1814 part_ind(pe_nr) = part_ind(pe_nr)+1 1815 ENDIF 1816 END DO 1817 END DO 1818 ENDDO 1819 ENDDO 1820 CASE('weight_factor') 1821 DO i=nxl,nxr 1822 DO j=nys,nyn 1823 DO k=nzb+1,nzt 1824 DO n=1,prt_count(k,j,i) 1825 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1826 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1827 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%weight_factor 1828 ELSE IF (particle_nr > 0) THEN 1829 pe_nr = find_pe_from_particle_nr (particle_nr) 1830 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%weight_factor 1831 part_ind(pe_nr) = part_ind(pe_nr)+1 1832 ENDIF 1833 END DO 1834 END DO 1835 ENDDO 1836 ENDDO 1837 CASE('aux1') 1838 DO i=nxl,nxr 1839 DO j=nys,nyn 1840 DO k=nzb+1,nzt 1841 DO n=1,prt_count(k,j,i) 1842 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1843 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1844 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%aux1 1845 ELSE IF (particle_nr > 0) THEN 1846 pe_nr = find_pe_from_particle_nr (particle_nr) 1847 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%aux1 1848 part_ind(pe_nr) = part_ind(pe_nr)+1 1849 ENDIF 1850 END DO 1851 END DO 1852 ENDDO 1853 ENDDO 1854 CASE('aux2') 1855 DO i=nxl,nxr 1856 DO j=nys,nyn 1857 DO k=nzb+1,nzt 1858 DO n=1,prt_count(k,j,i) 1859 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1860 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1861 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%aux2 1862 ELSE IF (particle_nr > 0) THEN 1863 pe_nr = find_pe_from_particle_nr (particle_nr) 1864 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%aux2 1865 part_ind(pe_nr) = part_ind(pe_nr)+1 1866 ENDIF 1867 END DO 1868 END DO 1869 ENDDO 1870 ENDDO 1871 CASE('rvar1') 1872 DO i=nxl,nxr 1873 DO j=nys,nyn 1874 DO k=nzb+1,nzt 1875 DO n=1,prt_count(k,j,i) 1876 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1877 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1878 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%rvar1 1879 ELSE IF (particle_nr > 0) THEN 1880 pe_nr = find_pe_from_particle_nr (particle_nr) 1881 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%rvar1 1882 part_ind(pe_nr) = part_ind(pe_nr)+1 1883 ENDIF 1884 END DO 1885 END DO 1886 ENDDO 1887 ENDDO 1888 CASE('rvar2') 1889 DO i=nxl,nxr 1890 DO j=nys,nyn 1891 DO k=nzb+1,nzt 1892 DO n=1,prt_count(k,j,i) 1893 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1894 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1895 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%rvar2 1896 ELSE IF (particle_nr > 0) THEN 1897 pe_nr = find_pe_from_particle_nr (particle_nr) 1898 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%rvar2 1899 part_ind(pe_nr) = part_ind(pe_nr)+1 1900 ENDIF 1901 END DO 1902 END DO 1903 ENDDO 1904 ENDDO 1905 CASE('rvar3') 1906 DO i=nxl,nxr 1907 DO j=nys,nyn 1908 DO k=nzb+1,nzt 1909 DO n=1,prt_count(k,j,i) 1910 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1911 IF(particle_nr >= io_start_index .AND. particle_nr <= io_end_index) THEN 1912 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%rvar3 1913 ELSE IF (particle_nr > 0) THEN 1914 pe_nr = find_pe_from_particle_nr (particle_nr) 1915 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%rvar3 1916 part_ind(pe_nr) = part_ind(pe_nr)+1 1917 ENDIF 1918 END DO 1919 END DO 1920 ENDDO 1921 ENDDO 1922 END SELECT 1923 1924 RETURN 1925 END SUBROUTINE dop_fill_out_buf 1926 1927 #if defined( __parallel ) 1928 ! 1929 !- Get indices (displacement) of remot particles 1930 SUBROUTINE dop_get_remote_indices 1931 1932 IMPLICIT NONE 1933 1934 INTEGER(iwp) :: i !< 1935 1936 INTEGER(iwp) :: bufsize !< size of remote indices array 1937 INTEGER(iwp) :: ind_local !< index in remore indices array 1938 INTEGER(iwp) :: ierr !< MPI error code 1939 INTEGER(KIND=MPI_ADDRESS_KIND) :: disp !< displacement in RMA window 1940 1941 bufsize = SUM(rma_particles(2,:)) 1942 ALLOCATE (remote_indices(0:bufsize)) 1943 remote_indices = -1 1944 1945 ind_local = 0 1946 CALL MPI_WIN_FENCE( 0, win_rma_buf_i, ierr ) 1947 DO i=0,numprocs-1 1948 IF (rma_particles(2,i) > 0) THEN 1949 disp = rma_particles(1,i) 1950 IF(rma_particles(2,i) > 0) THEN 1951 CALL MPI_GET (remote_indices(ind_local), rma_particles(2,i), MPI_INTEGER, i, disp, & 1952 rma_particles(2,i), MPI_INTEGER, win_rma_buf_i, ierr) 1953 ind_local = ind_local + rma_particles(2,i) 1954 END IF 1955 END IF 1956 ENDDO 1957 CALL MPI_WIN_FENCE( 0, win_rma_buf_i, ierr ) 1958 1959 RETURN 1960 END SUBROUTINE dop_get_remote_indices 1961 #endif 1962 1963 1964 SUBROUTINE dop_get_remote_particle (is_integer) 1965 1966 IMPLICIT NONE 1967 1968 LOGICAL,INTENT(IN) :: is_integer 1969 1970 #if defined( __parallel ) 1971 INTEGER(iwp) :: i !< 1972 INTEGER(iwp) :: j !< 1973 INTEGER(iwp) :: bufsize !< size of remote data array 1974 INTEGER(iwp) :: ind_local !< index in remore indices array 1975 INTEGER(iwp) :: particle_nr !< particle number 1976 INTEGER(iwp) :: ierr !< MPI error code 1977 INTEGER(KIND=MPI_ADDRESS_KIND) :: disp !< displacement in RMA window 1978 REAL(sp),ALLOCATABLE, DIMENSION(:) :: rma_buf_r !< buffer to receive remote data (REAL) 1979 INTEGER(iwp),ALLOCATABLE, DIMENSION(:) :: rma_buf_i !< buffer to receive remote data (INTEGER) 1980 1981 bufsize = sum(rma_particles(2,:)) 1982 ind_local = 0 1983 ALLOCATE (rma_buf_r(0:bufsize-1)) 1984 ALLOCATE (rma_buf_i(0:bufsize-1)) 1985 1986 IF(is_integer) THEN 1987 CALL MPI_WIN_FENCE( 0, win_rma_buf_i, ierr ) 1988 ELSE 1989 CALL MPI_WIN_FENCE( 0, win_rma_buf_r, ierr ) 1990 ENDIF 1991 DO i=0,numprocs-1 1992 IF (rma_particles(2,i) > 0) THEN 1993 IF(is_integer) THEN 1994 disp = rma_particles(1,i) 1995 CALL MPI_GET (rma_buf_i(ind_local), rma_particles(2,i), MPI_INTEGER, i, disp, & 1996 rma_particles(2,i), MPI_INTEGER, win_rma_buf_i, ierr) 1997 ind_local = ind_local + rma_particles(2,i) 1998 ELSE 1999 disp = rma_particles(1,i) 2000 CALL MPI_GET (rma_buf_r(ind_local), rma_particles(2,i), MPI_real, i, disp, & 2001 rma_particles(2,i), MPI_real, win_rma_buf_r, ierr) 2002 ind_local = ind_local + rma_particles(2,i) 2003 ENDIF 2004 END IF 2005 ENDDO 2006 IF(is_integer) THEN 2007 CALL MPI_WIN_FENCE( 0, win_rma_buf_i, ierr ) 2008 ELSE 2009 CALL MPI_WIN_FENCE( 0, win_rma_buf_r, ierr ) 2010 ENDIF 2011 2012 ind_local = 0 2013 2014 DO i=0,numprocs-1 2015 IF (rma_particles(2,i) > 0) THEN 2016 IF(is_integer) THEN 2017 ! 2018 !-- Copy data from remote PEs into output array 2019 DO j=0,rma_particles(2,i)-1 2020 particle_nr = remote_indices(ind_local) 2021 out_buf_i(particle_nr) = rma_buf_i(ind_local) 2022 ind_local = ind_local+1 2023 END DO 2024 ELSE 2025 ! 2026 !-- Copy data from remote PEs into output array 2027 2028 DO j=0,rma_particles(2,i)-1 2029 particle_nr = remote_indices(ind_local) 2030 out_buf_r(particle_nr) = rma_buf_r(ind_local) 2031 ind_local = ind_local+1 2032 END DO 2033 ENDIF 2034 END IF 2035 ENDDO 2036 2037 IF(ALLOCATED(rma_buf_r)) DEALLOCATE(rma_buf_r) 2038 IF(ALLOCATED(rma_buf_i)) DEALLOCATE(rma_buf_i) 1424 particle_nr = particle_nr + 1 1425 ELSE 1426 grid_particles(k,j,i)%particles(n)%particle_nr = -2 1427 ENDIF 1428 n_all = n_all + 1 1429 ENDIF 1430 ENDIF 1431 ENDDO 1432 ENDDO 1433 ENDDO 1434 ENDDO 1435 ELSEIF ( pts_percentage < 100.0_wp ) THEN 1436 finc = pts_percentage / 100 1437 fcount = 0.0_wp 1438 1439 DO i = nxl, nxr 1440 DO j = nys, nyn 1441 DO k = nzb+1, nzt 1442 DO n = 1, prt_count(k,j,i) 1443 IF ( grid_particles(k,j,i)%particles(n)%particle_mask ) THEN 1444 IF ( grid_particles(k,j,i)%particles(n)%particle_nr == -1 ) THEN 1445 fcount = fcount + finc 1446 IF ( nr_new_particle < INT( fcount ) ) THEN 1447 grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr 1448 particle_nr = particle_nr + 1 1449 nr_new_particle = nr_new_particle + 1 1450 ELSE 1451 grid_particles(k,j,i)%particles(n)%particle_nr = -2 1452 ENDIF 1453 ENDIF 1454 ENDIF 1455 ENDDO 1456 ENDDO 1457 ENDDO 1458 ENDDO 1459 ELSE 1460 DO i = nxl, nxr 1461 DO j = nys, nyn 1462 DO k = nzb+1, nzt 1463 DO n = 1, prt_count(k,j,i) 1464 IF ( grid_particles(k,j,i)%particles(n)%particle_mask ) THEN 1465 IF ( grid_particles(k,j,i)%particles(n)%particle_nr == -1 ) THEN 1466 grid_particles(k,j,i)%particles(n)%particle_nr = particle_nr 1467 particle_nr = particle_nr + 1 1468 ENDIF 1469 ENDIF 1470 ENDDO 1471 ENDDO 1472 ENDDO 1473 ENDDO 1474 1475 1476 ENDIF 1477 1478 1479 1480 RETURN 1481 END SUBROUTINE dop_newly_generated_particles 1482 1483 !--------------------------------------------------------------------------------------------------! 1484 ! Description: 1485 ! ------------ 1486 ! 1487 !--------------------------------------------------------------------------------------------------! 1488 SUBROUTINE dop_count_remote_particles 1489 1490 IMPLICIT NONE 1491 1492 #if defined( __parallel ) 1493 INTEGER(iwp) :: i !< 1494 INTEGER(iwp) :: ierr !< MPI error code 1495 INTEGER(iwp) :: j !< 1496 INTEGER(iwp) :: k !< 1497 INTEGER(iwp) :: n !< 1498 INTEGER(iwp) :: iop !< 1499 INTEGER(iwp) :: particle_nr 1500 INTEGER(iwp) :: pe_nr 1501 INTEGER(iwp) :: win_size 1502 1503 INTEGER(iwp), DIMENSION(0:numprocs-1) :: part_ind 1504 1505 ! 1506 !-- Count remote particles 1507 remote_nr_particles = 0 1508 DO i = nxl, nxr 1509 DO j = nys, nyn 1510 DO k = nzb+1, nzt 1511 DO n = 1, prt_count(k,j,i) 1512 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1513 IF ( particle_nr > 0 ) THEN 1514 DO iop = 0, numprocs-1 !kk this loop has to be optimized 1515 ! 1516 !-- Although the counting is local PE based, the following if is io processor 1517 !-- based because particles in MPI shared memory do not have to be transfered. 1518 IF ( particle_nr < io_start_index .OR. particle_nr > io_end_index ) THEN 1519 IF ( particle_nr >= mo_indices(1,iop) .AND. & 1520 particle_nr <= mo_indices(2,iop) ) THEN 1521 remote_nr_particles(2,iop) = remote_nr_particles(2,iop) + 1 1522 ENDIF 1523 ENDIF 1524 ENDDO 1525 ENDIF 1526 ENDDO 1527 ENDDO 1528 ENDDO 1529 ENDDO 1530 1531 remote_nr_particles(1,0) = 0 1532 DO i = 1, numprocs-1 1533 remote_nr_particles(1,i) = remote_nr_particles(1,i-1) + remote_nr_particles(2,i-1) 1534 ENDDO 1535 1536 win_size = SUM( remote_nr_particles(2,:) ) 1537 CALL dop_alloc_rma_mem( transfer_buffer_i, win_size, win_rma_buf_i ) 1538 CALL dop_alloc_rma_mem( transfer_buffer_r, win_size, win_rma_buf_r ) 1539 1540 CALL MPI_ALLTOALL( remote_nr_particles, 2, MPI_INTEGER, rma_particles, 2, MPI_INTEGER, comm2d, & 1541 ierr) 1542 1543 ! 1544 !-- The particles indices are the same for all output variables during one time step therefore, the 1545 !-- indices are transfered only once here. 1546 part_ind = remote_nr_particles(1,:) 1547 transfer_buffer_i = -9999 1548 1549 DO i = nxl, nxr 1550 DO j = nys, nyn 1551 DO k = nzb+1, nzt 1552 1553 DO n = 1, prt_count(k,j,i) 1554 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1555 IF ( particle_nr < io_start_index .OR. particle_nr > io_end_index ) THEN 1556 IF ( particle_nr > 0 ) THEN 1557 pe_nr = find_pe_from_particle_nr( particle_nr ) 1558 transfer_buffer_i(part_ind(pe_nr)) = particle_nr 1559 part_ind(pe_nr) = part_ind(pe_nr) + 1 1560 ENDIF 1561 ENDIF 1562 ENDDO 1563 ENDDO 1564 ENDDO 1565 ENDDO 1566 1567 CALL MPI_BARRIER( MPI_COMM_WORLD, ierr ) 1568 1569 CALL dop_get_remote_indices 1570 1571 #endif 1572 RETURN 1573 END SUBROUTINE dop_count_remote_particles 1574 1575 !--------------------------------------------------------------------------------------------------! 1576 ! Description: 1577 ! ------------ 1578 !> Fill ouput buffer. 1579 !> Local variables values are copied into output buffer. Local here means local to shared memory 1580 !> group. 1581 !> Remote variable values are copied into transfer buffer this is done by all threads. 1582 !--------------------------------------------------------------------------------------------------! 1583 SUBROUTINE dop_fill_out_buf (var) 1584 1585 IMPLICIT NONE 1586 1587 CHARACTER(LEN=32) :: local_name 1588 1589 INTEGER(iwp) :: i !< 1590 INTEGER(iwp) :: j !< 1591 INTEGER(iwp) :: k !< 1592 INTEGER(iwp) :: local_len !< 1593 INTEGER(iwp) :: n !< 1594 INTEGER(iwp) :: particle_nr !< 1595 INTEGER(iwp) :: pe_nr !< 1596 INTEGER(idp) :: pval !< 1597 1598 INTEGER(iwp), DIMENSION(0:numprocs-1) :: part_ind 1599 1600 TYPE(var_def), INTENT(IN) :: var 1601 1602 1603 part_ind = remote_nr_particles(1,:) 1604 transfer_buffer_i = -9998 1605 ! 1606 !-- Filling output buffer is the same for variable name and variable name_const, therefore set 1607 !-- local_name without _const 1608 local_len = INDEX( TRIM( var%name ), '_const' ) 1609 IF ( local_len == 0 ) THEN 1610 local_name = var%name 1611 ELSE 1612 local_name = var%name(1:local_len-1) 1613 ENDIF 1614 ! 1615 !-- In this subroutine the particles are seperated: 1616 ! 1617 !-- All particles which are located in the share memory area of the respective IO thread are copied 1618 !-- into the output buffer. The other output particle are copied into the transfer buffer. 1619 SELECT CASE ( TRIM( local_name ) ) 1620 CASE ( 'origin_x' ) 1621 DO i = nxl, nxr 1622 DO j = nys, nyn 1623 DO k = nzb+1, nzt 1624 DO n =1, prt_count(k,j,i) 1625 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1626 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1627 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%origin_x 1628 ELSEIF ( particle_nr > 0 ) THEN 1629 pe_nr = find_pe_from_particle_nr(particle_nr) 1630 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i) & 1631 %particles(n)%origin_x 1632 part_ind(pe_nr) = part_ind(pe_nr) + 1 1633 ENDIF 1634 ENDDO 1635 ENDDO 1636 ENDDO 1637 ENDDO 1638 CASE ( 'origin_y' ) 1639 DO i = nxl, nxr 1640 DO j = nys, nyn 1641 DO k = nzb+1, nzt 1642 DO n = 1, prt_count(k,j,i) 1643 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1644 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1645 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%origin_y 1646 ELSEIF ( particle_nr > 0 ) THEN 1647 pe_nr = find_pe_from_particle_nr (particle_nr) 1648 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i) & 1649 %particles(n)%origin_y 1650 part_ind(pe_nr) = part_ind(pe_nr) + 1 1651 ENDIF 1652 ENDDO 1653 ENDDO 1654 ENDDO 1655 ENDDO 1656 CASE ( 'origin_z' ) 1657 DO i = nxl, nxr 1658 DO j = nys, nyn 1659 DO k = nzb+1, nzt 1660 DO n = 1, prt_count(k,j,i) 1661 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1662 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1663 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%origin_z 1664 ELSEIF ( particle_nr > 0 ) THEN 1665 pe_nr = find_pe_from_particle_nr (particle_nr) 1666 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i) & 1667 %particles(n)%origin_z 1668 part_ind(pe_nr) = part_ind(pe_nr) + 1 1669 ENDIF 1670 ENDDO 1671 ENDDO 1672 ENDDO 1673 ENDDO 1674 CASE ( 'id_low' ) 1675 DO i = nxl, nxr 1676 DO j = nys, nyn 1677 DO k = nzb+1, nzt 1678 DO n = 1, prt_count(k,j,i) 1679 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1680 pval = IBITS( grid_particles(k,j,i)%particles(n)%id,0,32 ) 1681 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1682 out_buf_i(particle_nr) = INT(pval,4) 1683 ELSEIF ( particle_nr > 0 ) THEN 1684 pe_nr = find_pe_from_particle_nr(particle_nr) 1685 transfer_buffer_i(part_ind(pe_nr)) = INT( pval, 4 ) 1686 part_ind(pe_nr) = part_ind(pe_nr) + 1 1687 ENDIF 1688 ENDDO 1689 ENDDO 1690 ENDDO 1691 ENDDO 1692 CASE ( 'id_high' ) 1693 DO i = nxl, nxr 1694 DO j = nys, nyn 1695 DO k = nzb+1, nzt 1696 DO n = 1, prt_count(k,j,i) 1697 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1698 pval = IBITS( grid_particles(k,j,i)%particles(n)%id,32,32 ) 1699 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1700 out_buf_i(particle_nr) = INT(pval,4) 1701 ELSEIF ( particle_nr > 0 ) THEN 1702 pe_nr = find_pe_from_particle_nr(particle_nr) 1703 transfer_buffer_i(part_ind(pe_nr)) = INT( pval, 4 ) 1704 part_ind(pe_nr) = part_ind(pe_nr) + 1 1705 ENDIF 1706 ENDDO 1707 ENDDO 1708 ENDDO 1709 ENDDO 1710 CASE ( 'particle_nr' ) 1711 DO i = nxl, nxr 1712 DO j = nys, nyn 1713 DO k = nzb+1, nzt 1714 DO n = 1, prt_count(k,j,i) 1715 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1716 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1717 out_buf_i(particle_nr) = grid_particles(k,j,i)%particles(n)%particle_nr 1718 ELSEIF ( particle_nr > 0 ) THEN 1719 pe_nr = find_pe_from_particle_nr(particle_nr) 1720 transfer_buffer_i(part_ind(pe_nr)) = grid_particles(k,j,i) & 1721 %particles(n)%particle_nr 1722 part_ind(pe_nr) = part_ind(pe_nr) + 1 1723 ENDIF 1724 ENDDO 1725 ENDDO 1726 ENDDO 1727 ENDDO 1728 CASE ( 'class' ) 1729 DO i = nxl, nxr 1730 DO j = nys, nyn 1731 DO k = nzb+1, nzt 1732 DO n = 1, prt_count(k,j,i) 1733 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1734 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1735 out_buf_i(particle_nr) = grid_particles(k,j,i)%particles(n)%class 1736 ELSEIF ( particle_nr > 0 ) THEN 1737 pe_nr = find_pe_from_particle_nr(particle_nr) 1738 transfer_buffer_i(part_ind(pe_nr)) = grid_particles(k,j,i) & 1739 %particles(n)%class 1740 part_ind(pe_nr) = part_ind(pe_nr) + 1 1741 ENDIF 1742 ENDDO 1743 ENDDO 1744 ENDDO 1745 ENDDO 1746 CASE ( 'group' ) 1747 DO i = nxl, nxr 1748 DO j = nys, nyn 1749 DO k = nzb+1, nzt 1750 DO n = 1, prt_count(k,j,i) 1751 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1752 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1753 out_buf_i(particle_nr) = grid_particles(k,j,i)%particles(n)%group 1754 ELSEIF ( particle_nr > 0 ) THEN 1755 pe_nr = find_pe_from_particle_nr(particle_nr) 1756 transfer_buffer_i(part_ind(pe_nr)) = grid_particles(k,j,i) & 1757 %particles(n)%group 1758 part_ind(pe_nr) = part_ind(pe_nr) + 1 1759 ENDIF 1760 ENDDO 1761 ENDDO 1762 ENDDO 1763 ENDDO 1764 CASE ( 'x' ) 1765 DO i = nxl, nxr 1766 DO j = nys, nyn 1767 DO k = nzb+1, nzt 1768 DO n = 1, prt_count(k,j,i) 1769 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1770 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1771 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%x 1772 ELSEIF ( particle_nr > 0 ) THEN 1773 pe_nr = find_pe_from_particle_nr(particle_nr) 1774 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%x 1775 part_ind(pe_nr) = part_ind(pe_nr) + 1 1776 ENDIF 1777 ENDDO 1778 ENDDO 1779 ENDDO 1780 ENDDO 1781 CASE ( 'y' ) 1782 DO i = nxl, nxr 1783 DO j = nys, nyn 1784 DO k = nzb+1, nzt 1785 DO n = 1, prt_count(k,j,i) 1786 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1787 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1788 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%y 1789 ELSEIF ( particle_nr > 0 ) THEN 1790 pe_nr = find_pe_from_particle_nr(particle_nr) 1791 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%y 1792 part_ind(pe_nr) = part_ind(pe_nr) + 1 1793 ENDIF 1794 ENDDO 1795 ENDDO 1796 ENDDO 1797 ENDDO 1798 CASE ( 'z' ) 1799 DO i = nxl, nxr 1800 DO j = nys, nyn 1801 DO k = nzb+1, nzt 1802 DO n = 1, prt_count(k,j,i) 1803 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1804 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1805 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%z 1806 ELSEIF ( particle_nr > 0 ) THEN 1807 pe_nr = find_pe_from_particle_nr(particle_nr) 1808 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%z 1809 part_ind(pe_nr) = part_ind(pe_nr) + 1 1810 ENDIF 1811 ENDDO 1812 ENDDO 1813 ENDDO 1814 ENDDO 1815 CASE ( 'speed_x' ) 1816 DO i = nxl, nxr 1817 DO j = nys, nyn 1818 DO k = nzb+1, nzt 1819 DO n = 1, prt_count(k,j,i) 1820 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1821 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1822 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%speed_x 1823 ELSEIF ( particle_nr > 0 ) THEN 1824 pe_nr = find_pe_from_particle_nr(particle_nr) 1825 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i) & 1826 %particles(n)%speed_x 1827 part_ind(pe_nr) = part_ind(pe_nr) + 1 1828 ENDIF 1829 ENDDO 1830 ENDDO 1831 ENDDO 1832 ENDDO 1833 CASE ( 'speed_y' ) 1834 DO i = nxl, nxr 1835 DO j = nys, nyn 1836 DO k = nzb+1, nzt 1837 DO n = 1, prt_count(k,j,i) 1838 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1839 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1840 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%speed_y 1841 ELSEIF ( particle_nr > 0 ) THEN 1842 pe_nr = find_pe_from_particle_nr(particle_nr) 1843 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i) & 1844 %particles(n)%speed_y 1845 part_ind(pe_nr) = part_ind(pe_nr) + 1 1846 ENDIF 1847 ENDDO 1848 ENDDO 1849 ENDDO 1850 ENDDO 1851 CASE ( 'speed_z' ) 1852 DO i = nxl, nxr 1853 DO j = nys, nyn 1854 DO k = nzb+1, nzt 1855 DO n = 1, prt_count(k,j,i) 1856 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1857 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1858 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%speed_z 1859 ELSEIF ( particle_nr > 0 ) THEN 1860 pe_nr = find_pe_from_particle_nr (particle_nr) 1861 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%speed_z 1862 part_ind(pe_nr) = part_ind(pe_nr) + 1 1863 ENDIF 1864 ENDDO 1865 ENDDO 1866 ENDDO 1867 ENDDO 1868 CASE ( 'radius' ) 1869 DO i=nxl,nxr 1870 DO j=nys,nyn 1871 DO k=nzb+1,nzt 1872 DO n=1,prt_count(k,j,i) 1873 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1874 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1875 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%radius 1876 ELSEIF ( particle_nr > 0 ) THEN 1877 pe_nr = find_pe_from_particle_nr(particle_nr) 1878 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i) & 1879 %particles(n)%radius 1880 part_ind(pe_nr) = part_ind(pe_nr) + 1 1881 ENDIF 1882 ENDDO 1883 ENDDO 1884 ENDDO 1885 ENDDO 1886 CASE ( 'age' ) 1887 DO i = nxl, nxr 1888 DO j = nys, nyn 1889 DO k = nzb+1, nzt 1890 DO n = 1, prt_count(k,j,i) 1891 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1892 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1893 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%age 1894 ELSEIF ( particle_nr > 0 ) THEN 1895 pe_nr = find_pe_from_particle_nr(particle_nr) 1896 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%age 1897 part_ind(pe_nr) = part_ind(pe_nr) + 1 1898 ENDIF 1899 ENDDO 1900 ENDDO 1901 ENDDO 1902 ENDDO 1903 CASE ( 'age_m' ) 1904 DO i = nxl, nxr 1905 DO j = nys, nyn 1906 DO k = nzb+1, nzt 1907 DO n = 1, prt_count(k,j,i) 1908 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1909 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1910 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%age_m 1911 ELSEIF ( particle_nr > 0 ) THEN 1912 pe_nr = find_pe_from_particle_nr(particle_nr) 1913 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i) & 1914 %particles(n)%age_m 1915 part_ind(pe_nr) = part_ind(pe_nr) + 1 1916 ENDIF 1917 ENDDO 1918 ENDDO 1919 ENDDO 1920 ENDDO 1921 CASE ( 'dt_sum' ) 1922 DO i = nxl, nxr 1923 DO j = nys, nyn 1924 DO k = nzb+1, nzt 1925 DO n = 1, prt_count(k,j,i) 1926 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1927 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1928 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%dt_sum 1929 ELSEIF ( particle_nr > 0 ) THEN 1930 pe_nr = find_pe_from_particle_nr(particle_nr) 1931 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i) & 1932 %particles(n)%dt_sum 1933 part_ind(pe_nr) = part_ind(pe_nr) + 1 1934 ENDIF 1935 ENDDO 1936 ENDDO 1937 ENDDO 1938 ENDDO 1939 CASE( 'e_m' ) 1940 DO i = nxl, nxr 1941 DO j = nys, nyn 1942 DO k = nzb+1, nzt 1943 DO n = 1, prt_count(k,j,i) 1944 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1945 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1946 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%e_m 1947 ELSEIF ( particle_nr > 0 ) THEN 1948 pe_nr = find_pe_from_particle_nr(particle_nr) 1949 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i)%particles(n)%e_m 1950 part_ind(pe_nr) = part_ind(pe_nr) + 1 1951 ENDIF 1952 ENDDO 1953 ENDDO 1954 ENDDO 1955 ENDDO 1956 CASE ( 'weight_factor' ) 1957 DO i = nxl, nxr 1958 DO j = nys, nyn 1959 DO k = nzb+1, nzt 1960 DO n = 1, prt_count(k,j,i) 1961 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1962 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1963 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%weight_factor 1964 ELSEIF ( particle_nr > 0 ) THEN 1965 pe_nr = find_pe_from_particle_nr(particle_nr) 1966 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i) & 1967 %particles(n)%weight_factor 1968 part_ind(pe_nr) = part_ind(pe_nr) + 1 1969 ENDIF 1970 ENDDO 1971 ENDDO 1972 ENDDO 1973 ENDDO 1974 CASE ( 'aux1' ) 1975 DO i = nxl, nxr 1976 DO j = nys, nyn 1977 DO k = nzb+1, nzt 1978 DO n = 1, prt_count(k,j,i) 1979 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1980 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1981 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%aux1 1982 ELSEIF ( particle_nr > 0 ) THEN 1983 pe_nr = find_pe_from_particle_nr(particle_nr) 1984 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i) & 1985 %particles(n)%aux1 1986 part_ind(pe_nr) = part_ind(pe_nr) + 1 1987 ENDIF 1988 ENDDO 1989 ENDDO 1990 ENDDO 1991 ENDDO 1992 CASE ( 'aux2' ) 1993 DO i = nxl, nxr 1994 DO j = nys, nyn 1995 DO k = nzb+1, nzt 1996 DO n = 1, prt_count(k,j,i) 1997 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 1998 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 1999 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%aux2 2000 ELSEIF ( particle_nr > 0 ) THEN 2001 pe_nr = find_pe_from_particle_nr(particle_nr) 2002 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i) & 2003 %particles(n)%aux2 2004 part_ind(pe_nr) = part_ind(pe_nr) + 1 2005 ENDIF 2006 ENDDO 2007 ENDDO 2008 ENDDO 2009 ENDDO 2010 CASE ( 'rvar1' ) 2011 DO i = nxl, nxr 2012 DO j = nys, nyn 2013 DO k = nzb+1, nzt 2014 DO n = 1, prt_count(k,j,i) 2015 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 2016 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 2017 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%rvar1 2018 ELSEIF ( particle_nr > 0 ) THEN 2019 pe_nr = find_pe_from_particle_nr(particle_nr) 2020 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i) & 2021 %particles(n)%rvar1 2022 part_ind(pe_nr) = part_ind(pe_nr) + 1 2023 ENDIF 2024 ENDDO 2025 ENDDO 2026 ENDDO 2027 ENDDO 2028 CASE ( 'rvar2' ) 2029 DO i = nxl, nxr 2030 DO j = nys, nyn 2031 DO k = nzb+1, nzt 2032 DO n = 1, prt_count(k,j,i) 2033 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 2034 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 2035 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%rvar2 2036 ELSEIF ( particle_nr > 0 ) THEN 2037 pe_nr = find_pe_from_particle_nr (particle_nr) 2038 transfer_buffer_r (part_ind(pe_nr)) = grid_particles(k,j,i) & 2039 %particles(n)%rvar2 2040 part_ind(pe_nr) = part_ind(pe_nr) + 1 2041 ENDIF 2042 ENDDO 2043 ENDDO 2044 ENDDO 2045 ENDDO 2046 CASE ( 'rvar3' ) 2047 DO i = nxl, nxr 2048 DO j = nys, nyn 2049 DO k = nzb+1, nzt 2050 DO n = 1, prt_count(k,j,i) 2051 particle_nr = grid_particles(k,j,i)%particles(n)%particle_nr 2052 IF ( particle_nr >= io_start_index .AND. particle_nr <= io_end_index ) THEN 2053 out_buf_r(particle_nr) = grid_particles(k,j,i)%particles(n)%rvar3 2054 ELSEIF ( particle_nr > 0 ) THEN 2055 pe_nr = find_pe_from_particle_nr(particle_nr) 2056 transfer_buffer_r(part_ind(pe_nr)) = grid_particles(k,j,i) & 2057 %particles(n)%rvar3 2058 part_ind(pe_nr) = part_ind(pe_nr) + 1 2059 ENDIF 2060 ENDDO 2061 ENDDO 2062 ENDDO 2063 ENDDO 2064 END SELECT 2065 2066 RETURN 2067 END SUBROUTINE dop_fill_out_buf 2068 2069 #if defined( __parallel ) 2070 2071 !--------------------------------------------------------------------------------------------------! 2072 ! Description: 2073 ! ------------ 2074 !> Get indices (displacement) of remot particles 2075 !--------------------------------------------------------------------------------------------------! 2076 SUBROUTINE dop_get_remote_indices 2077 2078 IMPLICIT NONE 2079 2080 INTEGER(iwp) :: bufsize !< size of remote indices array 2081 INTEGER(iwp) :: i !< 2082 INTEGER(iwp) :: ierr !< MPI error code 2083 INTEGER(iwp) :: ind_local !< index in remore indices array 2084 INTEGER(KIND=MPI_ADDRESS_KIND) :: disp !< displacement in RMA window 2085 2086 2087 bufsize = SUM( rma_particles(2,:) ) 2088 ALLOCATE( remote_indices(0:bufsize) ) 2089 remote_indices = -1 2090 2091 ind_local = 0 2092 CALL MPI_WIN_FENCE( 0, win_rma_buf_i, ierr ) 2093 DO i = 0, numprocs-1 2094 IF ( rma_particles(2,i) > 0 ) THEN 2095 disp = rma_particles(1,i) 2096 IF ( rma_particles(2,i) > 0 ) THEN 2097 CALL MPI_GET( remote_indices(ind_local), rma_particles(2,i), MPI_INTEGER, i, disp, & 2098 rma_particles(2,i), MPI_INTEGER, win_rma_buf_i, ierr ) 2099 ind_local = ind_local + rma_particles(2,i) 2100 ENDIF 2101 ENDIF 2102 ENDDO 2103 CALL MPI_WIN_FENCE( 0, win_rma_buf_i, ierr ) 2104 2105 RETURN 2106 END SUBROUTINE dop_get_remote_indices 2107 #endif 2108 2109 !--------------------------------------------------------------------------------------------------! 2110 ! Description: 2111 ! ------------ 2112 !--------------------------------------------------------------------------------------------------! 2113 SUBROUTINE dop_get_remote_particle (is_integer) 2114 2115 IMPLICIT NONE 2116 2117 LOGICAL, INTENT(IN) :: is_integer 2118 2119 2120 #if defined( __parallel ) 2121 INTEGER(iwp) :: bufsize !< size of remote data array 2122 INTEGER(iwp) :: i !< 2123 INTEGER(iwp) :: ierr !< MPI error code 2124 INTEGER(iwp) :: ind_local !< index in remore indices array 2125 INTEGER(iwp) :: j !< 2126 INTEGER(iwp) :: particle_nr !< particle number 2127 INTEGER(KIND=MPI_ADDRESS_KIND) :: disp !< displacement in RMA window 2128 2129 INTEGER(iwp), ALLOCATABLE, DIMENSION(:) :: rma_buf_i !< buffer to receive remote data (INTEGER) 2130 2131 REAL(sp), ALLOCATABLE, DIMENSION(:) :: rma_buf_r !< buffer to receive remote data (REAL) 2132 2133 2134 bufsize = SUM( rma_particles(2,:) ) 2135 ind_local = 0 2136 ALLOCATE( rma_buf_r(0:bufsize-1) ) 2137 ALLOCATE( rma_buf_i(0:bufsize-1) ) 2138 2139 IF ( is_integer ) THEN 2140 CALL MPI_WIN_FENCE( 0, win_rma_buf_i, ierr ) 2141 ELSE 2142 CALL MPI_WIN_FENCE( 0, win_rma_buf_r, ierr ) 2143 ENDIF 2144 DO i = 0, numprocs-1 2145 IF ( rma_particles(2,i) > 0 ) THEN 2146 IF ( is_integer ) THEN 2147 disp = rma_particles(1,i) 2148 CALL MPI_GET( rma_buf_i(ind_local), rma_particles(2,i), MPI_INTEGER, i, disp, & 2149 rma_particles(2,i), MPI_INTEGER, win_rma_buf_i, ierr ) 2150 ind_local = ind_local + rma_particles(2,i) 2151 ELSE 2152 disp = rma_particles(1,i) 2153 CALL MPI_GET( rma_buf_r(ind_local), rma_particles(2,i), MPI_real, i, disp, & 2154 rma_particles(2,i), MPI_real, win_rma_buf_r, ierr ) 2155 ind_local = ind_local + rma_particles(2,i) 2156 ENDIF 2157 ENDIF 2158 ENDDO 2159 IF ( is_integer ) THEN 2160 CALL MPI_WIN_FENCE( 0, win_rma_buf_i, ierr ) 2161 ELSE 2162 CALL MPI_WIN_FENCE( 0, win_rma_buf_r, ierr ) 2163 ENDIF 2164 2165 ind_local = 0 2166 2167 DO i = 0, numprocs-1 2168 IF ( rma_particles(2,i) > 0 ) THEN 2169 IF ( is_integer ) THEN 2170 ! 2171 !-- Copy data from remote PEs into output array 2172 DO j = 0, rma_particles(2,i)-1 2173 particle_nr = remote_indices(ind_local) 2174 out_buf_i(particle_nr) = rma_buf_i(ind_local) 2175 ind_local = ind_local + 1 2176 ENDDO 2177 ELSE 2178 ! 2179 !-- Copy data from remote PEs into output array 2180 DO j = 0, rma_particles(2,i)-1 2181 particle_nr = remote_indices(ind_local) 2182 out_buf_r(particle_nr) = rma_buf_r(ind_local) 2183 ind_local = ind_local + 1 2184 ENDDO 2185 ENDIF 2186 ENDIF 2187 ENDDO 2188 2189 IF ( ALLOCATED( rma_buf_r) ) DEALLOCATE( rma_buf_r ) 2190 IF ( ALLOCATED( rma_buf_i) ) DEALLOCATE( rma_buf_i ) 2039 2191 #else 2040 IF ( is_integer) THEN2192 IF ( is_integer ) THEN 2041 2193 ENDIF 2042 2194 #endif 2043 2195 2044 RETURN 2045 END SUBROUTINE dop_get_remote_particle 2046 2047 #if defined( __parallel ) 2048 ! 2049 !- Allocate memory and cread window for one-sided communication (INTEGER 1-D array) 2050 SUBROUTINE dop_alloc_rma_mem_i1( array, idim1, win ) 2051 IMPLICIT NONE 2052 2053 INTEGER(isp), DIMENSION(:), POINTER, INTENT(INOUT) :: array !< 2054 INTEGER(iwp), INTENT(IN) :: idim1 !< 2055 INTEGER(iwp), INTENT(OUT) :: win !< 2056 2057 INTEGER(KIND=MPI_ADDRESS_KIND) :: winsize !< size of RMA window 2058 INTEGER :: ierr !< MPI error code 2059 2060 winsize = max(idim1, 2) 2061 2062 ALLOCATE(array(0:winsize-1)) 2063 2064 winsize = winsize * isp 2065 2066 CALL MPI_WIN_CREATE( array, winsize, isp, MPI_INFO_NULL, comm2d, win, ierr ) 2067 2068 array = -1 2069 2070 CALL MPI_WIN_FENCE( 0, win, ierr ) 2071 2072 END SUBROUTINE dop_alloc_rma_mem_i1 2073 #endif 2074 2075 #if defined( __parallel ) 2076 ! 2077 !- Allocate memory and cread window for one-sided communication (REAL 1-D array) 2078 SUBROUTINE dop_alloc_rma_mem_r1( array, idim1, win ) 2079 IMPLICIT NONE 2080 2081 REAL(sp), DIMENSION(:), POINTER, INTENT(INOUT) :: array !< 2082 INTEGER(iwp), INTENT(IN) :: idim1 !< 2083 INTEGER(iwp), INTENT(OUT) :: win !< 2084 2085 INTEGER(KIND=MPI_ADDRESS_KIND) :: winsize !< size of RMA window 2086 INTEGER :: ierr !< MPI error code 2087 2088 2089 winsize = max(idim1, 2) 2090 2091 2092 ALLOCATE(array(0:winsize-1)) 2093 2094 winsize = winsize * sp 2095 2096 CALL MPI_WIN_CREATE( array, winsize, sp, MPI_INFO_NULL, comm2d, win, ierr ) 2097 2098 array = -1.0 2099 2100 CALL MPI_WIN_FENCE( 0, win, ierr ) 2101 2102 END SUBROUTINE dop_alloc_rma_mem_r1 2103 #endif 2104 2105 2106 SUBROUTINE deallocate_and_free 2107 IMPLICIT NONE 2108 2109 #if defined( __parallel ) 2110 INTEGER :: ierr !< MPI error code 2111 #endif 2112 2113 #if defined( __parallel ) 2114 CALL MPI_Win_free (win_rma_buf_i, ierr) 2115 CALL MPI_Win_free (win_rma_buf_r, ierr) 2116 #endif 2117 IF (ALLOCATED(remote_indices)) DEALLOCATE(remote_indices) 2118 2119 DEALLOCATE(transfer_buffer_i) 2120 DEALLOCATE(transfer_buffer_r) 2121 2122 RETURN 2123 2124 END SUBROUTINE deallocate_and_free 2125 2126 FUNCTION find_pe_from_particle_nr (particle_nr) RESULT (pe_nr) 2127 IMPLICIT NONE 2128 2129 INTEGER(iwp), INTENT(IN) :: particle_nr 2130 INTEGER(iwp) :: pe_nr !< 2131 INTEGER(iwp) :: base !< 2132 INTEGER(iwp) :: pnr !< 2133 2134 IF(irregular_distribubtion) THEN 2135 IF(particle_nr <= nr_particles_rest*nr_particles_PE) THEN 2136 pe_nr = (particle_nr-1)/nr_particles_PE 2137 ELSE 2138 base = nr_particles_rest*nr_particles_PE 2139 pnr = particle_nr - base 2140 pe_nr = (pnr-1)/(nr_particles_PE-1) 2141 pe_nr = pe_nr+nr_particles_rest 2142 ENDIF 2143 ELSE 2144 pe_nr = (particle_nr-1)/nr_particles_PE 2145 ENDIF 2146 2147 2148 !kk This error test is to detect programming errors. For performance reasons it can be removed in 2149 !kk the final, stable version 2150 2151 END FUNCTION find_pe_from_particle_nr 2152 2153 END MODULE data_output_particle_mod 2196 RETURN 2197 END SUBROUTINE dop_get_remote_particle 2198 2199 #if defined( __parallel ) 2200 !--------------------------------------------------------------------------------------------------! 2201 ! Description: 2202 ! ------------ 2203 !> Allocate memory and cread window for one-sided communication (INTEGER 1-D array) 2204 !--------------------------------------------------------------------------------------------------! 2205 SUBROUTINE dop_alloc_rma_mem_i1( array, idim1, win ) 2206 2207 IMPLICIT NONE 2208 2209 INTEGER(iwp), INTENT(IN) :: idim1 !< 2210 INTEGER :: ierr !< MPI error code 2211 INTEGER(iwp), INTENT(OUT) :: win !< 2212 INTEGER(KIND=MPI_ADDRESS_KIND) :: winsize !< size of RMA window 2213 2214 INTEGER(isp), DIMENSION(:), POINTER, INTENT(INOUT) :: array !< 2215 2216 2217 winsize = MAX( idim1, 2 ) 2218 2219 ALLOCATE( array(0:winsize-1) ) 2220 2221 winsize = winsize * isp 2222 2223 CALL MPI_WIN_CREATE( array, winsize, isp, MPI_INFO_NULL, comm2d, win, ierr ) 2224 2225 array = -1 2226 2227 CALL MPI_WIN_FENCE( 0, win, ierr ) 2228 2229 END SUBROUTINE dop_alloc_rma_mem_i1 2230 #endif 2231 2232 #if defined( __parallel ) 2233 !--------------------------------------------------------------------------------------------------! 2234 ! Description: 2235 ! ------------ 2236 !> Allocate memory and cread window for one-sided communication (REAL 1-D array) 2237 !--------------------------------------------------------------------------------------------------! 2238 SUBROUTINE dop_alloc_rma_mem_r1( array, idim1, win ) 2239 2240 IMPLICIT NONE 2241 2242 INTEGER(iwp), INTENT(IN) :: idim1 !< 2243 INTEGER :: ierr !< MPI error code 2244 INTEGER(iwp), INTENT(OUT) :: win !< 2245 INTEGER(KIND=MPI_ADDRESS_KIND) :: winsize !< size of RMA window 2246 2247 REAL(sp), DIMENSION(:), POINTER, INTENT(INOUT) :: array !< 2248 2249 2250 winsize = MAX( idim1, 2 ) 2251 2252 ALLOCATE( array(0:winsize-1) ) 2253 2254 winsize = winsize * sp 2255 2256 CALL MPI_WIN_CREATE( array, winsize, sp, MPI_INFO_NULL, comm2d, win, ierr ) 2257 2258 array = -1.0_wp 2259 2260 CALL MPI_WIN_FENCE( 0, win, ierr ) 2261 2262 END SUBROUTINE dop_alloc_rma_mem_r1 2263 #endif 2264 2265 !--------------------------------------------------------------------------------------------------! 2266 ! Description: 2267 ! ------------ 2268 !--------------------------------------------------------------------------------------------------! 2269 SUBROUTINE deallocate_and_free 2270 2271 IMPLICIT NONE 2272 2273 #if defined( __parallel ) 2274 INTEGER :: ierr !< MPI error code 2275 #endif 2276 2277 #if defined( __parallel ) 2278 CALL MPI_WIN_FREE( win_rma_buf_i, ierr ) 2279 CALL MPI_WIN_FREE( win_rma_buf_r, ierr ) 2280 #endif 2281 IF ( ALLOCATED( remote_indices ) ) DEALLOCATE( remote_indices ) 2282 2283 DEALLOCATE( transfer_buffer_i ) 2284 DEALLOCATE( transfer_buffer_r ) 2285 2286 RETURN 2287 2288 END SUBROUTINE deallocate_and_free 2289 2290 2291 FUNCTION find_pe_from_particle_nr( particle_nr ) RESULT( pe_nr ) 2292 IMPLICIT NONE 2293 2294 INTEGER(iwp) :: base !< 2295 INTEGER(iwp), INTENT(IN) :: particle_nr 2296 INTEGER(iwp) :: pe_nr !< 2297 INTEGER(iwp) :: pnr !< 2298 2299 IF ( irregular_distribubtion ) THEN 2300 IF ( particle_nr <= nr_particles_rest * nr_particles_pe ) THEN 2301 pe_nr = ( particle_nr - 1 ) / nr_particles_pe 2302 ELSE 2303 base = nr_particles_rest * nr_particles_pe 2304 pnr = particle_nr - base 2305 pe_nr = ( pnr - 1 ) / ( nr_particles_pe - 1 ) 2306 pe_nr = pe_nr + nr_particles_rest 2307 ENDIF 2308 ELSE 2309 pe_nr = ( particle_nr - 1 ) / nr_particles_pe 2310 ENDIF 2311 2312 2313 !-- kk This error test is to detect programming errors. For performance reasons it can be removed 2314 !-- kk in the final, stable version. 2315 2316 END FUNCTION find_pe_from_particle_nr 2317 2318 END MODULE data_output_particle_mod -
TabularUnified palm/trunk/SOURCE/netcdf_interface_mod.f90 ¶
r4742 r4792 1 1 !> @file netcdf_interface_mod.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software 7 ! Foundation, either version 3 of the License, or (at your option) any later 8 ! version. 9 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY 11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR 12 ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. 13 ! 14 ! You should have received a copy of the GNU General Public License along with 15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 8 ! 9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 12 ! 13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ !17 !--------------------------------------------------------------------------------------------------! 19 18 ! 20 19 ! Current revisions: … … 25 24 ! ----------------- 26 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4742 2020-10-14 15:11:02Z schwenkel 27 29 ! Implement snow and graupel (bulk microphysics) 28 ! 30 ! 29 31 ! 4502 2020-04-17 16:14:16Z schwenkel 30 32 ! Implementation of ice microphysics 31 ! 33 ! 32 34 ! 4455 2020-03-11 12:20:29Z Giersch 33 35 ! Axis attribute added to netcdf output 34 ! 36 ! 35 37 ! 4400 2020-02-10 20:32:41Z suehring 36 ! Move routine to transform coordinates from netcdf_interface_mod to 38 ! Move routine to transform coordinates from netcdf_interface_mod to 37 39 ! basic_constants_and_equations_mod 38 ! 40 ! 39 41 ! 4360 2020-01-07 11:25:50Z suehring 40 42 ! Adjusted output of multi-agent system for biometeorology 41 ! 43 ! 42 44 ! 4227 2019-09-10 18:04:34Z gronemeier 43 45 ! Replace function date_time_string by call to get_date_time 44 ! 46 ! 45 47 ! 4223 2019-09-10 09:20:47Z gronemeier 46 ! replaced rotation angle from input-netCDF file 47 ! by namelist parameter 'rotation_angle' 48 ! 48 ! replaced rotation angle from input-netCDF file by namelist parameter 'rotation_angle' 49 ! 49 50 ! 4182 2019-08-22 15:20:23Z scharf 50 51 ! Corrected "Former revisions" section 51 ! 52 ! 52 53 ! 4127 2019-07-30 14:47:10Z suehring 53 ! - Introduce new vertical dimension for plant-canopy output.54 ! - Temporarlily disable masked output for soil (merge from branch resler)55 ! 54 ! - Introduce new vertical dimension for plant-canopy output. 55 ! - Temporarlily disable masked output for soil (merge from branch resler) 56 ! 56 57 ! 4069 2019-07-01 14:05:51Z Giersch 57 ! Masked output running index mid has been introduced as a local variable to 58 ! avoid runtime error(Loop variable has been modified) in time_integration59 ! 58 ! Masked output running index mid has been introduced as a local variable to avoid runtime error 59 ! (Loop variable has been modified) in time_integration 60 ! 60 61 ! 4046 2019-06-21 17:32:04Z knoop 61 62 ! removal of special treatment for usm_define_netcdf_grid call 62 ! 63 ! 63 64 ! 4039 2019-06-18 10:32:41Z suehring 64 65 ! Rename subroutines in module for diagnostic quantities … … 71 72 ! 72 73 ! 3994 2019-05-22 18:08:09Z suehring 73 ! remove origin time from time unit, compose origin_time_string within 74 ! subroutinenetcdf_create_global_atts74 ! remove origin time from time unit, compose origin_time_string within subroutine 75 ! netcdf_create_global_atts 75 76 ! 76 77 ! 3954 2019-05-06 12:49:42Z gronemeier … … 78 79 ! 79 80 ! 3953 2019-05-06 12:11:55Z gronemeier 80 ! bugfix: set origin_time and starting point of time coordinate according to 81 ! day_of_year_init andtime_utc_init81 ! bugfix: set origin_time and starting point of time coordinate according to day_of_year_init and 82 ! time_utc_init 82 83 ! 83 84 ! 3942 2019-04-30 13:08:30Z kanani … … 92 93 ! 93 94 ! 3744 2019-02-15 18:38:58Z suehring 94 ! Bugfix: - initialize return values to ensure they are set before returning 95 ! (routinedefine_geo_coordinates)95 ! Bugfix: - initialize return values to ensure they are set before returning (routine 96 ! define_geo_coordinates) 96 97 ! - change order of dimensions for some variables 97 98 ! … … 103 104 ! 104 105 ! 3655 2019-01-07 16:51:22Z knoop 105 ! Move the control parameter "salsa" from salsa_mod to control_parameters 106 ! (M. Kurppa) 106 ! Move the control parameter "salsa" from salsa_mod to control_parameters (M. Kurppa) 107 107 ! 108 108 ! Revision 1.1 2005/05/18 15:37:16 raasch … … 113 113 ! ------------ 114 114 !> In case of extend = .FALSE.: 115 !> Define all necessary dimensions, axes and variables for the different 116 !> netCDF datasets. This subroutine is called from check_open after a new117 !> dataset is created. It leaves the open netCDFfiles ready to write.115 !> Define all necessary dimensions, axes and variables for the different netCDF datasets. This 116 !> subroutine is called from check_open after a new dataset is created. It leaves the open netCDF 117 !> files ready to write. 118 118 !> 119 119 !> In case of extend = .TRUE.: 120 !> Find out if dimensions and variables of an existing file match the values 121 !> of the actual run. If so, get all necessary information (ids, etc.) from 122 !> this file. 120 !> Find out if dimensions and variables of an existing file match the values of the actual run. If 121 !> so, get all necessary information (ids, etc.) from this file. 123 122 !> 124 !> Parameter av can assume values 0 (non-averaged data) and 1 (time averaged 125 !> data) 123 !> Parameter av can assume values 0 (non-averaged data) and 1 (time averaged data) 126 124 !> 127 !> @todo calculation of output time levels for parallel NetCDF still does not 128 !> cover every exception (change of dt_do, end_time in restart) 129 !> @todo timeseries and profile output still needs to be rewritten to allow 130 !> modularization 125 !> @todo calculation of output time levels for parallel NetCDF still does not cover every exception 126 ! (change of dt_do, end_time in restart) 127 !> @todo timeseries and profile output still needs to be rewritten to allow modularization 131 128 !> @todo output 2d UTM coordinates without global arrays 132 129 !> @todo output longitude/latitude also with non-parallel output (3d and xy) 133 !------------------------------------------------------------------------------ !130 !--------------------------------------------------------------------------------------------------! 134 131 MODULE netcdf_interface 135 132 136 USE control_parameters, & 137 ONLY: biometeorology, fl_max, & 138 max_masks, multi_agent_system_end, & 139 multi_agent_system_start, & 140 rotation_angle, & 141 var_fl_max, varnamelength 133 USE control_parameters, & 134 ONLY: biometeorology, & 135 fl_max, & 136 max_masks, & 137 multi_agent_system_end, & 138 multi_agent_system_start, & 139 rotation_angle, & 140 var_fl_max, & 141 varnamelength 142 142 USE kinds 143 143 #if defined( __netcdf ) 144 144 USE NETCDF 145 145 #endif 146 USE mas_global_attributes, &146 USE mas_global_attributes, & 147 147 ONLY: dim_size_agtnum 148 148 149 USE netcdf_data_input_mod, &150 ONLY: coord_ref_sys, &151 crs_list, &149 USE netcdf_data_input_mod, & 150 ONLY: coord_ref_sys, & 151 crs_list, & 152 152 init_model 153 153 154 154 PRIVATE 155 155 156 CHARACTER (LEN=16), DIMENSION(13) :: agt_var_names = &157 (/ 'ag_id ', 'ag_x ', 'ag_y ', &158 'ag_wind ', 'ag_temp ', 'ag_group ', &159 'ag_iPT ', 'ag_PM10 ', 'ag_PM25 ', &160 'not_used ', 'not_used ', 'not_used ', &161 'not_used ' /)162 163 CHARACTER (LEN=16), DIMENSION(13) :: agt_var_units = &164 (/ 'dim_less ', 'meters ', 'meters ', &165 'm/s ', 'K ', 'dim_less ', &166 'C ', 'tbd ', 'tbd ', &167 'tbd ', 'not_used ', 'not_used ', &168 'not_used ' /)169 170 156 INTEGER(iwp), PARAMETER :: dopr_norm_num = 7, dopts_num = 29, dots_max = 100 171 172 CHARACTER (LEN=7), DIMENSION(dopr_norm_num) :: dopr_norm_names = &173 (/ 'wtheta0', 'ws2 ', 'tsw2 ', 'ws3 ', 'ws2tsw ', 'wstsw2 ', &174 'z_i ' /)175 176 CHARACTER (LEN=7), DIMENSION(dopr_norm_num) :: dopr_norm_longnames = &177 (/ 'wtheta0', 'w*2 ', 't*w2 ', 'w*3 ', 'w*2t*w ', 'w*t*w2 ', &178 'z_i ' /)179 180 CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_label = &181 (/ 'tnpt ', 'x_ ', 'y_ ', 'z_ ', 'z_abs ', 'u ', &182 'v ', 'w ', 'u" ', 'v" ', 'w" ', 'npt_up ', &183 'w_up ', 'w_down ', 'radius ', 'r_min ', 'r_max ', 'npt_max', &184 'npt_min', 'x*2 ', 'y*2 ', 'z*2 ', 'u*2 ', 'v*2 ', &185 'w*2 ', 'u"2 ', 'v"2 ', 'w"2 ', 'npt*2 ' /)186 187 CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_unit = &188 (/ 'number ', 'm ', 'm ', 'm ', 'm ', 'm/s ', &189 'm/s ', 'm/s ', 'm/s ', 'm/s ', 'm/s ', 'number ', &190 'm/s ', 'm/s ', 'm ', 'm ', 'm ', 'number ', &191 'number ', 'm2 ', 'm2 ', 'm2 ', 'm2/s2 ', 'm2/s2 ', &192 'm2/s2 ', 'm2/s2 ', 'm2/s2 ', 'm2/s2 ', 'number2' /)193 194 157 INTEGER(iwp) :: dots_num = 25 !< number of timeseries defined by default 195 158 INTEGER(iwp) :: dots_soil = 26 !< starting index for soil-timeseries 196 159 INTEGER(iwp) :: dots_rad = 32 !< starting index for radiation-timeseries 197 160 198 CHARACTER (LEN=13), DIMENSION(dots_max) :: dots_label = & 199 (/ 'E ', 'E* ', 'dt ', & 200 'us* ', 'th* ', 'umax ', & 201 'vmax ', 'wmax ', 'div_new ', & 202 'div_old ', 'zi_wtheta ', 'zi_theta ', & 203 'w* ', 'w"theta"0 ', 'w"theta" ', & 204 'wtheta ', 'theta(0) ', 'theta(z_mo) ', & 205 'w"u"0 ', 'w"v"0 ', 'w"q"0 ', & 206 'ol ', 'q* ', 'w"s" ', & 207 's* ', 'ghf ', 'qsws_liq ', & 208 'qsws_soil ', 'qsws_veg ', 'r_a ', & 209 'r_s ', & 210 'rad_net ', 'rad_lw_in ', 'rad_lw_out ', & 211 'rad_sw_in ', 'rad_sw_out ', 'rrtm_aldif ', & 212 'rrtm_aldir ', 'rrtm_asdif ', 'rrtm_asdir ', & 161 CHARACTER (LEN=16) :: heatflux_output_unit !< unit for heatflux output 162 CHARACTER (LEN=16) :: waterflux_output_unit !< unit for waterflux output 163 CHARACTER (LEN=16) :: momentumflux_output_unit !< unit for momentumflux output 164 CHARACTER (LEN=40) :: netcdf_data_format_string 165 166 CHARACTER (LEN=16), DIMENSION(13) :: agt_var_names = & 167 (/ 'ag_id ', 'ag_x ', 'ag_y ', & 168 'ag_wind ', 'ag_temp ', 'ag_group ', & 169 'ag_iPT ', 'ag_PM10 ', 'ag_PM25 ', & 170 'not_used ', 'not_used ', 'not_used ', & 171 'not_used ' /) 172 173 CHARACTER (LEN=16), DIMENSION(13) :: agt_var_units = & 174 (/ 'dim_less ', 'meters ', 'meters ', & 175 'm/s ', 'K ', 'dim_less ', & 176 'C ', 'tbd ', 'tbd ', & 177 'tbd ', 'not_used ', 'not_used ', & 178 'not_used ' /) 179 180 CHARACTER (LEN=20), DIMENSION(fl_max) :: dofl_dim_label_x 181 CHARACTER (LEN=20), DIMENSION(fl_max) :: dofl_dim_label_y 182 CHARACTER (LEN=20), DIMENSION(fl_max) :: dofl_dim_label_z 183 CHARACTER (LEN=20), DIMENSION(fl_max*var_fl_max) :: dofl_label 184 CHARACTER (LEN=20), DIMENSION(fl_max*var_fl_max) :: dofl_unit 185 186 CHARACTER (LEN=7), DIMENSION(dopr_norm_num) :: dopr_norm_names = & 187 (/ 'wtheta0', 'ws2 ', 'tsw2 ', 'ws3 ', 'ws2tsw ', 'wstsw2 ', 'z_i ' /) 188 189 CHARACTER (LEN=7), DIMENSION(dopr_norm_num) :: dopr_norm_longnames = & 190 (/ 'wtheta0', 'w*2 ', 't*w2 ', 'w*3 ', 'w*2t*w ', 'w*t*w2 ', 'z_i ' /) 191 192 CHARACTER (LEN=9), DIMENSION(300) :: dopr_unit = 'unknown' 193 194 CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_label = & 195 (/ 'tnpt ', 'x_ ', 'y_ ', 'z_ ', 'z_abs ', 'u ', & 196 'v ', 'w ', 'u" ', 'v" ', 'w" ', 'npt_up ', & 197 'w_up ', 'w_down ', 'radius ', 'r_min ', 'r_max ', 'npt_max', & 198 'npt_min', 'x*2 ', 'y*2 ', 'z*2 ', 'u*2 ', 'v*2 ', & 199 'w*2 ', 'u"2 ', 'v"2 ', 'w"2 ', 'npt*2 ' /) 200 201 CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_unit = & 202 (/ 'number ', 'm ', 'm ', 'm ', 'm ', 'm/s ', & 203 'm/s ', 'm/s ', 'm/s ', 'm/s ', 'm/s ', 'number ', & 204 'm/s ', 'm/s ', 'm ', 'm ', 'm ', 'number ', & 205 'number ', 'm2 ', 'm2 ', 'm2 ', 'm2/s2 ', 'm2/s2 ', & 206 'm2/s2 ', 'm2/s2 ', 'm2/s2 ', 'm2/s2 ', 'number2' /) 207 208 CHARACTER (LEN=13), DIMENSION(dots_max) :: dots_label = & 209 (/ 'E ', 'E* ', 'dt ', & 210 'us* ', 'th* ', 'umax ', & 211 'vmax ', 'wmax ', 'div_new ', & 212 'div_old ', 'zi_wtheta ', 'zi_theta ', & 213 'w* ', 'w"theta"0 ', 'w"theta" ', & 214 'wtheta ', 'theta(0) ', 'theta(z_mo) ', & 215 'w"u"0 ', 'w"v"0 ', 'w"q"0 ', & 216 'ol ', 'q* ', 'w"s" ', & 217 's* ', 'ghf ', 'qsws_liq ', & 218 'qsws_soil ', 'qsws_veg ', 'r_a ', & 219 'r_s ', & 220 'rad_net ', 'rad_lw_in ', 'rad_lw_out ', & 221 'rad_sw_in ', 'rad_sw_out ', 'rrtm_aldif ', & 222 'rrtm_aldir ', 'rrtm_asdif ', 'rrtm_asdir ', & 213 223 ( 'unknown ', i9 = 1, dots_max-40 ) /) 214 224 215 CHARACTER (LEN=13), DIMENSION(dots_max) :: dots_unit = &216 (/ 'm2/s2 ', 'm2/s2 ', 's ', &217 'm/s ', 'K ', 'm/s ', &218 'm/s ', 'm/s ', 's-1 ', &219 's-1 ', 'm ', 'm ', &220 'm/s ', 'K m/s ', 'K m/s ', &221 'K m/s ', 'K ', 'K ', &222 'm2/s2 ', 'm2/s2 ', 'kg m/s ', &223 'm ', 'kg/kg ', 'kg m/(kg s) ', &224 'kg/kg ', 'W/m2 ', 'W/m2 ', &225 'W/m2 ', 'W/m2 ', 's/m ', &226 's/m ', &227 'W/m2 ', 'W/m2 ', 'W/m2 ', &228 'W/m2 ', 'W/m2 ', ' ', &229 ' ', ' ', ' ', &225 CHARACTER (LEN=13), DIMENSION(dots_max) :: dots_unit = & 226 (/ 'm2/s2 ', 'm2/s2 ', 's ', & 227 'm/s ', 'K ', 'm/s ', & 228 'm/s ', 'm/s ', 's-1 ', & 229 's-1 ', 'm ', 'm ', & 230 'm/s ', 'K m/s ', 'K m/s ', & 231 'K m/s ', 'K ', 'K ', & 232 'm2/s2 ', 'm2/s2 ', 'kg m/s ', & 233 'm ', 'kg/kg ', 'kg m/(kg s) ', & 234 'kg/kg ', 'W/m2 ', 'W/m2 ', & 235 'W/m2 ', 'W/m2 ', 's/m ', & 236 's/m ', & 237 'W/m2 ', 'W/m2 ', 'W/m2 ', & 238 'W/m2 ', 'W/m2 ', ' ', & 239 ' ', ' ', ' ', & 230 240 ( 'unknown ', i9 = 1, dots_max-40 ) /) 231 241 232 CHARACTER (LEN=16) :: heatflux_output_unit !< unit for heatflux output 233 CHARACTER (LEN=16) :: waterflux_output_unit !< unit for waterflux output 234 CHARACTER (LEN=16) :: momentumflux_output_unit !< unit for momentumflux output 235 236 CHARACTER (LEN=9), DIMENSION(300) :: dopr_unit = 'unknown' 242 CHARACTER (LEN=20), DIMENSION(11) :: netcdf_precision = ' ' 237 243 238 244 CHARACTER (LEN=7), DIMENSION(0:1,500) :: do2d_unit, do3d_unit … … 260 266 ! 'not_used ' /) 261 267 262 CHARACTER(LEN=20), DIMENSION(11) :: netcdf_precision = ' ' 263 CHARACTER(LEN=40) :: netcdf_data_format_string 264 265 INTEGER(iwp) :: id_dim_agtnum, id_dim_time_agt, & 266 id_dim_time_fl, id_dim_time_pr, & 267 id_dim_time_pts, id_dim_time_sp, id_dim_time_ts, & 268 id_dim_x_sp, id_dim_y_sp, id_dim_zu_sp, id_dim_zw_sp, & 269 id_set_agt, id_set_fl, id_set_pr, id_set_prt, id_set_pts, & 270 id_set_sp, id_set_ts, id_var_agtnum, id_var_time_agt, & 271 id_var_time_fl, id_var_rnoa_agt, id_var_time_pr, & 272 id_var_time_pts, id_var_time_sp, id_var_time_ts, & 273 id_var_x_sp, id_var_y_sp, id_var_zu_sp, id_var_zw_sp, & 268 INTEGER(iwp) :: dofl_time_count 269 270 INTEGER(iwp) :: id_dim_agtnum, id_dim_time_agt, id_dim_time_fl, id_dim_time_pr, & 271 id_dim_time_pts, id_dim_time_sp, id_dim_time_ts, id_dim_x_sp, id_dim_y_sp, & 272 id_dim_zu_sp, id_dim_zw_sp, & 273 id_set_agt, id_set_fl, id_set_pr, id_set_prt, id_set_pts, id_set_sp, & 274 id_set_ts, & 275 id_var_agtnum, id_var_time_agt, id_var_time_fl, id_var_rnoa_agt, & 276 id_var_time_pr, id_var_time_pts, id_var_time_sp, id_var_time_ts, id_var_x_sp, & 277 id_var_y_sp, id_var_zu_sp, id_var_zw_sp, & 274 278 nc_stat 275 279 276 277 INTEGER(iwp), DIMENSION(0:1) :: id_dim_time_xy, id_dim_time_xz, & 278 id_dim_time_yz, id_dim_time_3d, id_dim_x_xy, id_dim_xu_xy, & 279 id_dim_x_xz, id_dim_xu_xz, id_dim_x_yz, id_dim_xu_yz, & 280 id_dim_x_3d, id_dim_xu_3d, id_dim_y_xy, id_dim_yv_xy, & 281 id_dim_y_xz, id_dim_yv_xz, id_dim_y_yz, id_dim_yv_yz, & 282 id_dim_y_3d, id_dim_yv_3d, id_dim_zs_xy, id_dim_zs_xz, & 283 id_dim_zs_yz, id_dim_zs_3d, id_dim_zpc_3d, & 284 id_dim_zu_xy, id_dim_zu1_xy, & 285 id_dim_zu_xz, id_dim_zu_yz, id_dim_zu_3d, id_dim_zw_xy, & 286 id_dim_zw_xz, id_dim_zw_yz, id_dim_zw_3d, id_set_xy, & 287 id_set_xz, id_set_yz, id_set_3d, id_var_ind_x_yz, & 288 id_var_ind_y_xz, id_var_ind_z_xy, id_var_time_xy, & 289 id_var_time_xz, id_var_time_yz, id_var_time_3d, id_var_x_xy, & 290 id_var_xu_xy, id_var_x_xz, id_var_xu_xz, id_var_x_yz, & 291 id_var_xu_yz, id_var_x_3d, id_var_xu_3d, id_var_y_xy, & 292 id_var_yv_xy, id_var_y_xz, id_var_yv_xz, id_var_y_yz, & 293 id_var_yv_yz, id_var_y_3d, id_var_yv_3d, id_var_zs_xy, & 294 id_var_zs_xz, id_var_zs_yz, id_var_zs_3d, id_var_zpc_3d, & 295 id_var_zusi_xy, id_var_zusi_3d, id_var_zu_xy, id_var_zu1_xy, id_var_zu_xz, & 296 id_var_zu_yz, id_var_zu_3d, id_var_zwwi_xy, id_var_zwwi_3d, & 297 id_var_zw_xy, id_var_zw_xz, id_var_zw_yz, id_var_zw_3d 298 299 INTEGER(iwp), DIMENSION(0:2,0:1) :: id_var_eutm_3d, id_var_nutm_3d, & 300 id_var_eutm_xy, id_var_nutm_xy, & 301 id_var_eutm_xz, id_var_nutm_xz, & 302 id_var_eutm_yz, id_var_nutm_yz 303 304 INTEGER(iwp), DIMENSION(0:2,0:1) :: id_var_lat_3d, id_var_lon_3d, & 305 id_var_lat_xy, id_var_lon_xy, & 306 id_var_lat_xz, id_var_lon_xz, & 307 id_var_lat_yz, id_var_lon_yz 308 309 INTEGER :: netcdf_data_format = 2 !< NetCDF3 64bit offset format 310 INTEGER :: netcdf_deflate = 0 !< NetCDF compression, default: no 311 !< compression 312 313 INTEGER(iwp) :: dofl_time_count 314 INTEGER(iwp), DIMENSION(10) :: id_var_dospx, id_var_dospy 315 INTEGER(iwp), DIMENSION(20) :: id_var_agt 316 ! INTEGER(iwp), DIMENSION(20) :: id_var_prt 317 INTEGER(iwp), DIMENSION(11) :: nc_precision 280 INTEGER :: netcdf_data_format = 2 !< NetCDF3 64bit offset format 281 INTEGER :: netcdf_deflate = 0 !< NetCDF compression, default: no 282 !< compression 283 284 INTEGER(iwp), DIMENSION(20) :: id_var_agt 285 INTEGER(iwp), DIMENSION(10) :: id_var_dospx, id_var_dospy 318 286 INTEGER(iwp), DIMENSION(dopr_norm_num) :: id_var_norm_dopr 319 320 INTEGER(iwp), DIMENSION(fl_max) :: id_dim_x_fl, id_dim_y_fl, id_dim_z_fl 321 INTEGER(iwp), DIMENSION(fl_max) :: id_var_x_fl, id_var_y_fl, id_var_z_fl 322 323 CHARACTER (LEN=20), DIMENSION(fl_max*var_fl_max) :: dofl_label 324 CHARACTER (LEN=20), DIMENSION(fl_max*var_fl_max) :: dofl_unit 325 CHARACTER (LEN=20), DIMENSION(fl_max) :: dofl_dim_label_x 326 CHARACTER (LEN=20), DIMENSION(fl_max) :: dofl_dim_label_y 327 CHARACTER (LEN=20), DIMENSION(fl_max) :: dofl_dim_label_z 328 287 ! INTEGER(iwp), DIMENSION(20) :: id_var_prt 288 INTEGER(iwp), DIMENSION(11) :: nc_precision 289 290 INTEGER(iwp), DIMENSION(fl_max) :: id_dim_x_fl, id_dim_y_fl, id_dim_z_fl 329 291 INTEGER(iwp), DIMENSION(fl_max*var_fl_max) :: id_var_dofl 292 INTEGER(iwp), DIMENSION(fl_max) :: id_var_x_fl, id_var_y_fl, id_var_z_fl 293 294 INTEGER(iwp), DIMENSION(0:1) :: id_dim_time_xy, id_dim_time_xz, id_dim_time_yz, & 295 id_dim_time_3d, id_dim_x_xy, id_dim_xu_xy, id_dim_x_xz, & 296 id_dim_xu_xz, id_dim_x_yz, id_dim_xu_yz, id_dim_x_3d, & 297 id_dim_xu_3d, id_dim_y_xy, id_dim_yv_xy, id_dim_y_xz, & 298 id_dim_yv_xz, id_dim_y_yz, id_dim_yv_yz, id_dim_y_3d, & 299 id_dim_yv_3d, id_dim_zs_xy, id_dim_zs_xz, id_dim_zs_yz, & 300 id_dim_zs_3d, id_dim_zpc_3d, id_dim_zu_xy, id_dim_zu1_xy, & 301 id_dim_zu_xz, id_dim_zu_yz, id_dim_zu_3d, id_dim_zw_xy, & 302 id_dim_zw_xz, id_dim_zw_yz, id_dim_zw_3d, & 303 id_set_xy, id_set_xz, id_set_yz, id_set_3d, & 304 id_var_ind_x_yz, id_var_ind_y_xz, id_var_ind_z_xy, & 305 id_var_time_xy, id_var_time_xz, id_var_time_yz, & 306 id_var_time_3d, id_var_x_xy, id_var_xu_xy, id_var_x_xz, & 307 id_var_xu_xz, id_var_x_yz, id_var_xu_yz, id_var_x_3d, & 308 id_var_xu_3d, id_var_y_xy, id_var_yv_xy, id_var_y_xz, & 309 id_var_yv_xz, id_var_y_yz, id_var_yv_yz, id_var_y_3d, & 310 id_var_yv_3d, id_var_zs_xy, id_var_zs_xz, id_var_zs_yz, & 311 id_var_zs_3d, id_var_zpc_3d, id_var_zusi_xy, id_var_zusi_3d, & 312 id_var_zu_xy, id_var_zu1_xy, id_var_zu_xz, id_var_zu_yz, & 313 id_var_zu_3d, id_var_zwwi_xy, id_var_zwwi_3d, id_var_zw_xy, & 314 id_var_zw_xz, id_var_zw_yz, id_var_zw_3d 315 316 INTEGER(iwp), DIMENSION(0:2,0:1) :: id_var_eutm_3d, id_var_eutm_xy, id_var_eutm_xz, & 317 id_var_eutm_yz, & 318 id_var_nutm_3d, id_var_nutm_xy, id_var_nutm_xz, & 319 id_var_nutm_yz 320 321 INTEGER(iwp), DIMENSION(0:2,0:1) :: id_var_lat_3d, id_var_lat_xy, id_var_lat_xz, & 322 id_var_lat_yz, & 323 id_var_lon_3d, id_var_lon_xy, id_var_lon_xz, id_var_lon_yz 324 330 325 331 326 INTEGER(iwp), DIMENSION(dopts_num,0:10) :: id_var_dopts 332 327 INTEGER(iwp), DIMENSION(0:1,500) :: id_var_do2d, id_var_do3d 333 INTEGER(iwp), DIMENSION(100,0:99) :: id_dim_z_pr, id_var_dopr, & 334 id_var_z_pr 328 INTEGER(iwp), DIMENSION(100,0:99) :: id_dim_z_pr, id_var_dopr, id_var_z_pr 335 329 INTEGER(iwp), DIMENSION(dots_max,0:99) :: id_var_dots 336 330 … … 339 333 CHARACTER (LEN=7), DIMENSION(max_masks,0:1,100) :: domask_unit 340 334 335 INTEGER(iwp), DIMENSION(1:max_masks,0:1) :: id_dim_time_mask, id_dim_x_mask, id_dim_xu_mask, & 336 id_dim_y_mask, id_dim_yv_mask, id_dim_zs_mask, & 337 id_dim_zu_mask, id_dim_zw_mask, & 338 id_set_mask, & 339 id_var_time_mask, id_var_x_mask, id_var_xu_mask, & 340 id_var_y_mask, id_var_yv_mask, id_var_zs_mask, & 341 id_var_zu_mask, id_var_zw_mask, & 342 id_var_zusi_mask, id_var_zwwi_mask 343 344 345 INTEGER(iwp), DIMENSION(1:max_masks,0:1,100) :: id_var_domask 346 INTEGER(iwp), DIMENSION(0:2,1:max_masks,0:1) :: id_var_eutm_mask, id_var_nutm_mask 347 INTEGER(iwp), DIMENSION(0:2,1:max_masks,0:1) :: id_var_lat_mask, id_var_lon_mask 348 349 341 350 LOGICAL :: output_for_t0 = .FALSE. 342 351 343 INTEGER(iwp), DIMENSION(1:max_masks,0:1) :: id_dim_time_mask, id_dim_x_mask, &344 id_dim_xu_mask, id_dim_y_mask, id_dim_yv_mask, id_dim_zs_mask, &345 id_dim_zu_mask, id_dim_zw_mask, &346 id_set_mask, &347 id_var_time_mask, id_var_x_mask, id_var_xu_mask, &348 id_var_y_mask, id_var_yv_mask, id_var_zs_mask, &349 id_var_zu_mask, id_var_zw_mask, &350 id_var_zusi_mask, id_var_zwwi_mask351 352 INTEGER(iwp), DIMENSION(0:2,1:max_masks,0:1) :: id_var_eutm_mask, &353 id_var_nutm_mask354 355 INTEGER(iwp), DIMENSION(0:2,1:max_masks,0:1) :: id_var_lat_mask, &356 id_var_lon_mask357 358 INTEGER(iwp), DIMENSION(1:max_masks,0:1,100) :: id_var_domask359 360 352 REAL(wp) :: fill_value = -9999.0_wp !< value for the _FillValue attribute 361 353 362 354 363 PUBLIC dofl_dim_label_x, dofl_dim_label_y, dofl_dim_label_z, dofl_label, & 364 dofl_time_count, dofl_unit, domask_unit, dopr_unit, dopts_num, & 365 dots_label, dots_max, dots_num, dots_rad, dots_soil, dots_unit, & 366 do2d_unit, do3d_unit, fill_value, id_set_agt, id_set_fl, & 367 id_set_mask, id_set_pr, id_set_prt, id_set_pts, id_set_sp, & 368 id_set_ts, id_set_xy, id_set_xz, id_set_yz, id_set_3d, id_var_agt, & 369 id_var_domask, id_var_dofl, id_var_dopr, id_var_dopts, & 370 id_var_dospx, id_var_dospy, id_var_dots, id_var_do2d, id_var_do3d, & 371 id_var_norm_dopr, id_var_time_agt, id_var_time_fl, & 372 id_var_time_mask, id_var_time_pr, id_var_rnoa_agt, id_var_time_pts,& 373 id_var_time_sp, id_var_time_ts, & 374 id_var_time_xy, id_var_time_xz, id_var_time_yz, id_var_time_3d, & 375 id_var_x_fl, id_var_y_fl, id_var_z_fl, nc_stat, & 376 netcdf_data_format, netcdf_data_format_string, netcdf_deflate, & 377 netcdf_precision, output_for_t0, heatflux_output_unit, & 378 waterflux_output_unit, momentumflux_output_unit 355 PUBLIC dofl_dim_label_x, dofl_dim_label_y, dofl_dim_label_z, dofl_label, dofl_time_count, & 356 dofl_unit, domask_unit, dopr_unit, dopts_num, dots_label, dots_max, dots_num, dots_rad,& 357 dots_soil, dots_unit, do2d_unit, do3d_unit, fill_value, id_set_agt, id_set_fl, & 358 id_set_mask, id_set_pr, id_set_prt, id_set_pts, id_set_sp, id_set_ts, id_set_xy, & 359 id_set_xz, id_set_yz, id_set_3d, id_var_agt, id_var_domask, id_var_dofl, id_var_dopr, & 360 id_var_dopts, id_var_dospx, id_var_dospy, id_var_dots, id_var_do2d, id_var_do3d, & 361 id_var_norm_dopr, id_var_time_agt, id_var_time_fl, id_var_time_mask, id_var_time_pr, & 362 id_var_rnoa_agt, id_var_time_pts, id_var_time_sp, id_var_time_ts, id_var_time_xy, & 363 id_var_time_xz, id_var_time_yz, id_var_time_3d, id_var_x_fl, id_var_y_fl, id_var_z_fl, & 364 nc_stat, netcdf_data_format, netcdf_data_format_string, netcdf_deflate, & 365 netcdf_precision, output_for_t0, heatflux_output_unit, waterflux_output_unit, & 366 momentumflux_output_unit 379 367 380 368 SAVE … … 412 400 END INTERFACE netcdf_open_write_file 413 401 414 PUBLIC netcdf_create_att, netcdf_create_dim, netcdf_create_file, & 415 netcdf_create_global_atts, netcdf_create_var, netcdf_define_header, & 416 netcdf_handle_error, netcdf_open_write_file 402 PUBLIC netcdf_create_att, netcdf_create_dim, netcdf_create_file, netcdf_create_global_atts, & 403 netcdf_create_var, netcdf_define_header, netcdf_handle_error, netcdf_open_write_file 417 404 418 405 CONTAINS … … 422 409 #if defined( __netcdf ) 423 410 424 USE arrays_3d, &411 USE arrays_3d, & 425 412 ONLY: zu, zw 426 413 427 USE biometeorology_mod, &414 USE biometeorology_mod, & 428 415 ONLY: bio_define_netcdf_grid 429 416 430 USE chemistry_model_mod, &417 USE chemistry_model_mod, & 431 418 ONLY: chem_define_netcdf_grid 432 419 433 USE basic_constants_and_equations_mod, &434 ONLY: convert_utm_to_geographic, &420 USE basic_constants_and_equations_mod, & 421 ONLY: convert_utm_to_geographic, & 435 422 pi 436 423 437 USE control_parameters, & 438 ONLY: agent_time_unlimited, air_chemistry, averaging_interval, & 439 averaging_interval_pr, data_output_pr, domask, dopr_n, & 440 dopr_time_count, dopts_time_count, dots_time_count, & 441 do2d, do2d_at_begin, do2d_xz_time_count, do3d, do3d_at_begin, & 442 do2d_yz_time_count, dt_data_output_av, dt_do2d_xy, dt_do2d_xz, & 443 dt_do2d_yz, dt_do3d, dt_write_agent_data, mask_size, & 444 do2d_xy_time_count, do3d_time_count, domask_time_count, & 445 end_time, indoor_model, land_surface, & 446 mask_size_l, mask_i, mask_i_global, mask_j, mask_j_global, & 447 mask_k_global, mask_surface, & 448 message_string, ntdim_2d_xy, ntdim_2d_xz, & 449 ntdim_2d_yz, ntdim_3d, nz_do3d, ocean_mode, plant_canopy, & 450 run_description_header, salsa, section, simulated_time, & 451 simulated_time_at_begin, skip_time_data_output_av, & 452 skip_time_do2d_xy, skip_time_do2d_xz, skip_time_do2d_yz, & 453 skip_time_do3d, topography, num_leg, num_var_fl, & 454 urban_surface 455 456 USE diagnostic_output_quantities_mod, & 424 USE control_parameters, & 425 ONLY: agent_time_unlimited, air_chemistry, averaging_interval, averaging_interval_pr, & 426 data_output_pr, domask, dopr_n, dopr_time_count, dopts_time_count, dots_time_count, & 427 do2d, do2d_at_begin, do2d_xz_time_count, do3d, do3d_at_begin, do2d_yz_time_count, & 428 dt_data_output_av, dt_do2d_xy, dt_do2d_xz, dt_do2d_yz, dt_do3d, dt_write_agent_data,& 429 mask_size, do2d_xy_time_count, do3d_time_count, domask_time_count, end_time, & 430 indoor_model, land_surface, mask_size_l, mask_i, mask_i_global, mask_j, & 431 mask_j_global, mask_k_global, mask_surface, message_string, ntdim_2d_xy, & 432 ntdim_2d_xz, ntdim_2d_yz, ntdim_3d, nz_do3d, ocean_mode, plant_canopy, & 433 run_description_header, salsa, section, simulated_time, simulated_time_at_begin, & 434 skip_time_data_output_av, skip_time_do2d_xy, skip_time_do2d_xz, skip_time_do2d_yz, & 435 skip_time_do3d, topography, num_leg, num_var_fl, urban_surface 436 437 USE diagnostic_output_quantities_mod, & 457 438 ONLY: doq_define_netcdf_grid 458 439 459 USE grid_variables, &440 USE grid_variables, & 460 441 ONLY: dx, dy, zu_s_inner, zw_w_inner 461 442 462 USE gust_mod, &443 USE gust_mod, & 463 444 ONLY: gust_define_netcdf_grid, gust_module_enabled 464 445 465 USE indices, &446 USE indices, & 466 447 ONLY: nx, nxl, nxr, ny, nys, nyn, nz ,nzb, nzt 467 448 468 449 USE kinds 469 450 470 USE indoor_model_mod, &451 USE indoor_model_mod, & 471 452 ONLY: im_define_netcdf_grid 472 453 473 USE land_surface_model_mod, &454 USE land_surface_model_mod, & 474 455 ONLY: lsm_define_netcdf_grid, nzb_soil, nzt_soil, nzs, zs 475 456 476 USE ocean_mod, &457 USE ocean_mod, & 477 458 ONLY: ocean_define_netcdf_grid 478 459 479 460 USE pegrid 480 461 481 USE particle_attributes, &462 USE particle_attributes, & 482 463 ONLY: number_of_particle_groups 483 464 484 USE plant_canopy_model_mod, &465 USE plant_canopy_model_mod, & 485 466 ONLY: pch_index, pcm_define_netcdf_grid 486 467 487 USE profil_parameter, &468 USE profil_parameter, & 488 469 ONLY: crmax, cross_profiles, dopr_index, profile_columns, profile_rows 489 470 490 USE radiation_model_mod, &471 USE radiation_model_mod, & 491 472 ONLY: radiation, radiation_define_netcdf_grid 492 473 493 USE salsa_mod, &474 USE salsa_mod, & 494 475 ONLY: salsa_define_netcdf_grid 495 476 496 USE spectra_mod, & 497 ONLY: averaging_interval_sp, comp_spectra_level, data_output_sp, dosp_time_count, spectra_direction 498 499 USE statistics, & 477 USE spectra_mod, & 478 ONLY: averaging_interval_sp, comp_spectra_level, data_output_sp, dosp_time_count, & 479 spectra_direction 480 481 USE statistics, & 500 482 ONLY: hom, statistic_regions 501 483 502 USE turbulence_closure_mod, &484 USE turbulence_closure_mod, & 503 485 ONLY: tcm_define_netcdf_grid 504 486 505 USE urban_surface_mod, &487 USE urban_surface_mod, & 506 488 ONLY: usm_define_netcdf_grid 507 489 508 USE user, &490 USE user, & 509 491 ONLY: user_module_enabled, user_define_netcdf_grid 510 492 … … 513 495 IMPLICIT NONE 514 496 515 CHARACTER (LEN=3) :: suffix !<516 497 CHARACTER (LEN=2), INTENT (IN) :: callmode !< 498 CHARACTER (LEN=4000) :: char_cross_profiles !< 517 499 CHARACTER (LEN=4) :: grid_x !< 518 500 CHARACTER (LEN=4) :: grid_y !< 519 501 CHARACTER (LEN=4) :: grid_z !< 520 502 CHARACTER (LEN=6) :: mode !< 503 CHARACTER (LEN=20) :: netcdf_var_name !< 521 504 CHARACTER (LEN=10) :: precision !< 505 CHARACTER (LEN=3) :: suffix !< 506 CHARACTER (LEN=80) :: time_average_text !< 507 CHARACTER (LEN=varnamelength) :: trimvar !< TRIM of output-variable string 522 508 CHARACTER (LEN=10) :: var !< 523 CHARACTER (LEN=20) :: netcdf_var_name !<524 CHARACTER (LEN=varnamelength) :: trimvar !< TRIM of output-variable string525 CHARACTER (LEN=80) :: time_average_text !<526 CHARACTER (LEN=4000) :: char_cross_profiles !<527 509 CHARACTER (LEN=4000) :: var_list !< 528 510 CHARACTER (LEN=4000) :: var_list_old !< … … 545 527 INTEGER(iwp) :: k !< 546 528 INTEGER(iwp) :: kk !< 529 INTEGER(iwp) :: l !< 547 530 INTEGER(iwp) :: mid !< masked output running index 548 531 INTEGER(iwp) :: ns !< … … 551 534 INTEGER(iwp) :: ntime_count !< number of time levels found in file 552 535 INTEGER(iwp) :: nz_old !< 553 INTEGER(iwp) :: l !<554 536 555 537 INTEGER(iwp), SAVE :: oldmode !< … … 566 548 INTEGER(iwp), DIMENSION(1:crmax) :: cross_profiles_numb !< 567 549 568 LOGICAL :: found !<569 570 550 LOGICAL, INTENT (INOUT) :: extend !< 551 LOGICAL :: found !< 571 552 572 553 LOGICAL, SAVE :: init_netcdf = .FALSE. !< … … 591 572 IF ( .NOT. init_netcdf ) THEN 592 573 ! 593 !-- Check and set accuracy for netCDF output. First set default value 574 !-- Check and set accuracy for netCDF output. First set default value. 594 575 nc_precision = NF90_REAL4 595 576 … … 598 579 j = INDEX( netcdf_precision(i), '_' ) 599 580 IF ( j == 0 ) THEN 600 WRITE ( message_string, * ) 'netcdf_precision must contain a ', &601 '"_"netcdf_precision(', i, ')="', &581 WRITE ( message_string, * ) 'netcdf_precision must contain a ', & 582 '"_"netcdf_precision(', i, ')="', & 602 583 TRIM( netcdf_precision(i) ),'"' 603 584 CALL message( 'netcdf_define_header', 'PA0241', 2, 2, 0, 6, 0 ) … … 612 593 j = NF90_REAL8 613 594 ELSE 614 WRITE ( message_string, * ) 'illegal netcdf precision: ', &615 'netcdf_precision(', i, ')="', &595 WRITE ( message_string, * ) 'illegal netcdf precision: ', & 596 'netcdf_precision(', i, ')="', & 616 597 TRIM( netcdf_precision(i) ),'"' 617 598 CALL message( 'netcdf_define_header', 'PA0242', 1, 2, 0, 6, 0 ) … … 645 626 646 627 CASE DEFAULT 647 WRITE ( message_string, * ) 'unknown variable in ' // & 648 'initialization_parameters ', & 649 'assignment: netcdf_precision(', i, ')="', & 628 WRITE ( message_string, * ) 'unknown variable in ' // 'initialization_parameters ',& 629 'assignment: netcdf_precision(', i, ')="', & 650 630 TRIM( netcdf_precision(i) ),'"' 651 631 CALL message( 'netcdf_define_header', 'PA0243', 1, 2, 0, 6, 0 ) … … 660 640 !-- Check for allowed parameter range 661 641 IF ( netcdf_deflate < 0 .OR. netcdf_deflate > 9 ) THEN 662 WRITE ( message_string, '(A,I3,A)' ) 'netcdf_deflate out of ' // & 663 'range & given value: ', netcdf_deflate, & 664 ', allowed range: 0-9' 642 WRITE ( message_string, '(A,I3,A)' ) 'netcdf_deflate out of ' // 'range & given value: ',& 643 netcdf_deflate, ', allowed range: 0-9' 665 644 CALL message( 'netcdf_define_header', 'PA0355', 2, 2, 0, 6, 0 ) 666 645 ENDIF … … 687 666 688 667 ! 689 !-- Select the mode to be processed. Possibilities are 3d, ma (mask), xy, xz, 690 !-- yz, pr (profiles), ps (particle timeseries), fl (flight data), ts 691 !-- (timeseries) or sp (spectra) 668 !-- Select the mode to be processed. Possibilities are 3d, ma (mask), xy, xz, yz, pr (profiles), ps 669 !-- (particle timeseries), fl (flight data), ts (timeseries) or sp (spectra). 692 670 SELECT CASE ( mode ) 693 671 … … 695 673 696 674 ! 697 !-- decompose actual parameter file_id (=formal parameter av) into 698 !-- mid and av 675 !-- Decompose actual parameter file_id (=formal parameter av) into mid and av 699 676 file_id = av 700 677 IF ( file_id <= 200+max_masks ) THEN … … 709 686 !-- Define some global attributes of the dataset 710 687 IF ( av == 0 ) THEN 711 CALL netcdf_create_global_atts( id_set_mask(mid,av), 'podsmasked', TRIM( run_description_header ), 464 ) 688 CALL netcdf_create_global_atts( id_set_mask(mid,av), 'podsmasked', & 689 TRIM( run_description_header ), 464 ) 712 690 time_average_text = ' ' 713 691 ELSE 714 CALL netcdf_create_global_atts( id_set_mask(mid,av), 'podsmasked', TRIM( run_description_header ), 464 ) 692 CALL netcdf_create_global_atts( id_set_mask(mid,av), 'podsmasked', & 693 TRIM( run_description_header ), 464 ) 715 694 WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval 716 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'time_avg', &695 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'time_avg', & 717 696 TRIM( time_average_text ) ) 718 697 CALL netcdf_handle_error( 'netcdf_define_header', 466 ) … … 721 700 ! 722 701 !-- Define time coordinate for volume data (unlimited dimension) 723 CALL netcdf_create_dim( id_set_mask(mid,av), 'time', NF90_UNLIMITED, &702 CALL netcdf_create_dim( id_set_mask(mid,av), 'time', NF90_UNLIMITED, & 724 703 id_dim_time_mask(mid,av), 467 ) 725 CALL netcdf_create_var( id_set_mask(mid,av), &726 (/ id_dim_time_mask(mid,av) /), 'time', &727 NF90_DOUBLE, id_var_time_mask(mid,av), &704 CALL netcdf_create_var( id_set_mask(mid,av), & 705 (/ id_dim_time_mask(mid,av) /), 'time', & 706 NF90_DOUBLE, id_var_time_mask(mid,av), & 728 707 'seconds', 'time', 468, 469, 000 ) 729 CALL netcdf_create_att( id_set_mask(mid,av), id_var_time_mask(mid,av), 'standard_name', 'time', 000) 708 CALL netcdf_create_att( id_set_mask(mid,av), id_var_time_mask(mid,av), & 709 'standard_name', 'time', 000) 730 710 CALL netcdf_create_att( id_set_mask(mid,av), id_var_time_mask(mid,av), 'axis', 'T', 000) 731 711 … … 734 714 IF ( mask_surface(mid) ) THEN 735 715 ! 736 !-- In case of terrain-following output, the vertical dimensions are 737 !-- indices, not meters 738 CALL netcdf_create_dim( id_set_mask(mid,av), 'ku_above_surf', & 739 mask_size(mid,3), id_dim_zu_mask(mid,av), & 716 !-- In case of terrain-following output, the vertical dimensions are indices, not meters. 717 CALL netcdf_create_dim( id_set_mask(mid,av), 'ku_above_surf', & 718 mask_size(mid,3), id_dim_zu_mask(mid,av), & 740 719 470 ) 741 CALL netcdf_create_var( id_set_mask(mid,av), &742 (/ id_dim_zu_mask(mid,av) /), &743 'ku_above_surf', &744 NF90_DOUBLE, id_var_zu_mask(mid,av), &745 '1', 'grid point above terrain', &720 CALL netcdf_create_var( id_set_mask(mid,av), & 721 (/ id_dim_zu_mask(mid,av) /), & 722 'ku_above_surf', & 723 NF90_DOUBLE, id_var_zu_mask(mid,av), & 724 '1', 'grid point above terrain', & 746 725 471, 472, 000 ) 747 CALL netcdf_create_att( id_set_mask(mid,av), & 748 id_var_zu_mask(mid,av), 'axis', 'Z', 000) 749 750 CALL netcdf_create_dim( id_set_mask(mid,av), 'kw_above_surf', & 751 mask_size(mid,3), id_dim_zw_mask(mid,av), & 726 CALL netcdf_create_att( id_set_mask(mid,av), id_var_zu_mask(mid,av), 'axis', 'Z', 000) 727 728 CALL netcdf_create_dim( id_set_mask(mid,av), 'kw_above_surf', & 729 mask_size(mid,3), id_dim_zw_mask(mid,av), & 752 730 473 ) 753 CALL netcdf_create_var( id_set_mask(mid,av), &754 (/ id_dim_zw_mask(mid,av) /), &755 'kw_above_surf', &756 NF90_DOUBLE, id_var_zw_mask(mid,av), &757 '1', 'grid point above terrain', &731 CALL netcdf_create_var( id_set_mask(mid,av), & 732 (/ id_dim_zw_mask(mid,av) /), & 733 'kw_above_surf', & 734 NF90_DOUBLE, id_var_zw_mask(mid,av), & 735 '1', 'grid point above terrain', & 758 736 474, 475, 000 ) 759 CALL netcdf_create_att( id_set_mask(mid,av), & 760 id_var_zw_mask(mid,av), 'axis', 'Z', 000) 737 CALL netcdf_create_att( id_set_mask(mid,av),id_var_zw_mask(mid,av), 'axis', 'Z', 000) 761 738 ELSE 762 739 ! 763 740 !-- Define vertical coordinate grid (zu grid) 764 CALL netcdf_create_dim( id_set_mask(mid,av), 'zu_3d', &765 mask_size(mid,3), id_dim_zu_mask(mid,av), &741 CALL netcdf_create_dim( id_set_mask(mid,av), 'zu_3d', & 742 mask_size(mid,3), id_dim_zu_mask(mid,av), & 766 743 470 ) 767 CALL netcdf_create_var( id_set_mask(mid,av), &768 (/ id_dim_zu_mask(mid,av) /), 'zu_3d', &769 NF90_DOUBLE, id_var_zu_mask(mid,av), &744 CALL netcdf_create_var( id_set_mask(mid,av), & 745 (/ id_dim_zu_mask(mid,av) /), 'zu_3d', & 746 NF90_DOUBLE, id_var_zu_mask(mid,av), & 770 747 'meters', '', 471, 472, 000 ) 771 CALL netcdf_create_att( id_set_mask(mid,av), & 772 id_var_zu_mask(mid,av), 'axis', 'Z', 000) 748 CALL netcdf_create_att( id_set_mask(mid,av), id_var_zu_mask(mid,av), 'axis', 'Z', 000) 773 749 ! 774 750 !-- Define vertical coordinate grid (zw grid) 775 CALL netcdf_create_dim( id_set_mask(mid,av), 'zw_3d', &776 mask_size(mid,3), id_dim_zw_mask(mid,av), &751 CALL netcdf_create_dim( id_set_mask(mid,av), 'zw_3d', & 752 mask_size(mid,3), id_dim_zw_mask(mid,av), & 777 753 473 ) 778 CALL netcdf_create_var( id_set_mask(mid,av), &779 (/ id_dim_zw_mask(mid,av) /), 'zw_3d', &780 NF90_DOUBLE, id_var_zw_mask(mid,av), &754 CALL netcdf_create_var( id_set_mask(mid,av), & 755 (/ id_dim_zw_mask(mid,av) /), 'zw_3d', & 756 NF90_DOUBLE, id_var_zw_mask(mid,av), & 781 757 'meters', '', 474, 475, 000 ) 782 CALL netcdf_create_att( id_set_mask(mid,av), & 783 id_var_zw_mask(mid,av), 'axis', 'Z', 000) 758 CALL netcdf_create_att( id_set_mask(mid,av), id_var_zw_mask(mid,av), 'axis', 'Z', 000) 784 759 ENDIF 785 760 ! 786 761 !-- Define x-axis (for scalar position) 787 CALL netcdf_create_dim( id_set_mask(mid,av), 'x', mask_size(mid,1), &762 CALL netcdf_create_dim( id_set_mask(mid,av), 'x', mask_size(mid,1), & 788 763 id_dim_x_mask(mid,av), 476 ) 789 CALL netcdf_create_var( id_set_mask(mid,av), &790 (/ id_dim_x_mask(mid,av) /), 'x', &791 NF90_DOUBLE, id_var_x_mask(mid,av), &764 CALL netcdf_create_var( id_set_mask(mid,av), & 765 (/ id_dim_x_mask(mid,av) /), 'x', & 766 NF90_DOUBLE, id_var_x_mask(mid,av), & 792 767 'meters', '', 477, 478, 000 ) 793 CALL netcdf_create_att( id_set_mask(mid,av), id_var_x_mask(mid,av), & 794 'axis', 'X', 000) 768 CALL netcdf_create_att( id_set_mask(mid,av), id_var_x_mask(mid,av), 'axis', 'X', 000) 795 769 ! 796 770 !-- Define x-axis (for u position) 797 CALL netcdf_create_dim( id_set_mask(mid,av), 'xu', mask_size(mid,1), &771 CALL netcdf_create_dim( id_set_mask(mid,av), 'xu', mask_size(mid,1), & 798 772 id_dim_xu_mask(mid,av), 479 ) 799 CALL netcdf_create_var( id_set_mask(mid,av), &800 (/ id_dim_xu_mask(mid,av) /), 'xu', &801 NF90_DOUBLE, id_var_xu_mask(mid,av), &773 CALL netcdf_create_var( id_set_mask(mid,av), & 774 (/ id_dim_xu_mask(mid,av) /), 'xu', & 775 NF90_DOUBLE, id_var_xu_mask(mid,av), & 802 776 'meters', '', 480, 481, 000 ) 803 CALL netcdf_create_att( id_set_mask(mid,av), id_var_xu_mask(mid,av), & 804 'axis', 'X', 000) 777 CALL netcdf_create_att( id_set_mask(mid,av), id_var_xu_mask(mid,av), 'axis', 'X', 000) 805 778 ! 806 779 !-- Define y-axis (for scalar position) 807 CALL netcdf_create_dim( id_set_mask(mid,av), 'y', mask_size(mid,2), &780 CALL netcdf_create_dim( id_set_mask(mid,av), 'y', mask_size(mid,2), & 808 781 id_dim_y_mask(mid,av), 482 ) 809 CALL netcdf_create_var( id_set_mask(mid,av), &810 (/ id_dim_y_mask(mid,av) /), 'y', &811 NF90_DOUBLE, id_var_y_mask(mid,av), &782 CALL netcdf_create_var( id_set_mask(mid,av), & 783 (/ id_dim_y_mask(mid,av) /), 'y', & 784 NF90_DOUBLE, id_var_y_mask(mid,av), & 812 785 'meters', '', 483, 484, 000 ) 813 CALL netcdf_create_att( id_set_mask(mid,av), id_var_y_mask(mid,av), & 814 'axis', 'Y', 000) 786 CALL netcdf_create_att( id_set_mask(mid,av), id_var_y_mask(mid,av), 'axis', 'Y', 000) 815 787 ! 816 788 !-- Define y-axis (for v position) 817 CALL netcdf_create_dim( id_set_mask(mid,av), 'yv', mask_size(mid,2), &789 CALL netcdf_create_dim( id_set_mask(mid,av), 'yv', mask_size(mid,2), & 818 790 id_dim_yv_mask(mid,av), 485 ) 819 CALL netcdf_create_var( id_set_mask(mid,av), &820 (/ id_dim_yv_mask(mid,av) /), &821 'yv', NF90_DOUBLE, id_var_yv_mask(mid,av), &791 CALL netcdf_create_var( id_set_mask(mid,av), & 792 (/ id_dim_yv_mask(mid,av) /), & 793 'yv', NF90_DOUBLE, id_var_yv_mask(mid,av), & 822 794 'meters', '', 486, 487, 000 ) 823 CALL netcdf_create_att( id_set_mask(mid,av), id_var_yv_mask(mid,av), & 824 'axis', 'Y', 000) 795 CALL netcdf_create_att( id_set_mask(mid,av), id_var_yv_mask(mid,av), 'axis', 'Y', 000) 825 796 ! 826 797 !-- Define UTM and geographic coordinates 827 CALL define_geo_coordinates( id_set_mask(mid,av), &828 (/ id_dim_x_mask(mid,av), id_dim_xu_mask(mid,av) /),&829 (/ id_dim_y_mask(mid,av), id_dim_yv_mask(mid,av) /),&830 id_var_eutm_mask(:,mid,av), id_var_nutm_mask(:,mid,av),&831 id_var_lat_mask(:,mid,av), id_var_lon_mask(:,mid,av) )798 CALL define_geo_coordinates( id_set_mask(mid,av), & 799 (/ id_dim_x_mask(mid,av), id_dim_xu_mask(mid,av) /), & 800 (/ id_dim_y_mask(mid,av), id_dim_yv_mask(mid,av) /), & 801 id_var_eutm_mask(:,mid,av), id_var_nutm_mask(:,mid,av), & 802 id_var_lat_mask(:,mid,av), id_var_lon_mask(:,mid,av) ) 832 803 ! 833 804 !-- Define coordinate-reference system 834 805 CALL netcdf_create_crs( id_set_mask(mid,av), 000 ) 835 806 ! 836 !-- In case of non-flat topography define 2d-arrays containing the height 837 !-- information. Only for parallel netcdf output. 838 IF ( TRIM( topography ) /= 'flat' .AND. & 839 netcdf_data_format > 4 ) THEN 807 !-- In case of non-flat topography define 2d-arrays containing the height information. Only 808 !-- for parallel netcdf output. 809 IF ( TRIM( topography ) /= 'flat' .AND. netcdf_data_format > 4 ) THEN 840 810 ! 841 811 !-- Define zusi = zu(nzb_s_inner) 842 CALL netcdf_create_var( id_set_mask(mid,av), & 843 (/ id_dim_x_mask(mid,av), & 844 id_dim_y_mask(mid,av) /), 'zusi', & 845 NF90_DOUBLE, id_var_zusi_mask(mid,av), & 846 'meters', 'zu(nzb_s_inner)', 488, 489, & 847 490 ) 812 CALL netcdf_create_var( id_set_mask(mid,av), & 813 (/ id_dim_x_mask(mid,av), id_dim_y_mask(mid,av) /), 'zusi', & 814 NF90_DOUBLE, id_var_zusi_mask(mid,av), & 815 'meters', 'zu(nzb_s_inner)', 488, 489, 490 ) 848 816 ! 849 817 !-- Define zwwi = zw(nzb_w_inner) 850 CALL netcdf_create_var( id_set_mask(mid,av), & 851 (/ id_dim_x_mask(mid,av), & 852 id_dim_y_mask(mid,av) /), 'zwwi', & 853 NF90_DOUBLE, id_var_zwwi_mask(mid,av), & 854 'meters', 'zw(nzb_w_inner)', 491, 492, & 855 493 ) 818 CALL netcdf_create_var( id_set_mask(mid,av), & 819 (/ id_dim_x_mask(mid,av), id_dim_y_mask(mid,av) /), 'zwwi', & 820 NF90_DOUBLE, id_var_zwwi_mask(mid,av), & 821 'meters', 'zw(nzb_w_inner)', 491, 492, 493 ) 856 822 ENDIF 857 823 … … 859 825 ! 860 826 !-- Define vertical coordinate grid (zw grid) 861 CALL netcdf_create_dim( id_set_mask(mid,av), 'zs_3d', &862 mask_size(mid,3), id_dim_zs_mask(mid,av), &827 CALL netcdf_create_dim( id_set_mask(mid,av), 'zs_3d', & 828 mask_size(mid,3), id_dim_zs_mask(mid,av), & 863 829 536 ) 864 CALL netcdf_create_var( id_set_mask(mid,av), &865 (/ id_dim_zs_mask(mid,av) /), 'zs_3d', &866 NF90_DOUBLE, id_var_zs_mask(mid,av), &830 CALL netcdf_create_var( id_set_mask(mid,av), & 831 (/ id_dim_zs_mask(mid,av) /), 'zs_3d', & 832 NF90_DOUBLE, id_var_zs_mask(mid,av), & 867 833 'meters', '', 537, 555, 000 ) 868 CALL netcdf_create_att( id_set_mask(mid,av), & 869 id_var_zs_mask(mid,av), 'axis', 'Z', 000) 834 CALL netcdf_create_att( id_set_mask(mid,av), id_var_zs_mask(mid,av), 'axis', 'Z', 000) 870 835 ENDIF 871 836 … … 875 840 i = 1 876 841 877 DO WHILE ( domask(mid,av,i)(1:1) /= ' ' )842 DO WHILE ( domask(mid,av,i)(1:1) /= ' ' ) 878 843 879 844 trimvar = TRIM( domask(mid,av,i) ) … … 884 849 ! 885 850 !-- Most variables are defined on the scalar grid 886 CASE ( 'e', 'nc', 'nr', 'p', 'pc', 'pr', 'prr', &887 'q', 'qc', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qv', &851 CASE ( 'e', 'nc', 'nr', 'p', 'pc', 'pr', 'prr', & 852 'q', 'qc', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qv', & 888 853 's', 'theta', 'thetal', 'thetav', 'qi', 'ni', 'qg', 'ng', 'qs', 'ns' ) 889 854 … … 923 888 ENDIF 924 889 925 IF ( .NOT. found ) &890 IF ( .NOT. found ) & 926 891 CALL doq_define_netcdf_grid( trimvar, found, grid_x, grid_y, grid_z ) 927 892 … … 991 956 ! 992 957 !-- Define the grid 993 CALL netcdf_create_var( id_set_mask(mid,av), (/ id_x, id_y, id_z,&994 id_dim_time_mask(mid,av) /),&995 domask(mid,av,i), nc_precision(11), &996 id_var_domask(mid,av,i), &997 TRIM( domask_unit(mid,av,i) ), &958 CALL netcdf_create_var( id_set_mask(mid,av), & 959 (/ id_x, id_y, id_z, id_dim_time_mask(mid,av) /), & 960 domask(mid,av,i), nc_precision(11), & 961 id_var_domask(mid,av,i), & 962 TRIM( domask_unit(mid,av,i) ), & 998 963 domask(mid,av,i), 494, 495, 496, .TRUE. ) 999 964 … … 1009 974 1010 975 ! 1011 !-- Write the list of variables as global attribute (this is used by 1012 !-- restart runs and by combine_plot_fields) 1013 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, & 1014 'VAR_LIST', var_list ) 976 !-- Write the list of variables as global attribute (this is used by restart runs and by 977 !-- combine_plot_fields). 978 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'VAR_LIST', var_list ) 1015 979 CALL netcdf_handle_error( 'netcdf_define_header', 497 ) 1016 980 … … 1026 990 netcdf_data = ( mask_i_global(mid,:mask_size(mid,1)) + 0.5_wp ) * dx 1027 991 1028 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_x_mask(mid,av), &1029 netcdf_data, start = (/ 1 /), &992 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_x_mask(mid,av), & 993 netcdf_data, start = (/ 1 /), & 1030 994 count = (/ mask_size(mid,1) /) ) 1031 995 CALL netcdf_handle_error( 'netcdf_define_header', 499 ) … … 1033 997 netcdf_data = mask_i_global(mid,:mask_size(mid,1)) * dx 1034 998 1035 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_xu_mask(mid,av), &1036 netcdf_data, start = (/ 1 /), &999 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_xu_mask(mid,av), & 1000 netcdf_data, start = (/ 1 /), & 1037 1001 count = (/ mask_size(mid,1) /) ) 1038 1002 CALL netcdf_handle_error( 'netcdf_define_header', 500 ) … … 1046 1010 netcdf_data = ( mask_j_global(mid,:mask_size(mid,2)) + 0.5_wp ) * dy 1047 1011 1048 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_y_mask(mid,av), &1049 netcdf_data, start = (/ 1 /), &1012 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_y_mask(mid,av), & 1013 netcdf_data, start = (/ 1 /), & 1050 1014 count = (/ mask_size(mid,2) /)) 1051 1015 CALL netcdf_handle_error( 'netcdf_define_header', 501 ) … … 1053 1017 netcdf_data = mask_j_global(mid,:mask_size(mid,2)) * dy 1054 1018 1055 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_yv_mask(mid,av), &1056 netcdf_data, start = (/ 1 /), &1019 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_yv_mask(mid,av), & 1020 netcdf_data, start = (/ 1 /), & 1057 1021 count = (/ mask_size(mid,2) /)) 1058 1022 CALL netcdf_handle_error( 'netcdf_define_header', 502 ) … … 1084 1048 ENDIF 1085 1049 1086 netcdf_data = init_model%origin_x + cos_rot_angle &1087 * ( mask_i_global(mid,:mask_size(mid,1)) + shift_x ) * dx1088 1089 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &1090 id_var_eutm_mask(k,mid,av), &1091 netcdf_data, start = (/ 1 /), &1050 netcdf_data = init_model%origin_x + cos_rot_angle & 1051 * ( mask_i_global(mid,:mask_size(mid,1)) + shift_x ) * dx 1052 1053 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 1054 id_var_eutm_mask(k,mid,av), & 1055 netcdf_data, start = (/ 1 /), & 1092 1056 count = (/ mask_size(mid,1) /) ) 1093 1057 CALL netcdf_handle_error( 'netcdf_define_header', 555 ) … … 1113 1077 ENDIF 1114 1078 1115 netcdf_data = init_model%origin_y + cos_rot_angle &1116 * ( mask_j_global(mid,:mask_size(mid,2)) + shift_y ) * dy1117 1118 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &1119 id_var_nutm_mask(k,mid,av), &1120 netcdf_data, start = (/ 1 /), &1079 netcdf_data = init_model%origin_y + cos_rot_angle & 1080 * ( mask_j_global(mid,:mask_size(mid,2)) + shift_y ) * dy 1081 1082 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 1083 id_var_nutm_mask(k,mid,av), & 1084 netcdf_data, start = (/ 1 /), & 1121 1085 count = (/ mask_size(mid,2) /) ) 1122 1086 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) … … 1149 1113 DO j = 1, mask_size(mid,2) 1150 1114 DO i = 1, mask_size(mid,1) 1151 netcdf_data_2d(i,j) = init_model%origin_x &1152 + cos_rot_angle * ( mask_i_global(mid,i) + shift_x ) * dx&1153 + sin_rot_angle * ( mask_j_global(mid,j) + shift_y ) * dy1115 netcdf_data_2d(i,j) = init_model%origin_x & 1116 + cos_rot_angle * ( mask_i_global(mid,i) + shift_x ) * dx & 1117 + sin_rot_angle * ( mask_j_global(mid,j) + shift_y ) * dy 1154 1118 ENDDO 1155 1119 ENDDO 1156 1120 1157 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 1158 id_var_eutm_mask(k,mid,av), & 1159 netcdf_data_2d, start = (/ 1, 1 /), & 1160 count = (/ mask_size(mid,1), & 1161 mask_size(mid,2) /) ) 1121 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 1122 id_var_eutm_mask(k,mid,av), & 1123 netcdf_data_2d, start = (/ 1, 1 /), & 1124 count = (/ mask_size(mid,1), mask_size(mid,2) /) ) 1162 1125 CALL netcdf_handle_error( 'netcdf_define_header', 555 ) 1163 1126 1164 1127 DO j = 1, mask_size(mid,2) 1165 1128 DO i = 1, mask_size(mid,1) 1166 netcdf_data_2d(i,j) = init_model%origin_y &1167 - sin_rot_angle * ( mask_i_global(mid,i) + shift_x ) * dx&1168 + cos_rot_angle * ( mask_j_global(mid,j) + shift_y ) * dy1129 netcdf_data_2d(i,j) = init_model%origin_y & 1130 - sin_rot_angle * ( mask_i_global(mid,i) + shift_x ) * dx & 1131 + cos_rot_angle * ( mask_j_global(mid,j) + shift_y ) * dy 1169 1132 ENDDO 1170 1133 ENDDO 1171 1134 1172 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 1173 id_var_nutm_mask(k,mid,av), & 1174 netcdf_data_2d, start = (/ 1, 1 /), & 1175 count = (/ mask_size(mid,1), & 1176 mask_size(mid,2) /) ) 1135 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 1136 id_var_nutm_mask(k,mid,av), & 1137 netcdf_data_2d, start = (/ 1, 1 /), & 1138 count = (/ mask_size(mid,1), mask_size(mid,2) /) ) 1177 1139 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) 1178 1140 … … 1204 1166 DO j = 1, mask_size(mid,2) 1205 1167 DO i = 1, mask_size(mid,1) 1206 eutm = init_model%origin_x & 1207 + cos_rot_angle * ( mask_i_global(mid,i) + shift_x ) * dx & 1208 + sin_rot_angle * ( mask_j_global(mid,j) + shift_y ) * dy 1209 nutm = init_model%origin_y & 1210 - sin_rot_angle * ( mask_i_global(mid,i) + shift_x ) * dx & 1211 + cos_rot_angle * ( mask_j_global(mid,j) + shift_y ) * dy 1212 1213 CALL convert_utm_to_geographic( crs_list, & 1214 eutm, nutm, & 1215 lon(i,j), lat(i,j) ) 1168 eutm = init_model%origin_x & 1169 + cos_rot_angle * ( mask_i_global(mid,i) + shift_x ) * dx & 1170 + sin_rot_angle * ( mask_j_global(mid,j) + shift_y ) * dy 1171 nutm = init_model%origin_y & 1172 - sin_rot_angle * ( mask_i_global(mid,i) + shift_x ) * dx & 1173 + cos_rot_angle * ( mask_j_global(mid,j) + shift_y ) * dy 1174 1175 CALL convert_utm_to_geographic( crs_list, eutm, nutm, lon(i,j), lat(i,j) ) 1216 1176 ENDDO 1217 1177 ENDDO 1218 1178 1219 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 1220 id_var_lon_mask(k,mid,av), & 1221 lon, start = (/ 1, 1 /), & 1222 count = (/ mask_size(mid,1), & 1223 mask_size(mid,2) /) ) 1179 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 1180 id_var_lon_mask(k,mid,av), & 1181 lon, start = (/ 1, 1 /), & 1182 count = (/ mask_size(mid,1), mask_size(mid,2) /) ) 1224 1183 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) 1225 1184 1226 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 1227 id_var_lat_mask(k,mid,av), & 1228 lat, start = (/ 1, 1 /), & 1229 count = (/ mask_size(mid,1), & 1230 mask_size(mid,2) /) ) 1185 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 1186 id_var_lat_mask(k,mid,av), & 1187 lat, start = (/ 1, 1 /), & 1188 count = (/ mask_size(mid,1), mask_size(mid,2) /) ) 1231 1189 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) 1232 1190 ENDDO … … 1242 1200 netcdf_data = mask_k_global(mid,:mask_size(mid,3)) 1243 1201 1244 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), &1245 netcdf_data, start = (/ 1 /), &1202 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), & 1203 netcdf_data, start = (/ 1 /), & 1246 1204 count = (/ mask_size(mid,3) /) ) 1247 1205 CALL netcdf_handle_error( 'netcdf_define_header', 503 ) … … 1249 1207 netcdf_data = mask_k_global(mid,:mask_size(mid,3)) 1250 1208 1251 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), &1252 netcdf_data, start = (/ 1 /), &1209 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), & 1210 netcdf_data, start = (/ 1 /), & 1253 1211 count = (/ mask_size(mid,3) /) ) 1254 1212 CALL netcdf_handle_error( 'netcdf_define_header', 504 ) … … 1258 1216 netcdf_data = zu( mask_k_global(mid,:mask_size(mid,3)) ) 1259 1217 1260 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), &1261 netcdf_data, start = (/ 1 /), &1218 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), & 1219 netcdf_data, start = (/ 1 /), & 1262 1220 count = (/ mask_size(mid,3) /) ) 1263 1221 CALL netcdf_handle_error( 'netcdf_define_header', 503 ) … … 1265 1223 netcdf_data = zw( mask_k_global(mid,:mask_size(mid,3)) ) 1266 1224 1267 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), &1268 netcdf_data, start = (/ 1 /), &1225 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), & 1226 netcdf_data, start = (/ 1 /), & 1269 1227 count = (/ mask_size(mid,3) /) ) 1270 1228 CALL netcdf_handle_error( 'netcdf_define_header', 504 ) … … 1276 1234 ! 1277 1235 !-- In case of non-flat topography write height information 1278 IF ( TRIM( topography ) /= 'flat' .AND. & 1279 netcdf_data_format > 4 ) THEN 1236 IF ( TRIM( topography ) /= 'flat' .AND. netcdf_data_format > 4 ) THEN 1280 1237 1281 1238 ALLOCATE( netcdf_data_2d(mask_size_l(mid,1),mask_size_l(mid,2)) ) 1282 netcdf_data_2d = zu_s_inner( mask_i(mid,:mask_size_l(mid,1)), &1239 netcdf_data_2d = zu_s_inner( mask_i(mid,:mask_size_l(mid,1)), & 1283 1240 mask_j(mid,:mask_size_l(mid,2)) ) 1284 1241 1285 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 1286 id_var_zusi_mask(mid,av), & 1287 netcdf_data_2d, & 1288 start = (/ 1, 1 /), & 1289 count = (/ mask_size_l(mid,1), & 1290 mask_size_l(mid,2) /) ) 1242 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 1243 id_var_zusi_mask(mid,av), & 1244 netcdf_data_2d, & 1245 start = (/ 1, 1 /), & 1246 count = (/ mask_size_l(mid,1), mask_size_l(mid,2) /) ) 1291 1247 CALL netcdf_handle_error( 'netcdf_define_header', 505 ) 1292 1248 1293 netcdf_data_2d = zw_w_inner( mask_i(mid,:mask_size_l(mid,1)), &1249 netcdf_data_2d = zw_w_inner( mask_i(mid,:mask_size_l(mid,1)), & 1294 1250 mask_j(mid,:mask_size_l(mid,2)) ) 1295 1251 1296 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 1297 id_var_zwwi_mask(mid,av), & 1298 netcdf_data_2d, & 1299 start = (/ 1, 1 /), & 1300 count = (/ mask_size_l(mid,1), & 1301 mask_size_l(mid,2) /) ) 1252 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 1253 id_var_zwwi_mask(mid,av), & 1254 netcdf_data_2d, & 1255 start = (/ 1, 1 /), & 1256 count = (/ mask_size_l(mid,1), mask_size_l(mid,2) /) ) 1302 1257 CALL netcdf_handle_error( 'netcdf_define_header', 506 ) 1303 1258 … … 1306 1261 ENDIF 1307 1262 ! 1308 !-- soil is not in masked output for now - disable temporary this block1263 !-- Soil is not in masked output for now - disable temporary this block 1309 1264 ! IF ( land_surface ) THEN 1310 1265 ! … … 1325 1280 1326 1281 ! 1327 !-- restore original parameter file_id (=formal parameter av) into av1282 !-- Restore original parameter file_id (=formal parameter av) into av 1328 1283 av = file_id 1329 1284 … … 1332 1287 1333 1288 ! 1334 !-- decompose actual parameter file_id (=formal parameter av) into 1335 !-- mid and av 1289 !-- Decompose actual parameter file_id (=formal parameter av) into mid and av 1336 1290 file_id = av 1337 1291 IF ( file_id <= 200+max_masks ) THEN … … 1345 1299 ! 1346 1300 !-- Get the list of variables and compare with the actual run. 1347 !-- First var_list_old has to be reset, since GET_ATT does not assign 1348 !-- trailing blanks. 1301 !-- First var_list_old has to be reset, since GET_ATT does not assign trailing blanks. 1349 1302 var_list_old = ' ' 1350 nc_stat = NF90_GET_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'VAR_LIST',& 1351 var_list_old ) 1303 nc_stat = NF90_GET_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'VAR_LIST', var_list_old ) 1352 1304 CALL netcdf_handle_error( 'netcdf_define_header', 507 ) 1353 1305 … … 1366 1318 1367 1319 IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN 1368 WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ), &1369 ' data for mask', mid, ' from previous run found,',&1370 '&but this file cannot be extended due to variable ',&1371 'mismatch.&New file is created instead.'1320 WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ), & 1321 ' data for mask', mid, ' from previous run found,', & 1322 '&but this file cannot be extended due to variable ', & 1323 'mismatch.&New file is created instead.' 1372 1324 CALL message( 'define_netcdf_header', 'PA0335', 0, 1, 0, 6, 0 ) 1373 1325 extend = .FALSE. … … 1377 1329 ! 1378 1330 !-- Get and compare the number of vertical gridpoints 1379 nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), 'zu_3d', & 1380 id_var_zu_mask(mid,av) ) 1331 nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), 'zu_3d', id_var_zu_mask(mid,av) ) 1381 1332 CALL netcdf_handle_error( 'netcdf_define_header', 508 ) 1382 1333 1383 nc_stat = NF90_INQUIRE_VARIABLE( id_set_mask(mid,av), &1384 id_var_zu_mask(mid,av), &1334 nc_stat = NF90_INQUIRE_VARIABLE( id_set_mask(mid,av), & 1335 id_var_zu_mask(mid,av), & 1385 1336 dimids = id_dim_zu_mask_old ) 1386 1337 CALL netcdf_handle_error( 'netcdf_define_header', 509 ) 1387 1338 id_dim_zu_mask(mid,av) = id_dim_zu_mask_old(1) 1388 1339 1389 nc_stat = NF90_INQUIRE_DIMENSION( id_set_mask(mid,av), &1390 id_dim_zu_mask(mid,av), &1391 len= nz_old )1340 nc_stat = NF90_INQUIRE_DIMENSION( id_set_mask(mid,av), & 1341 id_dim_zu_mask(mid,av), & 1342 LEN = nz_old ) 1392 1343 CALL netcdf_handle_error( 'netcdf_define_header', 510 ) 1393 1344 1394 1345 IF ( mask_size(mid,3) /= nz_old ) THEN 1395 WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ), &1396 '&data for mask', mid, ' from previous run found,',&1397 ' but this file cannot be extended due to mismatch in ',&1398 ' number of vertical grid points.',&1399 '&New file is created instead.'1346 WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ), & 1347 '&data for mask', mid, ' from previous run found,', & 1348 ' but this file cannot be extended due to mismatch in ', & 1349 ' number of vertical grid points.', & 1350 '&New file is created instead.' 1400 1351 CALL message( 'define_netcdf_header', 'PA0336', 0, 1, 0, 6, 0 ) 1401 1352 extend = .FALSE. … … 1404 1355 1405 1356 ! 1406 !-- Get the id of the time coordinate (unlimited coordinate) and its 1407 !-- last index on the file. The next time level is plmask..count+1. 1408 !-- The current time must be larger than the last output time 1409 !-- on the file. 1410 nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), 'time', & 1411 id_var_time_mask(mid,av) ) 1357 !-- Get the id of the time coordinate (unlimited coordinate) and its last index on the file. 1358 !-- The next time level is plmask..count+1. 1359 !-- The current time must be larger than the last output time on the file. 1360 nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), 'time', id_var_time_mask(mid,av) ) 1412 1361 CALL netcdf_handle_error( 'netcdf_define_header', 511 ) 1413 1362 1414 nc_stat = NF90_INQUIRE_VARIABLE( id_set_mask(mid,av), &1415 id_var_time_mask(mid,av), &1363 nc_stat = NF90_INQUIRE_VARIABLE( id_set_mask(mid,av), & 1364 id_var_time_mask(mid,av), & 1416 1365 dimids = id_dim_time_old ) 1417 1366 CALL netcdf_handle_error( 'netcdf_define_header', 512 ) 1418 1367 id_dim_time_mask(mid,av) = id_dim_time_old(1) 1419 1368 1420 nc_stat = NF90_INQUIRE_DIMENSION( id_set_mask(mid,av), &1421 id_dim_time_mask(mid,av), &1422 len= domask_time_count(mid,av) )1369 nc_stat = NF90_INQUIRE_DIMENSION( id_set_mask(mid,av), & 1370 id_dim_time_mask(mid,av), & 1371 LEN = domask_time_count(mid,av) ) 1423 1372 CALL netcdf_handle_error( 'netcdf_define_header', 513 ) 1424 1373 1425 nc_stat = NF90_GET_VAR( id_set_mask(mid,av), &1426 id_var_time_mask(mid,av), &1427 last_time_coordinate, &1428 start = (/ domask_time_count(mid,av) /), &1374 nc_stat = NF90_GET_VAR( id_set_mask(mid,av), & 1375 id_var_time_mask(mid,av), & 1376 last_time_coordinate, & 1377 start = (/ domask_time_count(mid,av) /), & 1429 1378 count = (/ 1 /) ) 1430 1379 CALL netcdf_handle_error( 'netcdf_define_header', 514 ) 1431 1380 1432 1381 IF ( last_time_coordinate(1) >= simulated_time ) THEN 1433 WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ), &1434 ' data for mask', mid, ' from previous run found,',&1435 '&but this file cannot be extended because the current ',&1436 'output time is less or equal than the last output time ',&1437 'on this file.&New file is created instead.'1382 WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ), & 1383 ' data for mask', mid, ' from previous run found,', & 1384 '&but this file cannot be extended because the current ', & 1385 'output time is less or equal than the last output time ',& 1386 'on this file.&New file is created instead.' 1438 1387 CALL message( 'define_netcdf_header', 'PA0337', 0, 1, 0, 6, 0 ) 1439 1388 domask_time_count(mid,av) = 0 … … 1447 1396 i = 1 1448 1397 DO WHILE ( domask(mid,av,i)(1:1) /= ' ' ) 1449 nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), &1450 TRIM( domask(mid,av,i) ), &1398 nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), & 1399 TRIM( domask(mid,av,i) ), & 1451 1400 id_var_domask(mid,av,i) ) 1452 1401 CALL netcdf_handle_error( 'netcdf_define_header', 515 ) … … 1455 1404 1456 1405 ! 1457 !-- Update the title attribute on file 1458 !-- In order to avoid 'data mode' errors if updated attributes are larger 1459 !-- than their original size, NF90_PUT_ATT is called in 'define mode' 1460 !-- enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible 1461 !-- performance loss due to data copying; an alternative strategy would be 1462 !-- to ensure equal attribute size in a job chain. Maybe revise later. 1406 !-- Update the title attribute on file. 1407 !-- In order to avoid 'data mode' errors if updated attributes are larger than their original 1408 !-- size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF 1409 !-- calls. This implies a possible performance loss due to data copying; an alternative 1410 !-- strategy would be to ensure equal attribute size in a job chain. Maybe revise later. 1463 1411 IF ( av == 0 ) THEN 1464 1412 time_average_text = ' ' 1465 1413 ELSE 1466 WRITE (time_average_text, '('', '',F7.1,'' s average'')') & 1467 averaging_interval 1414 WRITE (time_average_text, '('', '',F7.1,'' s average'')') averaging_interval 1468 1415 ENDIF 1469 1416 nc_stat = NF90_REDEF( id_set_mask(mid,av) ) 1470 1417 CALL netcdf_handle_error( 'netcdf_define_header', 516 ) 1471 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'title', & 1472 TRIM( run_description_header ) // & 1473 TRIM( time_average_text ) ) 1418 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'title', & 1419 TRIM( run_description_header ) // TRIM( time_average_text ) ) 1474 1420 CALL netcdf_handle_error( 'netcdf_define_header', 517 ) 1475 1421 nc_stat = NF90_ENDDEF( id_set_mask(mid,av) ) 1476 1422 CALL netcdf_handle_error( 'netcdf_define_header', 518 ) 1477 WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ), & 1478 ' data for mask', mid, ' from previous run found.', & 1479 ' &This file will be extended.' 1423 WRITE ( message_string, * ) 'netCDF file for ', TRIM( var ), ' data for mask', mid, & 1424 ' from previous run found.', ' &This file will be extended.' 1480 1425 CALL message( 'define_netcdf_header', 'PA0338', 0, 0, 0, 6, 0 ) 1481 1426 ! 1482 !-- restore original parameter file_id (=formal parameter av) into av1427 !-- Restore original parameter file_id (=formal parameter av) into av 1483 1428 av = file_id 1484 1429 … … 1489 1434 !-- Define some global attributes of the dataset 1490 1435 IF ( av == 0 ) THEN 1491 CALL netcdf_create_global_atts( id_set_3d(av), '3d', TRIM( run_description_header ), 62 ) 1436 CALL netcdf_create_global_atts( id_set_3d(av), '3d', & 1437 TRIM( run_description_header ), 62 ) 1492 1438 time_average_text = ' ' 1493 1439 ELSE 1494 CALL netcdf_create_global_atts( id_set_3d(av), '3d_av', TRIM( run_description_header ), 62 ) 1440 CALL netcdf_create_global_atts( id_set_3d(av), '3d_av', & 1441 TRIM( run_description_header ), 62 ) 1495 1442 WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval 1496 nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'time_avg', &1443 nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'time_avg', & 1497 1444 TRIM( time_average_text ) ) 1498 1445 CALL netcdf_handle_error( 'netcdf_define_header', 63 ) … … 1501 1448 ! 1502 1449 !-- Define time coordinate for volume data. 1503 !-- For parallel output the time dimensions has to be limited, otherwise 1504 !-- the performance dropssignificantly.1450 !-- For parallel output the time dimensions has to be limited, otherwise the performance drops 1451 !-- significantly. 1505 1452 IF ( netcdf_data_format < 5 ) THEN 1506 CALL netcdf_create_dim( id_set_3d(av), 'time', NF90_UNLIMITED, & 1507 id_dim_time_3d(av), 64 ) 1453 CALL netcdf_create_dim( id_set_3d(av), 'time', NF90_UNLIMITED, id_dim_time_3d(av), 64 ) 1508 1454 ELSE 1509 CALL netcdf_create_dim( id_set_3d(av), 'time', ntdim_3d(av), & 1510 id_dim_time_3d(av), 523 ) 1511 ENDIF 1512 1513 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_time_3d(av) /), & 1514 'time', NF90_DOUBLE, id_var_time_3d(av), & 1515 'seconds', 'time', 65, 66, 00 ) 1455 CALL netcdf_create_dim( id_set_3d(av), 'time', ntdim_3d(av), id_dim_time_3d(av), 523 ) 1456 ENDIF 1457 1458 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_time_3d(av) /), 'time', NF90_DOUBLE, & 1459 id_var_time_3d(av), 'seconds', 'time', 65, 66, 00 ) 1516 1460 CALL netcdf_create_att( id_set_3d(av), id_var_time_3d(av), 'standard_name', 'time', 000) 1517 1461 CALL netcdf_create_att( id_set_3d(av), id_var_time_3d(av), 'axis', 'T', 000) … … 1519 1463 !-- Define spatial dimensions and coordinates: 1520 1464 !-- Define vertical coordinate grid (zu grid) 1521 CALL netcdf_create_dim( id_set_3d(av), 'zu_3d', nz_do3d-nzb+1, & 1522 id_dim_zu_3d(av), 67 ) 1523 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zu_3d(av) /), & 1524 'zu_3d', NF90_DOUBLE, id_var_zu_3d(av), & 1525 'meters', '', 68, 69, 00 ) 1526 CALL netcdf_create_att( id_set_3d(av), id_var_zu_3d(av), 'axis', & 1527 'Z', 000) 1465 CALL netcdf_create_dim( id_set_3d(av), 'zu_3d', nz_do3d-nzb+1, id_dim_zu_3d(av), 67 ) 1466 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zu_3d(av) /), 'zu_3d', NF90_DOUBLE, & 1467 id_var_zu_3d(av), 'meters', '', 68, 69, 00 ) 1468 CALL netcdf_create_att( id_set_3d(av), id_var_zu_3d(av), 'axis', 'Z', 000) 1528 1469 ! 1529 1470 !-- Define vertical coordinate grid (zw grid) 1530 CALL netcdf_create_dim( id_set_3d(av), 'zw_3d', nz_do3d-nzb+1, & 1531 id_dim_zw_3d(av), 70 ) 1532 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zw_3d(av) /), & 1533 'zw_3d', NF90_DOUBLE, id_var_zw_3d(av), & 1534 'meters', '', 71, 72, 00 ) 1535 CALL netcdf_create_att( id_set_3d(av), id_var_zw_3d(av), 'axis', & 1536 'Z', 000) 1471 CALL netcdf_create_dim( id_set_3d(av), 'zw_3d', nz_do3d-nzb+1, id_dim_zw_3d(av), 70 ) 1472 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zw_3d(av) /), 'zw_3d', NF90_DOUBLE, & 1473 id_var_zw_3d(av), 'meters', '', 71, 72, 00 ) 1474 CALL netcdf_create_att( id_set_3d(av), id_var_zw_3d(av), 'axis', 'Z', 000) 1537 1475 ! 1538 1476 !-- Define x-axis (for scalar position) 1539 CALL netcdf_create_dim( id_set_3d(av), 'x', nx+1, id_dim_x_3d(av), & 1540 73 ) 1541 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av) /), 'x', & 1542 NF90_DOUBLE, id_var_x_3d(av), 'meters', '', & 1543 74, 75, 00 ) 1544 CALL netcdf_create_att( id_set_3d(av), id_var_x_3d(av), 'axis', & 1545 'X', 000) 1477 CALL netcdf_create_dim( id_set_3d(av), 'x', nx+1, id_dim_x_3d(av), 73 ) 1478 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av) /), 'x', NF90_DOUBLE, & 1479 id_var_x_3d(av), 'meters', '', 74, 75, 00 ) 1480 CALL netcdf_create_att( id_set_3d(av), id_var_x_3d(av), 'axis', 'X', 000) 1546 1481 ! 1547 1482 !-- Define x-axis (for u position) 1548 CALL netcdf_create_dim( id_set_3d(av), 'xu', nx+1, id_dim_xu_3d(av), & 1549 358 ) 1550 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_xu_3d(av) /), 'xu', & 1551 NF90_DOUBLE, id_var_xu_3d(av), 'meters', '', & 1552 359, 360, 000 ) 1553 CALL netcdf_create_att( id_set_3d(av), id_var_xu_3d(av), 'axis', & 1554 'X', 000) 1483 CALL netcdf_create_dim( id_set_3d(av), 'xu', nx+1, id_dim_xu_3d(av), 358 ) 1484 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_xu_3d(av) /), 'xu', NF90_DOUBLE, & 1485 id_var_xu_3d(av), 'meters', '', 359, 360, 000 ) 1486 CALL netcdf_create_att( id_set_3d(av), id_var_xu_3d(av), 'axis', 'X', 000) 1555 1487 ! 1556 1488 !-- Define y-axis (for scalar position) 1557 CALL netcdf_create_dim( id_set_3d(av), 'y', ny+1, id_dim_y_3d(av), & 1558 76 ) 1559 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_y_3d(av) /), 'y', & 1560 NF90_DOUBLE, id_var_y_3d(av), 'meters', '', & 1561 77, 78, 00 ) 1562 CALL netcdf_create_att( id_set_3d(av), id_var_y_3d(av), 'axis', & 1563 'Y', 000) 1489 CALL netcdf_create_dim( id_set_3d(av), 'y', ny+1, id_dim_y_3d(av), 76 ) 1490 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_y_3d(av) /), 'y', NF90_DOUBLE, & 1491 id_var_y_3d(av), 'meters', '', 77, 78, 00 ) 1492 CALL netcdf_create_att( id_set_3d(av), id_var_y_3d(av), 'axis', 'Y', 000) 1564 1493 ! 1565 1494 !-- Define y-axis (for v position) 1566 CALL netcdf_create_dim( id_set_3d(av), 'yv', ny+1, id_dim_yv_3d(av), & 1567 361 ) 1568 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_yv_3d(av) /), 'yv', & 1569 NF90_DOUBLE, id_var_yv_3d(av), 'meters', '', & 1570 362, 363, 000 ) 1571 CALL netcdf_create_att( id_set_3d(av), id_var_yv_3d(av), 'axis', & 1572 'Y', 000) 1495 CALL netcdf_create_dim( id_set_3d(av), 'yv', ny+1, id_dim_yv_3d(av), 361 ) 1496 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_yv_3d(av) /), 'yv', NF90_DOUBLE, & 1497 id_var_yv_3d(av), 'meters', '', 362, 363, 000 ) 1498 CALL netcdf_create_att( id_set_3d(av), id_var_yv_3d(av), 'axis', 'Y', 000) 1573 1499 ! 1574 1500 !-- Define UTM and geographic coordinates 1575 CALL define_geo_coordinates( id_set_3d(av), &1576 (/ id_dim_x_3d(av), id_dim_xu_3d(av) /),&1577 (/ id_dim_y_3d(av), id_dim_yv_3d(av) /),&1578 id_var_eutm_3d(:,av), id_var_nutm_3d(:,av),&1579 id_var_lat_3d(:,av), id_var_lon_3d(:,av) )1501 CALL define_geo_coordinates( id_set_3d(av), & 1502 (/ id_dim_x_3d(av), id_dim_xu_3d(av) /), & 1503 (/ id_dim_y_3d(av), id_dim_yv_3d(av) /), & 1504 id_var_eutm_3d(:,av), id_var_nutm_3d(:,av), & 1505 id_var_lat_3d(:,av), id_var_lon_3d(:,av) ) 1580 1506 ! 1581 1507 !-- Define coordinate-reference system 1582 1508 CALL netcdf_create_crs( id_set_3d(av), 000 ) 1583 1509 ! 1584 !-- In case of non-flat topography define 2d-arrays containing the height 1585 !-- information. Only output 2d topography information in case of parallel 1586 !-- output. 1587 IF ( TRIM( topography ) /= 'flat' .AND. & 1588 netcdf_data_format > 4 ) THEN 1510 !-- In case of non-flat topography define 2d-arrays containing the height information. Only 1511 !-- output 2d topography information in case of parallel output. 1512 IF ( TRIM( topography ) /= 'flat' .AND. netcdf_data_format > 4 ) THEN 1589 1513 ! 1590 1514 !-- Define zusi = zu(nzb_s_inner) 1591 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av), & 1592 id_dim_y_3d(av) /), 'zusi', NF90_DOUBLE, & 1593 id_var_zusi_3d(av), 'meters', & 1594 'zu(nzb_s_inner)', 413, 414, 415 ) 1515 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av), id_dim_y_3d(av) /), 'zusi',& 1516 NF90_DOUBLE, id_var_zusi_3d(av), 'meters', 'zu(nzb_s_inner)', & 1517 413, 414, 415 ) 1595 1518 ! 1596 1519 !-- Define zwwi = zw(nzb_w_inner) 1597 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av), & 1598 id_dim_y_3d(av) /), 'zwwi', NF90_DOUBLE, & 1599 id_var_zwwi_3d(av), 'meters', & 1600 'zw(nzb_w_inner)', 416, 417, 418 ) 1520 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_x_3d(av), id_dim_y_3d(av) /), 'zwwi',& 1521 NF90_DOUBLE, id_var_zwwi_3d(av), 'meters', 'zw(nzb_w_inner)', & 1522 416, 417, 418 ) 1601 1523 1602 1524 ENDIF … … 1605 1527 ! 1606 1528 !-- Define vertical coordinate grid (zs grid) 1607 CALL netcdf_create_dim( id_set_3d(av), 'zs_3d', &1529 CALL netcdf_create_dim( id_set_3d(av), 'zs_3d', & 1608 1530 nzt_soil-nzb_soil+1, id_dim_zs_3d(av), 70 ) 1609 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zs_3d(av) /), & 1610 'zs_3d', NF90_DOUBLE, id_var_zs_3d(av), & 1611 'meters', '', 71, 72, 00 ) 1612 CALL netcdf_create_att( id_set_3d(av), id_var_zs_3d(av), 'axis', & 1613 'Z', 000) 1531 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zs_3d(av) /), 'zs_3d', NF90_DOUBLE, & 1532 id_var_zs_3d(av), 'meters', '', 71, 72, 00 ) 1533 CALL netcdf_create_att( id_set_3d(av), id_var_zs_3d(av), 'axis', 'Z', 000) 1614 1534 1615 1535 ENDIF … … 1618 1538 ! 1619 1539 !-- Define vertical coordinate grid (zpc grid) 1620 CALL netcdf_create_dim( id_set_3d(av), 'zpc_3d', & 1621 pch_index+1, id_dim_zpc_3d(av), 70 ) 1540 CALL netcdf_create_dim( id_set_3d(av), 'zpc_3d', pch_index+1, id_dim_zpc_3d(av), 70 ) 1622 1541 !netcdf_create_dim(ncid, dim_name, ncdim_type, ncdim_id, error_no) 1623 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zpc_3d(av) /), & 1624 'zpc_3d', NF90_DOUBLE, id_var_zpc_3d(av), & 1625 'meters', '', 71, 72, 00 ) 1626 CALL netcdf_create_att( id_set_3d(av), id_var_zpc_3d(av), 'axis', & 1627 'Z', 000) 1542 CALL netcdf_create_var( id_set_3d(av), (/ id_dim_zpc_3d(av) /), 'zpc_3d', NF90_DOUBLE,& 1543 id_var_zpc_3d(av), 'meters', '', 71, 72, 00 ) 1544 CALL netcdf_create_att( id_set_3d(av), id_var_zpc_3d(av), 'axis', 'Z', 000) 1628 1545 1629 1546 ENDIF … … 1636 1553 DO WHILE ( do3d(av,i)(1:1) /= ' ' ) 1637 1554 ! 1638 !-- Temporary solution to account for data output within the new urban 1639 !-- surface model(urban_surface_mod.f90), see also SELECT CASE ( trimvar )1555 !-- Temporary solution to account for data output within the new urban surface model 1556 !-- (urban_surface_mod.f90), see also SELECT CASE ( trimvar ) 1640 1557 trimvar = TRIM( do3d(av,i) ) 1641 1558 IF ( urban_surface .AND. trimvar(1:4) == 'usm_' ) THEN … … 1680 1597 !-- Block of urban surface model outputs 1681 1598 CASE ( 'usm_output' ) 1682 CALL usm_define_netcdf_grid( do3d(av,i), found, & 1683 grid_x, grid_y, grid_z ) 1599 CALL usm_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z ) 1684 1600 1685 1601 CASE DEFAULT 1686 1602 1687 CALL tcm_define_netcdf_grid( do3d(av,i), found, & 1688 grid_x, grid_y, grid_z ) 1603 CALL tcm_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z ) 1689 1604 1690 1605 ! 1691 1606 !-- Check for land surface quantities 1692 IF ( .NOT. found .AND. land_surface ) THEN 1693 CALL lsm_define_netcdf_grid( do3d(av,i), found, grid_x, & 1694 grid_y, grid_z ) 1607 IF ( .NOT. found .AND. land_surface ) THEN 1608 CALL lsm_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z ) 1695 1609 ENDIF 1696 1610 ! 1697 1611 !-- Check for ocean quantities 1698 1612 IF ( .NOT. found .AND. ocean_mode ) THEN 1699 CALL ocean_define_netcdf_grid( do3d(av,i), found, & 1700 grid_x, grid_y, grid_z ) 1613 CALL ocean_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z ) 1701 1614 ENDIF 1702 1615 … … 1704 1617 !-- Check for plant canopy quantities 1705 1618 IF ( .NOT. found .AND. plant_canopy ) THEN 1706 CALL pcm_define_netcdf_grid( do3d(av,i), found, grid_x, & 1707 grid_y, grid_z ) 1619 CALL pcm_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z ) 1708 1620 ENDIF 1709 1621 … … 1711 1623 !-- Check for radiation quantities 1712 1624 IF ( .NOT. found .AND. radiation ) THEN 1713 CALL radiation_define_netcdf_grid( do3d(av,i), found, & 1714 grid_x, grid_y, & 1715 grid_z ) 1625 CALL radiation_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z ) 1716 1626 ENDIF 1717 1627 1718 1628 !-- Check for gust module quantities 1719 1629 IF ( .NOT. found .AND. gust_module_enabled ) THEN 1720 CALL gust_define_netcdf_grid( do3d(av,i), found, grid_x, & 1721 grid_y, grid_z ) 1630 CALL gust_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z ) 1722 1631 ENDIF 1723 1632 ! 1724 1633 !-- Check for indoor model quantities 1725 IF ( .NOT. found .AND. indoor_model ) THEN 1726 CALL im_define_netcdf_grid( do3d(av,i), found, & 1727 grid_x, grid_y, grid_z ) 1634 IF ( .NOT. found .AND. indoor_model ) THEN 1635 CALL im_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z ) 1728 1636 ENDIF 1729 1637 … … 1731 1639 !-- Check for biometeorology quantities 1732 1640 IF ( .NOT. found .AND. biometeorology ) THEN 1733 CALL bio_define_netcdf_grid( do3d(av,i), found, & 1734 grid_x, grid_y, grid_z ) 1641 CALL bio_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z ) 1735 1642 ENDIF 1736 1643 … … 1738 1645 !-- Check for chemistry quantities 1739 1646 IF ( .NOT. found .AND. air_chemistry ) THEN 1740 CALL chem_define_netcdf_grid( do3d(av,i), found, & 1741 grid_x, grid_y, grid_z ) 1647 CALL chem_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z ) 1742 1648 ENDIF 1743 1649 … … 1745 1651 !-- Check for SALSA quantities 1746 1652 IF ( .NOT. found .AND. salsa ) THEN 1747 CALL salsa_define_netcdf_grid( do3d(av,i), found, grid_x,& 1748 grid_y, grid_z ) 1653 CALL salsa_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z ) 1749 1654 ENDIF 1750 1655 ! 1751 1656 !-- Check for user-defined quantities 1752 1657 IF ( .NOT. found .AND. user_module_enabled ) THEN 1753 CALL user_define_netcdf_grid( do3d(av,i), found, grid_x, & 1754 grid_y, grid_z ) 1658 CALL user_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z ) 1755 1659 ENDIF 1756 1660 1757 IF ( .NOT. found ) & 1758 CALL doq_define_netcdf_grid( do3d(av,i), found, grid_x, & 1759 grid_y, grid_z ) 1661 IF ( .NOT. found ) & 1662 CALL doq_define_netcdf_grid( do3d(av,i), found, grid_x, grid_y, grid_z ) 1760 1663 1761 1664 IF ( .NOT. found ) THEN 1762 WRITE ( message_string, * ) 'no grid defined for varia', & 1763 'ble ', TRIM( do3d(av,i) ) 1764 CALL message( 'define_netcdf_header', 'PA0244', 0, 1, 0, & 1765 6, 0 ) 1665 WRITE ( message_string, * ) 'no grid defined for variable ', & 1666 TRIM( do3d(av,i) ) 1667 CALL message( 'define_netcdf_header', 'PA0244', 0, 1, 0, 6, 0 ) 1766 1668 ENDIF 1767 1669 … … 1794 1696 ! 1795 1697 !-- Define the grid 1796 CALL netcdf_create_var( id_set_3d(av),(/ id_x, id_y, id_z, & 1797 id_dim_time_3d(av) /), do3d(av,i), & 1798 nc_precision(4), id_var_do3d(av,i), & 1799 TRIM( do3d_unit(av,i) ), do3d(av,i), 79, & 1800 80, 357, .TRUE. ) 1698 CALL netcdf_create_var( id_set_3d(av),(/ id_x, id_y, id_z, id_dim_time_3d(av) /), & 1699 do3d(av,i), nc_precision(4), id_var_do3d(av,i), & 1700 TRIM( do3d_unit(av,i) ), do3d(av,i), 79, 80, 357, .TRUE. ) 1801 1701 #if defined( __netcdf4_parallel ) 1802 1702 IF ( netcdf_data_format > 4 ) THEN 1803 1703 ! 1804 1704 !-- Set no fill for every variable to increase performance. 1805 nc_stat = NF90_DEF_VAR_FILL( id_set_3d(av), & 1806 id_var_do3d(av,i), & 1807 NF90_NOFILL, 0 ) 1705 nc_stat = NF90_DEF_VAR_FILL( id_set_3d(av), id_var_do3d(av,i), NF90_NOFILL, 0 ) 1808 1706 CALL netcdf_handle_error( 'netcdf_define_header', 532 ) 1809 1707 ! 1810 1708 !-- Set collective io operations for parallel io 1811 nc_stat = NF90_VAR_PAR_ACCESS( id_set_3d(av), & 1812 id_var_do3d(av,i), & 1813 NF90_COLLECTIVE ) 1709 nc_stat = NF90_VAR_PAR_ACCESS( id_set_3d(av), id_var_do3d(av,i), NF90_COLLECTIVE ) 1814 1710 CALL netcdf_handle_error( 'netcdf_define_header', 445 ) 1815 1711 ENDIF … … 1826 1722 1827 1723 ! 1828 !-- Write the list of variables as global attribute (this is used by 1829 !-- restart runs and by combine_plot_fields) 1830 nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', & 1831 var_list ) 1724 !-- Write the list of variables as global attribute (this is used by restart runs and by 1725 !-- combine_plot_fields). 1726 nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', var_list ) 1832 1727 CALL netcdf_handle_error( 'netcdf_define_header', 81 ) 1833 1728 1834 1729 ! 1835 !-- Set general no fill, otherwise the performance drops significantly for 1836 !-- parallel output. 1730 !-- Set general no fill, otherwise the performance drops significantly for parallel output. 1837 1731 nc_stat = NF90_SET_FILL( id_set_3d(av), NF90_NOFILL, oldmode ) 1838 1732 CALL netcdf_handle_error( 'netcdf_define_header', 528 ) … … 1844 1738 1845 1739 ! 1846 !-- These data are only written by PE0 for parallel output to increase 1847 !-- the performance. 1740 !-- These data are only written by PE0 for parallel output to increase the performance. 1848 1741 IF ( myid == 0 .OR. netcdf_data_format < 5 ) THEN 1849 1742 ! … … 1855 1748 ENDDO 1856 1749 1857 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_x_3d(av), &1858 netcdf_data, start = (/ 1 /), &1750 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_x_3d(av), & 1751 netcdf_data, start = (/ 1 /), & 1859 1752 count = (/ nx+1 /) ) 1860 1753 CALL netcdf_handle_error( 'netcdf_define_header', 83 ) … … 1864 1757 ENDDO 1865 1758 1866 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_xu_3d(av), &1867 netcdf_data, start = (/ 1 /), &1759 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_xu_3d(av), & 1760 netcdf_data, start = (/ 1 /), & 1868 1761 count = (/ nx+1 /) ) 1869 1762 CALL netcdf_handle_error( 'netcdf_define_header', 385 ) … … 1879 1772 ENDDO 1880 1773 1881 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_y_3d(av), &1882 netcdf_data, start = (/ 1 /), &1774 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_y_3d(av), & 1775 netcdf_data, start = (/ 1 /), & 1883 1776 count = (/ ny+1 /) ) 1884 1777 CALL netcdf_handle_error( 'netcdf_define_header', 84 ) … … 1888 1781 ENDDO 1889 1782 1890 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_yv_3d(av), &1891 netcdf_data, start = (/ 1 /), &1783 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_yv_3d(av), & 1784 netcdf_data, start = (/ 1 /), & 1892 1785 count = (/ ny+1 /)) 1893 1786 CALL netcdf_handle_error( 'netcdf_define_header', 387 ) … … 1920 1813 1921 1814 DO i = 0, nx 1922 netcdf_data(i) = init_model%origin_x & 1923 + cos_rot_angle * ( i + shift_x ) * dx 1815 netcdf_data(i) = init_model%origin_x + cos_rot_angle * ( i + shift_x ) * dx 1924 1816 ENDDO 1925 1817 1926 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_eutm_3d(k,av), &1927 netcdf_data, start = (/ 1 /), &1818 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_eutm_3d(k,av), & 1819 netcdf_data, start = (/ 1 /), & 1928 1820 count = (/ nx+1 /) ) 1929 1821 CALL netcdf_handle_error( 'netcdf_define_header', 555 ) … … 1950 1842 1951 1843 DO j = 0, ny 1952 netcdf_data(j) = init_model%origin_y & 1953 + cos_rot_angle * ( j + shift_y ) * dy 1844 netcdf_data(j) = init_model%origin_y + cos_rot_angle * ( j + shift_y ) * dy 1954 1845 ENDDO 1955 1846 1956 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_nutm_3d(k,av), &1957 netcdf_data, start = (/ 1 /), &1847 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_nutm_3d(k,av), & 1848 netcdf_data, start = (/ 1 /), & 1958 1849 count = (/ ny+1 /) ) 1959 1850 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) … … 1986 1877 DO j = 0, ny 1987 1878 DO i = 0, nx 1988 netcdf_data_2d(i,j) = init_model%origin_x &1989 + cos_rot_angle * ( i + shift_x ) * dx&1990 + sin_rot_angle * ( j + shift_y ) * dy1879 netcdf_data_2d(i,j) = init_model%origin_x & 1880 + cos_rot_angle * ( i + shift_x ) * dx & 1881 + sin_rot_angle * ( j + shift_y ) * dy 1991 1882 ENDDO 1992 1883 ENDDO 1993 1884 1994 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_eutm_3d(k,av), &1995 netcdf_data_2d, start = (/ 1, 1 /), &1885 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_eutm_3d(k,av), & 1886 netcdf_data_2d, start = (/ 1, 1 /), & 1996 1887 count = (/ nx+1, ny+1 /) ) 1997 1888 CALL netcdf_handle_error( 'netcdf_define_header', 555 ) … … 1999 1890 DO j = 0, ny 2000 1891 DO i = 0, nx 2001 netcdf_data_2d(i,j) = init_model%origin_y &2002 - sin_rot_angle * ( i + shift_x ) * dx &2003 + cos_rot_angle * ( j + shift_y ) * dy1892 netcdf_data_2d(i,j) = init_model%origin_y & 1893 - sin_rot_angle * ( i + shift_x ) * dx & 1894 + cos_rot_angle * ( j + shift_y ) * dy 2004 1895 ENDDO 2005 1896 ENDDO 2006 1897 2007 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_nutm_3d(k,av), &2008 netcdf_data_2d, start = (/ 1, 1 /), &1898 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_nutm_3d(k,av), & 1899 netcdf_data_2d, start = (/ 1, 1 /), & 2009 1900 count = (/ nx+1, ny+1 /) ) 2010 1901 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) … … 2015 1906 ! 2016 1907 !-- Write zu and zw data (vertical axes) 2017 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zu_3d(av), &2018 zu(nzb:nz_do3d), start = (/ 1 /), &1908 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zu_3d(av), & 1909 zu(nzb:nz_do3d), start = (/ 1 /), & 2019 1910 count = (/ nz_do3d-nzb+1 /) ) 2020 1911 CALL netcdf_handle_error( 'netcdf_define_header', 85 ) 2021 1912 2022 1913 2023 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zw_3d(av), &2024 zw(nzb:nz_do3d), start = (/ 1 /), &1914 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zw_3d(av), & 1915 zw(nzb:nz_do3d), start = (/ 1 /), & 2025 1916 count = (/ nz_do3d-nzb+1 /) ) 2026 1917 CALL netcdf_handle_error( 'netcdf_define_header', 86 ) … … 2029 1920 ! 2030 1921 !-- Write zs grid 2031 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zs_3d(av), &2032 - zs(nzb_soil:nzt_soil), start = (/ 1 /), &1922 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zs_3d(av), & 1923 - zs(nzb_soil:nzt_soil), start = (/ 1 /), & 2033 1924 count = (/ nzt_soil-nzb_soil+1 /) ) 2034 1925 CALL netcdf_handle_error( 'netcdf_define_header', 86 ) … … 2038 1929 ! 2039 1930 !-- Write zpc grid 2040 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zpc_3d(av), &2041 zu(nzb:nzb+pch_index), start = (/ 1 /), &1931 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zpc_3d(av), & 1932 zu(nzb:nzb+pch_index), start = (/ 1 /), & 2042 1933 count = (/ pch_index+1 /) ) 2043 1934 CALL netcdf_handle_error( 'netcdf_define_header', 86 ) … … 2071 1962 DO j = nys, nyn 2072 1963 DO i = nxl, nxr 2073 eutm = init_model%origin_x & 2074 + cos_rot_angle * ( i + shift_x ) * dx & 2075 + sin_rot_angle * ( j + shift_y ) * dy 2076 nutm = init_model%origin_y & 2077 - sin_rot_angle * ( i + shift_x ) * dx & 2078 + cos_rot_angle * ( j + shift_y ) * dy 2079 2080 CALL convert_utm_to_geographic( crs_list, & 2081 eutm, nutm, & 2082 lon(i,j), lat(i,j) ) 1964 eutm = init_model%origin_x & 1965 + cos_rot_angle * ( i + shift_x ) * dx & 1966 + sin_rot_angle * ( j + shift_y ) * dy 1967 nutm = init_model%origin_y & 1968 - sin_rot_angle * ( i + shift_x ) * dx & 1969 + cos_rot_angle * ( j + shift_y ) * dy 1970 1971 CALL convert_utm_to_geographic( crs_list, eutm, nutm, lon(i,j), lat(i,j) ) 2083 1972 ENDDO 2084 1973 ENDDO 2085 1974 2086 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_lon_3d(k,av), &2087 lon, start = (/ nxl+1, nys+1 /),&2088 count = (/ nxr-nxl+1, nyn-nys+1 /) )1975 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_lon_3d(k,av), & 1976 lon, start = (/ nxl+1, nys+1 /), & 1977 count = (/ nxr-nxl+1, nyn-nys+1 /) ) 2089 1978 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) 2090 1979 2091 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_lat_3d(k,av), &2092 lat, start = (/ nxl+1, nys+1 /),&2093 count = (/ nxr-nxl+1, nyn-nys+1 /) )1980 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_lat_3d(k,av), & 1981 lat, start = (/ nxl+1, nys+1 /), & 1982 count = (/ nxr-nxl+1, nyn-nys+1 /) ) 2094 1983 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) 2095 1984 ENDDO … … 2100 1989 ENDIF 2101 1990 ! 2102 !-- In case of non-flat topography write height information. Only for 2103 !-- parallel netcdf output. 2104 IF ( TRIM( topography ) /= 'flat' .AND. & 2105 netcdf_data_format > 4 ) THEN 1991 !-- In case of non-flat topography write height information. Only for parallel netcdf output. 1992 IF ( TRIM( topography ) /= 'flat' .AND. netcdf_data_format > 4 ) THEN 2106 1993 2107 1994 ! IF ( nxr == nx .AND. nyn /= ny ) THEN 2108 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av), &2109 ! zu_s_inner(nxl:nxr+1,nys:nyn), &2110 ! start = (/ nxl+1, nys+1 /), &1995 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av), & 1996 ! zu_s_inner(nxl:nxr+1,nys:nyn), & 1997 ! start = (/ nxl+1, nys+1 /), & 2111 1998 ! count = (/ nxr-nxl+2, nyn-nys+1 /) ) 2112 1999 ! ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN 2113 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av), &2114 ! zu_s_inner(nxl:nxr,nys:nyn+1), &2115 ! start = (/ nxl+1, nys+1 /), &2000 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av), & 2001 ! zu_s_inner(nxl:nxr,nys:nyn+1), & 2002 ! start = (/ nxl+1, nys+1 /), & 2116 2003 ! count = (/ nxr-nxl+1, nyn-nys+2 /) ) 2117 2004 ! ELSEIF ( nxr == nx .AND. nyn == ny ) THEN 2118 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av), &2119 ! zu_s_inner(nxl:nxr+1,nys:nyn+1), &2120 ! start = (/ nxl+1, nys+1 /), &2005 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av), & 2006 ! zu_s_inner(nxl:nxr+1,nys:nyn+1), & 2007 ! start = (/ nxl+1, nys+1 /), & 2121 2008 ! count = (/ nxr-nxl+2, nyn-nys+2 /) ) 2122 2009 ! ELSE 2123 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av), &2124 zu_s_inner(nxl:nxr,nys:nyn), &2125 start = (/ nxl+1, nys+1 /), &2010 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av), & 2011 zu_s_inner(nxl:nxr,nys:nyn), & 2012 start = (/ nxl+1, nys+1 /), & 2126 2013 count = (/ nxr-nxl+1, nyn-nys+1 /) ) 2127 2014 ! ENDIF … … 2129 2016 2130 2017 ! IF ( nxr == nx .AND. nyn /= ny ) THEN 2131 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av), &2132 ! zw_w_inner(nxl:nxr+1,nys:nyn), &2133 ! start = (/ nxl+1, nys+1 /), &2018 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av), & 2019 ! zw_w_inner(nxl:nxr+1,nys:nyn), & 2020 ! start = (/ nxl+1, nys+1 /), & 2134 2021 ! count = (/ nxr-nxl+2, nyn-nys+1 /) ) 2135 2022 ! ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN 2136 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av), &2137 ! zw_w_inner(nxl:nxr,nys:nyn+1), &2138 ! start = (/ nxl+1, nys+1 /), &2023 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av), & 2024 ! zw_w_inner(nxl:nxr,nys:nyn+1), & 2025 ! start = (/ nxl+1, nys+1 /), & 2139 2026 ! count = (/ nxr-nxl+1, nyn-nys+2 /) ) 2140 2027 ! ELSEIF ( nxr == nx .AND. nyn == ny ) THEN 2141 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av), &2142 ! zw_w_inner(nxl:nxr+1,nys:nyn+1), &2143 ! start = (/ nxl+1, nys+1 /), &2028 ! nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av), & 2029 ! zw_w_inner(nxl:nxr+1,nys:nyn+1), & 2030 ! start = (/ nxl+1, nys+1 /), & 2144 2031 ! count = (/ nxr-nxl+2, nyn-nys+2 /) ) 2145 2032 ! ELSE 2146 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av), &2147 zw_w_inner(nxl:nxr,nys:nyn), &2148 start = (/ nxl+1, nys+1 /), &2033 nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av), & 2034 zw_w_inner(nxl:nxr,nys:nyn), & 2035 start = (/ nxl+1, nys+1 /), & 2149 2036 count = (/ nxr-nxl+1, nyn-nys+1 /) ) 2150 2037 ! ENDIF … … 2157 2044 ! 2158 2045 !-- Get the list of variables and compare with the actual run. 2159 !-- First var_list_old has to be reset, since GET_ATT does not assign 2160 !-- trailing blanks. 2046 !-- First var_list_old has to be reset, since GET_ATT does not assign trailing blanks. 2161 2047 var_list_old = ' ' 2162 nc_stat = NF90_GET_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', & 2163 var_list_old ) 2048 nc_stat = NF90_GET_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', var_list_old ) 2164 2049 CALL netcdf_handle_error( 'netcdf_define_header', 87 ) 2165 2050 2166 2051 var_list = ';' 2167 2052 i = 1 2168 DO WHILE ( do3d(av,i)(1:1) /= ' ' )2169 var_list = TRIM( var_list) // TRIM( do3d(av,i) ) // ';'2053 DO WHILE ( do3d(av,i)(1:1) /= ' ' ) 2054 var_list = TRIM( var_list ) // TRIM( do3d(av,i) ) // ';' 2170 2055 i = i + 1 2171 2056 ENDDO … … 2178 2063 2179 2064 IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN 2180 message_string = 'netCDF file for volume data ' // & 2181 TRIM( var ) // ' from previous run found,' // & 2182 '&but this file cannot be extended due to' // & 2183 ' variable mismatch.' // & 2184 '&New file is created instead.' 2065 message_string = 'netCDF file for volume data ' // TRIM( var ) // & 2066 ' from previous run found,' // & 2067 '&but this file cannot be extended due to' // & 2068 ' variable mismatch.' // '&New file is created instead.' 2185 2069 CALL message( 'define_netcdf_header', 'PA0245', 0, 1, 0, 6, 0 ) 2186 2070 extend = .FALSE. … … 2193 2077 CALL netcdf_handle_error( 'netcdf_define_header', 88 ) 2194 2078 2195 nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_zu_3d(av), &2079 nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_zu_3d(av), & 2196 2080 dimids = id_dim_zu_3d_old ) 2197 2081 CALL netcdf_handle_error( 'netcdf_define_header', 89 ) 2198 2082 id_dim_zu_3d(av) = id_dim_zu_3d_old(1) 2199 2083 2200 nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_zu_3d(av), & 2201 len = nz_old ) 2084 nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_zu_3d(av), LEN = nz_old ) 2202 2085 CALL netcdf_handle_error( 'netcdf_define_header', 90 ) 2203 2086 2204 2087 IF ( nz_do3d-nzb+1 /= nz_old ) THEN 2205 message_string = 'netCDF file for volume data ' // & 2206 TRIM( var ) // ' from previous run found,' // & 2207 '&but this file cannot be extended due to' // & 2208 ' mismatch in number of' // & 2209 ' vertical grid points (nz_do3d).' // & 2088 message_string = 'netCDF file for volume data ' // TRIM( var ) // & 2089 ' from previous run found,' // & 2090 '&but this file cannot be extended due to' // & 2091 ' mismatch in number of' // ' vertical grid points (nz_do3d).' // & 2210 2092 '&New file is created instead.' 2211 2093 CALL message( 'define_netcdf_header', 'PA0246', 0, 1, 0, 6, 0 ) … … 2215 2097 2216 2098 ! 2217 !-- Get the id of the time coordinate (unlimited coordinate) and its 2218 !-- last index on the file. The next time level is pl3d..count+1. 2219 !-- The current time must be larger than the last output time 2220 !-- on the file. 2099 !-- Get the id of the time coordinate (unlimited coordinate) and its last index on the file. 2100 !-- The next time level is pl3d..count+1. 2101 !-- The current time must be larger than the last output time on the file. 2221 2102 nc_stat = NF90_INQ_VARID( id_set_3d(av), 'time', id_var_time_3d(av) ) 2222 2103 CALL netcdf_handle_error( 'netcdf_define_header', 91 ) 2223 2104 2224 nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_time_3d(av), &2105 nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_time_3d(av), & 2225 2106 dimids = id_dim_time_old ) 2226 2107 CALL netcdf_handle_error( 'netcdf_define_header', 92 ) … … 2228 2109 id_dim_time_3d(av) = id_dim_time_old(1) 2229 2110 2230 nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_time_3d(av), & 2231 len = ntime_count ) 2111 nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_time_3d(av), LEN = ntime_count ) 2232 2112 CALL netcdf_handle_error( 'netcdf_define_header', 93 ) 2233 2113 2234 2114 ! 2235 !-- For non-parallel output use the last output time level of the netcdf 2236 !-- file because the time dimension is unlimited. In case of parallel 2237 !-- output the variable ntime_count could get the value of 9*10E36 because 2238 !-- the time dimension is limited. 2115 !-- For non-parallel output use the last output time level of the netcdf file because the time 2116 !-- dimension is unlimited. In case of parallel output the variable ntime_count could get the 2117 !-- value of 9*10E36 because the time dimension is limited. 2239 2118 IF ( netcdf_data_format < 5 ) do3d_time_count(av) = ntime_count 2240 2119 2241 nc_stat = NF90_GET_VAR( id_set_3d(av), id_var_time_3d(av), &2242 last_time_coordinate, &2243 start = (/ do3d_time_count(av) /), &2120 nc_stat = NF90_GET_VAR( id_set_3d(av), id_var_time_3d(av), & 2121 last_time_coordinate, & 2122 start = (/ do3d_time_count(av) /), & 2244 2123 count = (/ 1 /) ) 2245 2124 CALL netcdf_handle_error( 'netcdf_define_header', 94 ) 2246 2125 2247 2126 IF ( last_time_coordinate(1) >= simulated_time ) THEN 2248 message_string = 'netCDF file for volume data ' // & 2249 TRIM( var ) // ' from previous run found,' // & 2250 '&but this file cannot be extended becaus' // & 2251 'e the current output time' // & 2252 '&is less or equal than the last output t' // & 2253 'ime on this file.' // & 2127 message_string = 'netCDF file for volume data ' // TRIM( var ) // & 2128 ' from previous run found,' // & 2129 '&but this file cannot be extended because' // & 2130 ' the current output time' // & 2131 '&is less or equal than the last output time' // ' on this file.' // & 2254 2132 '&New file is created instead.' 2255 2133 CALL message( 'define_netcdf_header', 'PA0247', 0, 1, 0, 6, 0 ) … … 2261 2139 IF ( netcdf_data_format > 4 ) THEN 2262 2140 ! 2263 !-- Check if the needed number of output time levels is increased 2264 !-- compared to the number oftime levels in the existing file.2141 !-- Check if the needed number of output time levels is increased compared to the number of 2142 !-- time levels in the existing file. 2265 2143 IF ( ntdim_3d(av) > ntime_count ) THEN 2266 message_string = 'netCDF file for volume data ' // & 2267 TRIM( var ) // ' from previous run found,' // & 2268 '&but this file cannot be extended becaus' // & 2269 'e the number of output time levels has b' // & 2270 'een increased compared to the previous s' // & 2271 'imulation.' // & 2144 message_string = 'netCDF file for volume data ' // TRIM( var ) // & 2145 ' from previous run found,' // & 2146 '&but this file cannot be extended becaus' // & 2147 'e the number of output time levels has b' // & 2148 'een increased compared to the previous s' // 'imulation.' // & 2272 2149 '&New file is created instead.' 2273 2150 CALL message( 'define_netcdf_header', 'PA0388', 0, 1, 0, 6, 0 ) … … 2277 2154 !-- Recalculate the needed time levels for the new file. 2278 2155 IF ( av == 0 ) THEN 2279 ntdim_3d(0) = CEILING( & 2280 ( end_time - MAX( skip_time_do3d, & 2281 simulated_time_at_begin ) & 2282 ) / dt_do3d ) 2156 ntdim_3d(0) = CEILING( ( end_time - MAX( skip_time_do3d, & 2157 simulated_time_at_begin ) & 2158 ) / dt_do3d ) 2283 2159 IF ( do3d_at_begin ) ntdim_3d(0) = ntdim_3d(0) + 1 2284 2160 ELSE 2285 ntdim_3d(1) = CEILING( & 2286 ( end_time - MAX( skip_time_data_output_av, & 2287 simulated_time_at_begin ) & 2288 ) / dt_data_output_av ) 2161 ntdim_3d(1) = CEILING( ( end_time - MAX( skip_time_data_output_av, & 2162 simulated_time_at_begin ) & 2163 ) / dt_data_output_av ) 2289 2164 ENDIF 2290 2165 RETURN … … 2296 2171 !-- Now get the variable ids. 2297 2172 i = 1 2298 DO WHILE ( do3d(av,i)(1:1) /= ' ' ) 2299 nc_stat = NF90_INQ_VARID( id_set_3d(av), TRIM( do3d(av,i) ), & 2300 id_var_do3d(av,i) ) 2173 DO WHILE ( do3d(av,i)(1:1) /= ' ' ) 2174 nc_stat = NF90_INQ_VARID( id_set_3d(av), TRIM( do3d(av,i) ), id_var_do3d(av,i) ) 2301 2175 CALL netcdf_handle_error( 'netcdf_define_header', 95 ) 2302 2176 #if defined( __netcdf4_parallel ) … … 2304 2178 !-- Set collective io operations for parallel io 2305 2179 IF ( netcdf_data_format > 4 ) THEN 2306 nc_stat = NF90_VAR_PAR_ACCESS( id_set_3d(av), & 2307 id_var_do3d(av,i), & 2308 NF90_COLLECTIVE ) 2180 nc_stat = NF90_VAR_PAR_ACCESS( id_set_3d(av), id_var_do3d(av,i), NF90_COLLECTIVE ) 2309 2181 CALL netcdf_handle_error( 'netcdf_define_header', 453 ) 2310 2182 ENDIF … … 2314 2186 2315 2187 ! 2316 !-- Update the title attribute on file 2317 !-- In order to avoid 'data mode' errors if updated attributes are larger 2318 !-- than their original size, NF90_PUT_ATT is called in 'define mode' 2319 !-- enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible 2320 !-- performance loss due to data copying; an alternative strategy would be 2321 !-- to ensure equal attribute size. Maybe revise later. 2188 !-- Update the title attribute on file. 2189 !-- In order to avoid 'data mode' errors if updated attributes are larger than their original 2190 !-- size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF 2191 !-- calls. This implies a possible performance loss due to data copying; an alternative 2192 !-- strategy would be to ensure equal attribute size. Maybe revise later. 2322 2193 IF ( av == 0 ) THEN 2323 2194 time_average_text = ' ' 2324 2195 ELSE 2325 WRITE (time_average_text, '('', '',F7.1,'' s average'')') & 2326 averaging_interval 2196 WRITE ( time_average_text, '('', '',F7.1,'' s average'')' ) averaging_interval 2327 2197 ENDIF 2328 2198 nc_stat = NF90_REDEF( id_set_3d(av) ) 2329 2199 CALL netcdf_handle_error( 'netcdf_define_header', 429 ) 2330 nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'title', & 2331 TRIM( run_description_header ) // & 2332 TRIM( time_average_text ) ) 2200 nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'title', & 2201 TRIM( run_description_header ) // TRIM( time_average_text ) ) 2333 2202 CALL netcdf_handle_error( 'netcdf_define_header', 96 ) 2334 2203 nc_stat = NF90_ENDDEF( id_set_3d(av) ) 2335 2204 CALL netcdf_handle_error( 'netcdf_define_header', 430 ) 2336 message_string = 'netCDF file for volume data ' // & 2337 TRIM( var ) // ' from previous run found.' // & 2338 '&This file will be extended.' 2205 message_string = 'netCDF file for volume data ' // TRIM( var ) // & 2206 ' from previous run found.' // '&This file will be extended.' 2339 2207 CALL message( 'define_netcdf_header', 'PA0248', 0, 0, 0, 6, 0 ) 2340 2208 … … 2344 2212 ! 2345 2213 !-- Define some global attributes of the dataset 2346 nc_stat = NF90_PUT_ATT( id_set_agt, NF90_GLOBAL, 'title', & 2347 TRIM( run_description_header ) ) 2214 nc_stat = NF90_PUT_ATT( id_set_agt, NF90_GLOBAL, 'title', TRIM( run_description_header ) ) 2348 2215 CALL netcdf_handle_error( 'netcdf_define_header', 330 ) 2349 2216 ! 2350 2217 !-- Switch for unlimited time dimension 2351 2218 IF ( agent_time_unlimited ) THEN 2352 CALL netcdf_create_dim( id_set_agt, 'time', NF90_UNLIMITED, & 2219 CALL netcdf_create_dim( id_set_agt, 'time', NF90_UNLIMITED, id_dim_time_agt, 331 ) 2220 ELSE 2221 CALL netcdf_create_dim( id_set_agt, 'time', & 2222 INT( ( MIN( multi_agent_system_end, end_time ) - & 2223 multi_agent_system_start ) / & 2224 dt_write_agent_data * 1.1 ), & 2353 2225 id_dim_time_agt, 331 ) 2354 ELSE 2355 CALL netcdf_create_dim( id_set_agt, 'time', & 2356 INT( ( MIN( multi_agent_system_end, & 2357 end_time ) - & 2358 multi_agent_system_start ) / & 2359 dt_write_agent_data * 1.1 ), & 2360 id_dim_time_agt, 331 ) 2361 ENDIF 2362 2363 CALL netcdf_create_var( id_set_agt, (/ id_dim_time_agt /), 'time', & 2364 NF90_REAL4, id_var_time_agt, 'seconds', 'time', & 2365 332, 333, 000 ) 2226 ENDIF 2227 2228 CALL netcdf_create_var( id_set_agt, (/ id_dim_time_agt /), 'time', NF90_REAL4, & 2229 id_var_time_agt, 'seconds', 'time', 332, 333, 000 ) 2366 2230 CALL netcdf_create_att( id_set_agt, id_var_time_agt, 'standard_name', 'time', 000) 2367 2231 CALL netcdf_create_att( id_set_agt, id_var_time_agt, 'axis', 'T', 000) 2368 2232 2369 CALL netcdf_create_dim( id_set_agt, 'agent_number', & 2370 dim_size_agtnum, id_dim_agtnum, 334 ) 2371 2372 CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum /), & 2373 'agent_number', NF90_REAL4, & 2374 id_var_agtnum, 'agent number', '', 335, & 2375 336, 000 ) 2233 CALL netcdf_create_dim( id_set_agt, 'agent_number', dim_size_agtnum, id_dim_agtnum, 334 ) 2234 2235 CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum /), 'agent_number', NF90_REAL4, & 2236 id_var_agtnum, 'agent number', '', 335, 336, 000 ) 2376 2237 ! 2377 2238 !-- Define variable which contains the real number of agents in use 2378 CALL netcdf_create_var( id_set_agt, (/ id_dim_time_agt /), & 2379 'real_num_of_agt', NF90_REAL4, & 2380 id_var_rnoa_agt, 'agent number', '', 337, & 2381 338, 000 ) 2239 CALL netcdf_create_var( id_set_agt, (/ id_dim_time_agt /), 'real_num_of_agt', NF90_REAL4,& 2240 id_var_rnoa_agt, 'agent number', '', 337, 338, 000 ) 2382 2241 i = 1 2383 CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum, & 2384 id_dim_time_agt /), agt_var_names(i), & 2385 NF90_DOUBLE, id_var_agt(i), & 2386 TRIM( agt_var_units(i) ), & 2387 TRIM( agt_var_names(i) ), 339, 340, 341 ) 2242 CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum, id_dim_time_agt /), & 2243 agt_var_names(i), NF90_DOUBLE, id_var_agt(i), & 2244 TRIM( agt_var_units(i) ), TRIM( agt_var_names(i) ), & 2245 339, 340, 341 ) 2388 2246 ! 2389 2247 !-- Define the variables 2390 2248 DO i = 2, 6 2391 CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum, & 2392 id_dim_time_agt /), agt_var_names(i), & 2393 NF90_REAL4, id_var_agt(i), & 2394 TRIM( agt_var_units(i) ), & 2395 TRIM( agt_var_names(i) ), 339, 340, 341 ) 2249 CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum, id_dim_time_agt /), & 2250 agt_var_names(i), NF90_REAL4, id_var_agt(i), & 2251 TRIM( agt_var_units(i) ), TRIM( agt_var_names(i) ), & 2252 339, 340, 341 ) 2396 2253 2397 2254 ENDDO … … 2399 2256 !-- Define vars for biometeorology 2400 2257 IF ( biometeorology ) THEN 2401 CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum, & 2402 id_dim_time_agt /), agt_var_names(7), & 2403 nc_precision(8), id_var_agt(7), & 2404 TRIM( agt_var_units(7) ), & 2405 TRIM( agt_var_names(7) ), 339, 340, 341 ) 2258 CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum, id_dim_time_agt /), & 2259 agt_var_names(7), nc_precision(8), id_var_agt(7), & 2260 TRIM( agt_var_units(7) ), TRIM( agt_var_names(7) ), & 2261 339, 340, 341 ) 2406 2262 ENDIF 2407 2263 ! … … 2415 2271 ! 2416 2272 ! ! 2417 ! !-- Get the id of the time coordinate (unlimited coordinate) and its 2418 ! !-- last index on the file. The next time level is prt..count+1. 2419 ! !-- The current time must be larger than the last output time 2420 ! !-- on the file. 2273 ! !-- Get the id of the time coordinate (unlimited coordinate) and its last index on the file. 2274 ! !-- The next time level is prt..count+1. 2275 ! !-- The current time must be larger than the last output time on the file. 2421 2276 ! nc_stat = NF90_INQ_VARID( id_set_agt, 'time', id_var_time_agt ) 2422 2277 ! CALL netcdf_handle_error( 'netcdf_define_header', 343 ) 2423 2278 ! 2424 ! nc_stat = NF90_INQUIRE_VARIABLE( id_set_agt, id_var_time_agt, & 2425 ! dimids = id_dim_time_old ) 2279 ! nc_stat = NF90_INQUIRE_VARIABLE( id_set_agt, id_var_time_agt, dimids = id_dim_time_old ) 2426 2280 ! CALL netcdf_handle_error( 'netcdf_define_header', 344 ) 2427 2281 ! id_dim_time_agt = id_dim_time_old(1) 2428 2282 ! 2429 ! nc_stat = NF90_INQUIRE_DIMENSION( id_set_agt, id_dim_time_agt, & 2430 ! len = agt_time_count ) 2283 ! nc_stat = NF90_INQUIRE_DIMENSION( id_set_agt, id_dim_time_agt, LEN = agt_time_count ) 2431 2284 ! CALL netcdf_handle_error( 'netcdf_define_header', 345 ) 2432 2285 ! 2433 ! nc_stat = NF90_GET_VAR( id_set_agt, id_var_time_agt, &2434 ! last_time_coordinate, &2435 ! start = (/ agt_time_count /), &2286 ! nc_stat = NF90_GET_VAR( id_set_agt, id_var_time_agt, & 2287 ! last_time_coordinate, & 2288 ! start = (/ agt_time_count /), & 2436 2289 ! count = (/ 1 /) ) 2437 2290 ! CALL netcdf_handle_error( 'netcdf_define_header', 346 ) 2438 2291 ! 2439 2292 ! IF ( last_time_coordinate(1) >= simulated_time ) THEN 2440 ! message_string = 'netCDF file for agents ' // & 2441 ! 'from previous run found,' // & 2442 ! '&but this file cannot be extended becaus' // & 2443 ! 'e the current output time' // & 2444 ! '&is less or equal than the last output t' // & 2445 ! 'ime on this file.' // & 2293 ! message_string = 'netCDF file for agents ' //'from previous run found,' // & 2294 ! '&but this file cannot be extended because' // & 2295 ! ' the current output time' // & 2296 ! '&is less or equal than the last output time' // ' on this file.' //& 2446 2297 ! '&New file is created instead.' 2447 2298 ! CALL message( 'define_netcdf_header', 'PA0265', 0, 1, 0, 6, 0 ) … … 2454 2305 ! !-- Dataset seems to be extendable. 2455 2306 ! !-- Now get the variable ids. 2456 ! nc_stat = NF90_INQ_VARID( id_set_agt, 'real_num_of_agt', & 2457 ! id_var_rnoa_agt ) 2307 ! nc_stat = NF90_INQ_VARID( id_set_agt, 'real_num_of_agt', id_var_rnoa_agt ) 2458 2308 ! CALL netcdf_handle_error( 'netcdf_define_header', 347 ) 2459 2309 ! 2460 2310 ! DO i = 1, 17 2461 2311 ! 2462 ! nc_stat = NF90_INQ_VARID( id_set_agt, agt_var_names(i), & 2463 ! id_var_prt(i) ) 2312 ! nc_stat = NF90_INQ_VARID( id_set_agt, agt_var_names(i), id_var_prt(i) ) 2464 2313 ! CALL netcdf_handle_error( 'netcdf_define_header', 348 ) 2465 2314 ! 2466 2315 ! ENDDO 2467 2316 ! 2468 ! message_string = 'netCDF file for particles ' // & 2469 ! 'from previous run found.' // & 2317 ! message_string = 'netCDF file for particles ' //'from previous run found.' // & 2470 2318 ! '&This file will be extended.' 2471 2319 ! CALL message( 'define_netcdf_header', 'PA0266', 0, 0, 0, 6, 0 ) … … 2477 2325 !-- Define some global attributes of the dataset 2478 2326 IF ( av == 0 ) THEN 2479 CALL netcdf_create_global_atts( id_set_xy(av), 'xy', TRIM( run_description_header ), 97 ) 2327 CALL netcdf_create_global_atts( id_set_xy(av), 'xy', TRIM( run_description_header ), & 2328 97 ) 2480 2329 time_average_text = ' ' 2481 2330 ELSE 2482 CALL netcdf_create_global_atts( id_set_xy(av), 'xy_av', TRIM( run_description_header ), 97 ) 2331 CALL netcdf_create_global_atts( id_set_xy(av), 'xy_av', & 2332 TRIM( run_description_header ), 97 ) 2483 2333 WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval 2484 nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'time_avg', &2334 nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'time_avg', & 2485 2335 TRIM( time_average_text ) ) 2486 2336 CALL netcdf_handle_error( 'netcdf_define_header', 98 ) … … 2489 2339 ! 2490 2340 !-- Define time coordinate for xy sections. 2491 !-- For parallel output the time dimensions has to be limited, otherwise 2492 !-- the performance dropssignificantly.2341 !-- For parallel output the time dimensions has to be limited, otherwise the performance drops 2342 !-- significantly. 2493 2343 IF ( netcdf_data_format < 5 ) THEN 2494 CALL netcdf_create_dim( id_set_xy(av), 'time', NF90_UNLIMITED, & 2495 id_dim_time_xy(av), 99 ) 2344 CALL netcdf_create_dim( id_set_xy(av), 'time', NF90_UNLIMITED, id_dim_time_xy(av), 99 ) 2496 2345 ELSE 2497 CALL netcdf_create_dim( id_set_xy(av), 'time', ntdim_2d_xy(av), & 2498 id_dim_time_xy(av), 524 ) 2499 ENDIF 2500 2501 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_time_xy(av) /), & 2502 'time', NF90_DOUBLE, id_var_time_xy(av), & 2503 'seconds', 'time', 100, 101, 000 ) 2346 CALL netcdf_create_dim( id_set_xy(av), 'time', ntdim_2d_xy(av), id_dim_time_xy(av), & 2347 524 ) 2348 ENDIF 2349 2350 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_time_xy(av) /), 'time', NF90_DOUBLE, & 2351 id_var_time_xy(av), 'seconds', 'time', 100, 101, 000 ) 2504 2352 CALL netcdf_create_att( id_set_xy(av), id_var_time_xy(av), 'standard_name', 'time', 000) 2505 2353 CALL netcdf_create_att( id_set_xy(av), id_var_time_xy(av), 'axis', 'T', 000) … … 2511 2359 ELSE 2512 2360 ns = 1 2513 DO WHILE ( section(ns,1) /= -9999 .AND. ns <= 100 )2361 DO WHILE ( section(ns,1) /= -9999 .AND. ns <= 100 ) 2514 2362 ns = ns + 1 2515 2363 ENDDO … … 2519 2367 ! 2520 2368 !-- Define vertical coordinate grid (zu grid) 2521 CALL netcdf_create_dim( id_set_xy(av), 'zu_xy', ns, & 2522 id_dim_zu_xy(av), 102 ) 2523 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu_xy(av) /), & 2524 'zu_xy', NF90_DOUBLE, id_var_zu_xy(av), & 2525 'meters', '', 103, 104, 000 ) 2526 CALL netcdf_create_att( id_set_xy(av), id_var_zu_xy(av), 'axis', & 2527 'Z', 000) 2369 CALL netcdf_create_dim( id_set_xy(av), 'zu_xy', ns, id_dim_zu_xy(av), 102 ) 2370 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu_xy(av) /), 'zu_xy', NF90_DOUBLE, & 2371 id_var_zu_xy(av), 'meters', '', 103, 104, 000 ) 2372 CALL netcdf_create_att( id_set_xy(av), id_var_zu_xy(av), 'axis', 'Z', 000) 2528 2373 ! 2529 2374 !-- Define vertical coordinate grid (zw grid) 2530 CALL netcdf_create_dim( id_set_xy(av), 'zw_xy', ns, & 2531 id_dim_zw_xy(av), 105 ) 2532 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zw_xy(av) /), & 2533 'zw_xy', NF90_DOUBLE, id_var_zw_xy(av), & 2534 'meters', '', 106, 107, 000 ) 2535 CALL netcdf_create_att( id_set_xy(av), id_var_zw_xy(av), 'axis', & 2536 'Z', 000) 2375 CALL netcdf_create_dim( id_set_xy(av), 'zw_xy', ns, id_dim_zw_xy(av), 105 ) 2376 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zw_xy(av) /), 'zw_xy', NF90_DOUBLE, & 2377 id_var_zw_xy(av), 'meters', '', 106, 107, 000 ) 2378 CALL netcdf_create_att( id_set_xy(av), id_var_zw_xy(av), 'axis', 'Z', 000) 2537 2379 2538 2380 IF ( land_surface ) THEN 2539 2381 2540 2382 ns_do = 1 2541 DO WHILE ( section(ns_do,1) /= -9999 .AND. ns_do < nzs )2383 DO WHILE ( section(ns_do,1) /= -9999 .AND. ns_do < nzs ) 2542 2384 ns_do = ns_do + 1 2543 2385 ENDDO 2544 2386 ! 2545 2387 !-- Define vertical coordinate grid (zs grid) 2546 CALL netcdf_create_dim( id_set_xy(av), 'zs_xy', ns_do, & 2547 id_dim_zs_xy(av), 539 ) 2548 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zs_xy(av) /), & 2549 'zs_xy', NF90_DOUBLE, id_var_zs_xy(av), & 2550 'meters', '', 540, 541, 000 ) 2551 CALL netcdf_create_att( id_set_xy(av), id_var_zs_xy(av), 'axis', & 2552 'Z', 000) 2553 2554 ENDIF 2555 2556 ! 2557 !-- Define a pseudo vertical coordinate grid for the surface variables 2558 !-- u* and t* to store their height level 2559 CALL netcdf_create_dim( id_set_xy(av), 'zu1_xy', 1, & 2560 id_dim_zu1_xy(av), 108 ) 2561 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu1_xy(av) /), & 2562 'zu1_xy', NF90_DOUBLE, id_var_zu1_xy(av), & 2563 'meters', '', 109, 110, 000 ) 2564 CALL netcdf_create_att( id_set_xy(av), id_var_zu1_xy(av), 'axis', & 2565 'Z', 000) 2566 ! 2567 !-- Define a variable to store the layer indices of the horizontal cross 2568 !-- sections, too 2569 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu_xy(av) /), & 2570 'ind_z_xy', NF90_DOUBLE, & 2571 id_var_ind_z_xy(av), 'gridpoints', '', 111, & 2572 112, 000 ) 2388 CALL netcdf_create_dim( id_set_xy(av), 'zs_xy', ns_do, id_dim_zs_xy(av), 539 ) 2389 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zs_xy(av) /), 'zs_xy', NF90_DOUBLE, & 2390 id_var_zs_xy(av), 'meters', '', 540, 541, 000 ) 2391 CALL netcdf_create_att( id_set_xy(av), id_var_zs_xy(av), 'axis', 'Z', 000) 2392 2393 ENDIF 2394 2395 ! 2396 !-- Define a pseudo vertical coordinate grid for the surface variables u* and t* to store 2397 !-- their height level. 2398 CALL netcdf_create_dim( id_set_xy(av), 'zu1_xy', 1, id_dim_zu1_xy(av), 108 ) 2399 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu1_xy(av) /), 'zu1_xy', NF90_DOUBLE, & 2400 id_var_zu1_xy(av), 'meters', '', 109, 110, 000 ) 2401 CALL netcdf_create_att( id_set_xy(av), id_var_zu1_xy(av), 'axis', 'Z', 000) 2402 ! 2403 !-- Define a variable to store the layer indices of the horizontal cross sections, too. 2404 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_zu_xy(av) /), 'ind_z_xy', NF90_DOUBLE, & 2405 id_var_ind_z_xy(av), 'gridpoints', '', 111, 112, 000 ) 2573 2406 ! 2574 2407 !-- Define x-axis (for scalar position) 2575 CALL netcdf_create_dim( id_set_xy(av), 'x', nx+1, id_dim_x_xy(av), & 2576 113 ) 2577 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av) /), 'x', & 2578 NF90_DOUBLE, id_var_x_xy(av), 'meters', '', & 2579 114, 115, 000 ) 2580 CALL netcdf_create_att( id_set_xy(av), id_var_x_xy(av), 'axis', & 2581 'X', 000) 2408 CALL netcdf_create_dim( id_set_xy(av), 'x', nx+1, id_dim_x_xy(av), 113 ) 2409 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av) /), 'x', NF90_DOUBLE, & 2410 id_var_x_xy(av), 'meters', '', 114, 115, 000 ) 2411 CALL netcdf_create_att( id_set_xy(av), id_var_x_xy(av), 'axis', 'X', 000) 2582 2412 ! 2583 2413 !-- Define x-axis (for u position) 2584 CALL netcdf_create_dim( id_set_xy(av), 'xu', nx+1, & 2585 id_dim_xu_xy(av), 388 ) 2586 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_xu_xy(av) /), 'xu', & 2587 NF90_DOUBLE, id_var_xu_xy(av), 'meters', '', & 2588 389, 390, 000 ) 2589 CALL netcdf_create_att( id_set_xy(av), id_var_xu_xy(av), 'axis', & 2590 'X', 000) 2414 CALL netcdf_create_dim( id_set_xy(av), 'xu', nx+1, id_dim_xu_xy(av), 388 ) 2415 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_xu_xy(av) /), 'xu', NF90_DOUBLE, & 2416 id_var_xu_xy(av), 'meters', '', 389, 390, 000 ) 2417 CALL netcdf_create_att( id_set_xy(av), id_var_xu_xy(av), 'axis', 'X', 000) 2591 2418 ! 2592 2419 !-- Define y-axis (for scalar position) 2593 CALL netcdf_create_dim( id_set_xy(av), 'y', ny+1, id_dim_y_xy(av), & 2594 116 ) 2595 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_y_xy(av) /), 'y', & 2596 NF90_DOUBLE, id_var_y_xy(av), 'meters', '', & 2597 117, 118, 000 ) 2598 CALL netcdf_create_att( id_set_xy(av), id_var_y_xy(av), 'axis', & 2599 'Y', 000) 2420 CALL netcdf_create_dim( id_set_xy(av), 'y', ny+1, id_dim_y_xy(av), 116 ) 2421 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_y_xy(av) /), 'y', NF90_DOUBLE, & 2422 id_var_y_xy(av), 'meters', '', 117, 118, 000 ) 2423 CALL netcdf_create_att( id_set_xy(av), id_var_y_xy(av), 'axis', 'Y', 000) 2600 2424 ! 2601 2425 !-- Define y-axis (for scalar position) 2602 CALL netcdf_create_dim( id_set_xy(av), 'yv', ny+1, & 2603 id_dim_yv_xy(av), 364 ) 2604 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_yv_xy(av) /), 'yv', & 2605 NF90_DOUBLE, id_var_yv_xy(av), 'meters', '', & 2606 365, 366, 000 ) 2607 CALL netcdf_create_att( id_set_xy(av), id_var_yv_xy(av), 'axis', & 2608 'Y', 000) 2426 CALL netcdf_create_dim( id_set_xy(av), 'yv', ny+1, id_dim_yv_xy(av), 364 ) 2427 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_yv_xy(av) /), 'yv', NF90_DOUBLE, & 2428 id_var_yv_xy(av), 'meters', '', 365, 366, 000 ) 2429 CALL netcdf_create_att( id_set_xy(av), id_var_yv_xy(av), 'axis', 'Y', 000) 2609 2430 ! 2610 2431 !-- Define UTM and geographic coordinates 2611 CALL define_geo_coordinates( id_set_xy(av), &2612 (/ id_dim_x_xy(av), id_dim_xu_xy(av) /),&2613 (/ id_dim_y_xy(av), id_dim_yv_xy(av) /),&2614 id_var_eutm_xy(:,av), id_var_nutm_xy(:,av),&2615 id_var_lat_xy(:,av), id_var_lon_xy(:,av) )2432 CALL define_geo_coordinates( id_set_xy(av), & 2433 (/ id_dim_x_xy(av), id_dim_xu_xy(av) /), & 2434 (/ id_dim_y_xy(av), id_dim_yv_xy(av) /), & 2435 id_var_eutm_xy(:,av), id_var_nutm_xy(:,av), & 2436 id_var_lat_xy(:,av), id_var_lon_xy(:,av) ) 2616 2437 ! 2617 2438 !-- Define coordinate-reference system 2618 2439 CALL netcdf_create_crs( id_set_xy(av), 000 ) 2619 2440 ! 2620 !-- In case of non-flat topography define 2d-arrays containing the height 2621 !-- information. Only for parallel netcdf output. 2622 IF ( TRIM( topography ) /= 'flat' .AND. & 2623 netcdf_data_format > 4 ) THEN 2441 !-- In case of non-flat topography define 2d-arrays containing the height information. Only 2442 !-- for parallel netcdf output. 2443 IF ( TRIM( topography ) /= 'flat' .AND. netcdf_data_format > 4 ) THEN 2624 2444 ! 2625 2445 !-- Define zusi = zu(nzb_s_inner) 2626 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av), & 2627 id_dim_y_xy(av) /), 'zusi', NF90_DOUBLE, & 2628 id_var_zusi_xy(av), 'meters', & 2629 'zu(nzb_s_inner)', 421, 422, 423 ) 2446 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av), id_dim_y_xy(av) /), 'zusi',& 2447 NF90_DOUBLE, id_var_zusi_xy(av), 'meters', 'zu(nzb_s_inner)', & 2448 421, 422, 423 ) 2630 2449 ! 2631 2450 !-- Define zwwi = zw(nzb_w_inner) 2632 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av), & 2633 id_dim_y_xy(av) /), 'zwwi', NF90_DOUBLE, & 2634 id_var_zwwi_xy(av), 'meters', & 2635 'zw(nzb_w_inner)', 424, 425, 426 ) 2451 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av), id_dim_y_xy(av) /), 'zwwi',& 2452 NF90_DOUBLE, id_var_zwwi_xy(av), 'meters', 'zw(nzb_w_inner)', & 2453 424, 425, 426 ) 2636 2454 2637 2455 ENDIF … … 2642 2460 i = 1 2643 2461 2644 DO WHILE ( do2d(av,i)(1:1) /= ' ' )2462 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) 2645 2463 2646 2464 IF ( INDEX( do2d(av,i), 'xy' ) /= 0 ) THEN 2647 2465 ! 2648 !-- If there is a star in the variable name (u* or t*), it is a 2649 !-- surface variable. Defineit with id_dim_zu1_xy.2466 !-- If there is a star in the variable name (u* or t*), it is a surface variable. Define 2467 !-- it with id_dim_zu1_xy. 2650 2468 IF ( INDEX( do2d(av,i), '*' ) /= 0 ) THEN 2651 2469 2652 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av), & 2653 id_dim_y_xy(av), id_dim_zu1_xy(av), & 2654 id_dim_time_xy(av) /), do2d(av,i), & 2655 nc_precision(1), id_var_do2d(av,i), & 2656 TRIM( do2d_unit(av,i) ), & 2657 do2d(av,i), 119, 120, 354, .TRUE. ) 2470 CALL netcdf_create_var( id_set_xy(av), (/ id_dim_x_xy(av), id_dim_y_xy(av), & 2471 id_dim_zu1_xy(av), id_dim_time_xy(av) /), do2d(av,i), & 2472 nc_precision(1), id_var_do2d(av,i), & 2473 TRIM( do2d_unit(av,i) ), do2d(av,i), 119, 120, 354, & 2474 .TRUE. ) 2658 2475 2659 2476 ELSE … … 2666 2483 !-- Most variables are defined on the zu grid 2667 2484 CASE ( 'e_xy', 'nc_xy', 'ng_xy', 'ni_xy', 'nr_xy', 'ns_xy', 'p_xy', & 2668 'pc_xy', 'pr_xy', 'prr_xy', 'q_xy', &2485 'pc_xy', 'pr_xy', 'prr_xy', 'q_xy', & 2669 2486 'qc_xy', 'qg_xy', 'qi_xy', 'ql_xy', 'ql_c_xy', 'ql_v_xy', & 2670 2487 'ql_vp_xy', 'qr_xy', 'qs_xy', 'qv_xy', & 2671 's_xy', &2488 's_xy', & 2672 2489 'theta_xy', 'thetal_xy', 'thetav_xy' ) 2673 2490 … … 2702 2519 !-- Check for land surface quantities 2703 2520 IF ( land_surface ) THEN 2704 CALL lsm_define_netcdf_grid( do2d(av,i), found, & 2705 grid_x, grid_y, grid_z ) 2521 CALL lsm_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 2706 2522 ENDIF 2707 2523 2708 2524 IF ( .NOT. found ) THEN 2709 CALL tcm_define_netcdf_grid( do2d(av,i), found, & 2710 grid_x, grid_y, & 2525 CALL tcm_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 2526 ENDIF 2527 2528 ! 2529 !-- Check for ocean quantities 2530 IF ( .NOT. found .AND. ocean_mode ) THEN 2531 CALL ocean_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, & 2532 grid_z ) 2533 ENDIF 2534 ! 2535 !-- Check for radiation quantities 2536 IF ( .NOT. found .AND. radiation ) THEN 2537 CALL radiation_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, & 2538 grid_z ) 2539 ENDIF 2540 2541 ! 2542 !-- Check for SALSA quantities 2543 IF ( .NOT. found .AND. salsa ) THEN 2544 CALL salsa_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, & 2545 grid_z ) 2546 ENDIF 2547 2548 ! 2549 !-- Check for gust module quantities 2550 IF ( .NOT. found .AND. gust_module_enabled ) THEN 2551 CALL gust_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, & 2552 grid_z ) 2553 ENDIF 2554 ! 2555 !-- Check for biometeorology quantities 2556 IF ( .NOT. found .AND. biometeorology ) THEN 2557 CALL bio_define_netcdf_grid( do2d( av, i), found, grid_x, grid_y, & 2711 2558 grid_z ) 2712 2559 ENDIF 2713 2714 ! 2715 !-- Check for ocean quantities 2716 IF ( .NOT. found .AND. ocean_mode ) THEN 2717 CALL ocean_define_netcdf_grid( do2d(av,i), found, & 2718 grid_x, grid_y, & 2719 grid_z ) 2720 ENDIF 2721 ! 2722 !-- Check for radiation quantities 2723 IF ( .NOT. found .AND. radiation ) THEN 2724 CALL radiation_define_netcdf_grid( do2d(av,i), & 2725 found, grid_x, grid_y,& 2726 grid_z ) 2727 ENDIF 2728 2729 ! 2730 !-- Check for SALSA quantities 2731 IF ( .NOT. found .AND. salsa ) THEN 2732 CALL salsa_define_netcdf_grid( do2d(av,i), found, & 2733 grid_x, grid_y, & 2734 grid_z ) 2735 ENDIF 2736 2737 ! 2738 !-- Check for gust module quantities 2739 IF ( .NOT. found .AND. gust_module_enabled ) THEN 2740 CALL gust_define_netcdf_grid( do2d(av,i), found, & 2741 grid_x, grid_y, & 2560 ! 2561 !-- Check for chemistry quantities 2562 IF ( .NOT. found .AND. air_chemistry ) THEN 2563 CALL chem_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, & 2742 2564 grid_z ) 2743 2565 ENDIF 2744 ! 2745 !-- Check for biometeorology quantities 2746 IF ( .NOT. found .AND. biometeorology ) THEN 2747 CALL bio_define_netcdf_grid( do2d( av, i), found, & 2748 grid_x, grid_y, & 2749 grid_z ) 2750 ENDIF 2751 ! 2752 !-- Check for chemistry quantities 2753 IF ( .NOT. found .AND. air_chemistry ) THEN 2754 CALL chem_define_netcdf_grid( do2d(av,i), found, & 2755 grid_x, grid_y, & 2566 2567 IF ( .NOT. found ) & 2568 CALL doq_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 2569 ! 2570 !-- Check for user-defined quantities 2571 IF ( .NOT. found .AND. user_module_enabled ) THEN 2572 CALL user_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, & 2756 2573 grid_z ) 2757 2574 ENDIF 2758 2575 2759 IF ( .NOT. found ) &2760 CALL doq_define_netcdf_grid( &2761 do2d(av,i), found, grid_x, &2762 grid_y, grid_z )2763 !2764 !-- Check for user-defined quantities2765 IF ( .NOT. found .AND. user_module_enabled ) THEN2766 CALL user_define_netcdf_grid( do2d(av,i), found, &2767 grid_x, grid_y, &2768 grid_z )2769 ENDIF2770 2771 2576 IF ( .NOT. found ) THEN 2772 WRITE ( message_string, * ) 'no grid defined for', & 2773 ' variable ', TRIM( do2d(av,i) ) 2774 CALL message( 'define_netcdf_header', 'PA0244', & 2775 0, 1, 0, 6, 0 ) 2577 WRITE ( message_string, * ) 'no grid defined for', ' variable ', & 2578 TRIM( do2d(av,i) ) 2579 CALL message( 'define_netcdf_header', 'PA0244', 0, 1, 0, 6, 0 ) 2776 2580 ENDIF 2777 2581 … … 2804 2608 ! 2805 2609 !-- Define the grid 2806 CALL netcdf_create_var( id_set_xy(av), (/ id_x, id_y, id_z, & 2807 id_dim_time_xy(av) /), do2d(av,i), & 2808 nc_precision(1), id_var_do2d(av,i), & 2809 TRIM( do2d_unit(av,i) ), & 2810 do2d(av,i), 119, 120, 354, .TRUE. ) 2610 CALL netcdf_create_var( id_set_xy(av), (/ id_x, id_y, id_z, & 2611 id_dim_time_xy(av) /), do2d(av,i), nc_precision(1), & 2612 id_var_do2d(av,i), TRIM( do2d_unit(av,i) ), do2d(av,i), & 2613 119, 120, 354, .TRUE. ) 2811 2614 2812 2615 ENDIF … … 2816 2619 ! 2817 2620 !-- Set no fill for every variable to increase performance. 2818 nc_stat = NF90_DEF_VAR_FILL( id_set_xy(av), & 2819 id_var_do2d(av,i), & 2820 NF90_NOFILL, 0 ) 2621 nc_stat = NF90_DEF_VAR_FILL( id_set_xy(av), id_var_do2d(av,i), NF90_NOFILL, 0 ) 2821 2622 CALL netcdf_handle_error( 'netcdf_define_header', 533 ) 2822 2623 ! 2823 2624 !-- Set collective io operations for parallel io 2824 nc_stat = NF90_VAR_PAR_ACCESS( id_set_xy(av), & 2825 id_var_do2d(av,i), & 2625 nc_stat = NF90_VAR_PAR_ACCESS( id_set_xy(av), id_var_do2d(av,i), & 2826 2626 NF90_COLLECTIVE ) 2827 2627 CALL netcdf_handle_error( 'netcdf_define_header', 448 ) … … 2841 2641 2842 2642 ! 2843 !-- Write the list of variables as global attribute (this is used by 2844 !-- restart runs and by combine_plot_fields) 2845 nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', & 2846 var_list ) 2643 !-- Write the list of variables as global attribute (this is used by restart runs and by 2644 !-- combine_plot_fields). 2645 nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', var_list ) 2847 2646 CALL netcdf_handle_error( 'netcdf_define_header', 121 ) 2848 2647 2849 2648 ! 2850 !-- Set general no fill, otherwise the performance drops significantly for 2851 !-- parallel output. 2649 !-- Set general no fill, otherwise the performance drops significantly for parallel output. 2852 2650 nc_stat = NF90_SET_FILL( id_set_xy(av), NF90_NOFILL, oldmode ) 2853 2651 CALL netcdf_handle_error( 'netcdf_define_header', 529 ) … … 2859 2657 2860 2658 ! 2861 !-- These data are only written by PE0 for parallel output to increase 2862 !-- the performance. 2659 !-- These data are only written by PE0 for parallel output to increase the performance. 2863 2660 IF ( myid == 0 .OR. netcdf_data_format < 5 ) THEN 2864 2661 … … 2876 2673 ENDIF 2877 2674 ENDDO 2878 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu_xy(av), &2879 netcdf_data, start = (/ 1 /), &2675 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu_xy(av), & 2676 netcdf_data, start = (/ 1 /), & 2880 2677 count = (/ ns /) ) 2881 2678 CALL netcdf_handle_error( 'netcdf_define_header', 123 ) … … 2890 2687 ENDIF 2891 2688 ENDDO 2892 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zw_xy(av), &2893 netcdf_data, start = (/ 1 /), &2689 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zw_xy(av), & 2690 netcdf_data, start = (/ 1 /), & 2894 2691 count = (/ ns /) ) 2895 2692 CALL netcdf_handle_error( 'netcdf_define_header', 124 ) … … 2909 2706 ENDDO 2910 2707 2911 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zs_xy(av), &2912 netcdf_data(1:ns_do), start = (/ 1 /), &2708 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zs_xy(av), & 2709 netcdf_data(1:ns_do), start = (/ 1 /), & 2913 2710 count = (/ ns_do /) ) 2914 2711 CALL netcdf_handle_error( 'netcdf_define_header', 124 ) … … 2919 2716 !-- Write gridpoint number data 2920 2717 netcdf_data(1:ns) = section(1:ns,1) 2921 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_ind_z_xy(av), &2922 netcdf_data, start = (/ 1 /), &2718 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_ind_z_xy(av), & 2719 netcdf_data, start = (/ 1 /), & 2923 2720 count = (/ ns /) ) 2924 2721 CALL netcdf_handle_error( 'netcdf_define_header', 125 ) … … 2928 2725 ! 2929 2726 !-- Write the cross section height u*, t* 2930 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu1_xy(av), &2931 (/ zu(nzb+1) /), start = (/ 1 /), &2727 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu1_xy(av), & 2728 (/ zu(nzb+1) /), start = (/ 1 /), & 2932 2729 count = (/ 1 /) ) 2933 2730 CALL netcdf_handle_error( 'netcdf_define_header', 126 ) … … 2941 2738 ENDDO 2942 2739 2943 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_x_xy(av), &2944 netcdf_data, start = (/ 1 /), &2740 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_x_xy(av), & 2741 netcdf_data, start = (/ 1 /), & 2945 2742 count = (/ nx+1 /) ) 2946 2743 CALL netcdf_handle_error( 'netcdf_define_header', 127 ) … … 2950 2747 ENDDO 2951 2748 2952 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_xu_xy(av), &2953 netcdf_data, start = (/ 1 /), &2749 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_xu_xy(av), & 2750 netcdf_data, start = (/ 1 /), & 2954 2751 count = (/ nx+1 /) ) 2955 2752 CALL netcdf_handle_error( 'netcdf_define_header', 367 ) … … 2965 2762 ENDDO 2966 2763 2967 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_y_xy(av), &2968 netcdf_data, start = (/ 1 /), &2764 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_y_xy(av), & 2765 netcdf_data, start = (/ 1 /), & 2969 2766 count = (/ ny+1 /)) 2970 2767 CALL netcdf_handle_error( 'netcdf_define_header', 128 ) … … 2974 2771 ENDDO 2975 2772 2976 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_yv_xy(av), &2977 netcdf_data, start = (/ 1 /), &2773 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_yv_xy(av), & 2774 netcdf_data, start = (/ 1 /), & 2978 2775 count = (/ ny+1 /)) 2979 2776 CALL netcdf_handle_error( 'netcdf_define_header', 368 ) … … 3005 2802 3006 2803 DO i = 0, nx 3007 netcdf_data(i) = init_model%origin_x & 3008 + cos_rot_angle * ( i + shift_x ) * dx 2804 netcdf_data(i) = init_model%origin_x + cos_rot_angle * ( i + shift_x ) * dx 3009 2805 ENDDO 3010 2806 3011 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_eutm_xy(k,av), &3012 netcdf_data, start = (/ 1 /), &2807 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_eutm_xy(k,av), & 2808 netcdf_data, start = (/ 1 /), & 3013 2809 count = (/ nx+1 /) ) 3014 2810 CALL netcdf_handle_error( 'netcdf_define_header', 555 ) … … 3035 2831 3036 2832 DO j = 0, ny 3037 netcdf_data(j) = init_model%origin_y & 3038 + cos_rot_angle * ( j + shift_y ) * dy 2833 netcdf_data(j) = init_model%origin_y + cos_rot_angle * ( j + shift_y ) * dy 3039 2834 ENDDO 3040 2835 3041 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_nutm_xy(k,av), &3042 netcdf_data, start = (/ 1 /), &2836 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_nutm_xy(k,av), & 2837 netcdf_data, start = (/ 1 /), & 3043 2838 count = (/ ny+1 /) ) 3044 2839 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) … … 3071 2866 DO j = 0, ny 3072 2867 DO i = 0, nx 3073 netcdf_data_2d(i,j) = init_model%origin_x &3074 + cos_rot_angle * ( i + shift_x ) * dx&3075 + sin_rot_angle * ( j + shift_y ) * dy2868 netcdf_data_2d(i,j) = init_model%origin_x & 2869 + cos_rot_angle * ( i + shift_x ) * dx & 2870 + sin_rot_angle * ( j + shift_y ) * dy 3076 2871 ENDDO 3077 2872 ENDDO 3078 2873 3079 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_eutm_xy(k,av), &3080 netcdf_data_2d, start = (/ 1, 1 /), &2874 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_eutm_xy(k,av), & 2875 netcdf_data_2d, start = (/ 1, 1 /), & 3081 2876 count = (/ nx+1, ny+1 /) ) 3082 2877 CALL netcdf_handle_error( 'netcdf_define_header', 555 ) … … 3084 2879 DO j = 0, ny 3085 2880 DO i = 0, nx 3086 netcdf_data_2d(i,j) = init_model%origin_y &3087 - sin_rot_angle * ( i + shift_x ) * dx&3088 + cos_rot_angle * ( j + shift_y ) * dy2881 netcdf_data_2d(i,j) = init_model%origin_y & 2882 - sin_rot_angle * ( i + shift_x ) * dx & 2883 + cos_rot_angle * ( j + shift_y ) * dy 3089 2884 ENDDO 3090 2885 ENDDO 3091 2886 3092 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_nutm_xy(k,av), &3093 netcdf_data_2d, start = (/ 1, 1 /), &2887 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_nutm_xy(k,av), & 2888 netcdf_data_2d, start = (/ 1, 1 /), & 3094 2889 count = (/ nx+1, ny+1 /) ) 3095 2890 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) … … 3126 2921 DO j = nys, nyn 3127 2922 DO i = nxl, nxr 3128 eutm = init_model%origin_x & 3129 + cos_rot_angle * ( i + shift_x ) * dx & 3130 + sin_rot_angle * ( j + shift_y ) * dy 3131 nutm = init_model%origin_y & 3132 - sin_rot_angle * ( i + shift_x ) * dx & 3133 + cos_rot_angle * ( j + shift_y ) * dy 3134 3135 CALL convert_utm_to_geographic( crs_list, & 3136 eutm, nutm, & 3137 lon(i,j), lat(i,j) ) 2923 eutm = init_model%origin_x & 2924 + cos_rot_angle * ( i + shift_x ) * dx & 2925 + sin_rot_angle * ( j + shift_y ) * dy 2926 nutm = init_model%origin_y & 2927 - sin_rot_angle * ( i + shift_x ) * dx & 2928 + cos_rot_angle * ( j + shift_y ) * dy 2929 2930 CALL convert_utm_to_geographic( crs_list, eutm, nutm, lon(i,j), lat(i,j) ) 3138 2931 ENDDO 3139 2932 ENDDO 3140 2933 3141 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_lon_xy(k,av), &3142 lon, start = (/ nxl+1, nys+1 /),&3143 count = (/ nxr-nxl+1, nyn-nys+1 /) )2934 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_lon_xy(k,av), & 2935 lon, start = (/ nxl+1, nys+1 /), & 2936 count = (/ nxr-nxl+1, nyn-nys+1 /) ) 3144 2937 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) 3145 2938 3146 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_lat_xy(k,av), &3147 lat, start = (/ nxl+1, nys+1 /),&3148 count = (/ nxr-nxl+1, nyn-nys+1 /) )2939 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_lat_xy(k,av), & 2940 lat, start = (/ nxl+1, nys+1 /), & 2941 count = (/ nxr-nxl+1, nyn-nys+1 /) ) 3149 2942 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) 3150 2943 ENDDO … … 3157 2950 !-- In case of non-flat topography write height information. Only for 3158 2951 !-- parallel netcdf output. 3159 IF ( TRIM( topography ) /= 'flat' .AND. & 3160 netcdf_data_format > 4 ) THEN 2952 IF ( TRIM( topography ) /= 'flat' .AND. netcdf_data_format > 4 ) THEN 3161 2953 3162 2954 ! IF ( nxr == nx .AND. nyn /= ny ) THEN 3163 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av), &3164 ! zu_s_inner(nxl:nxr+1,nys:nyn), &3165 ! start = (/ nxl+1, nys+1 /), &2955 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av), & 2956 ! zu_s_inner(nxl:nxr+1,nys:nyn), & 2957 ! start = (/ nxl+1, nys+1 /), & 3166 2958 ! count = (/ nxr-nxl+2, nyn-nys+1 /) ) 3167 2959 ! ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN 3168 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av), &3169 ! zu_s_inner(nxl:nxr,nys:nyn+1), &3170 ! start = (/ nxl+1, nys+1 /), &2960 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av), & 2961 ! zu_s_inner(nxl:nxr,nys:nyn+1), & 2962 ! start = (/ nxl+1, nys+1 /), & 3171 2963 ! count = (/ nxr-nxl+1, nyn-nys+2 /) ) 3172 2964 ! ELSEIF ( nxr == nx .AND. nyn == ny ) THEN 3173 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av), &3174 ! zu_s_inner(nxl:nxr+1,nys:nyn+1), &3175 ! start = (/ nxl+1, nys+1 /), &2965 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av), & 2966 ! zu_s_inner(nxl:nxr+1,nys:nyn+1), & 2967 ! start = (/ nxl+1, nys+1 /), & 3176 2968 ! count = (/ nxr-nxl+2, nyn-nys+2 /) ) 3177 2969 ! ELSE 3178 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av), &3179 zu_s_inner(nxl:nxr,nys:nyn), &3180 start = (/ nxl+1, nys+1 /), &2970 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av), & 2971 zu_s_inner(nxl:nxr,nys:nyn), & 2972 start = (/ nxl+1, nys+1 /), & 3181 2973 count = (/ nxr-nxl+1, nyn-nys+1 /) ) 3182 2974 ! ENDIF … … 3184 2976 3185 2977 ! IF ( nxr == nx .AND. nyn /= ny ) THEN 3186 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av), &3187 ! zw_w_inner(nxl:nxr+1,nys:nyn), &3188 ! start = (/ nxl+1, nys+1 /), &2978 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av), & 2979 ! zw_w_inner(nxl:nxr+1,nys:nyn), & 2980 ! start = (/ nxl+1, nys+1 /), & 3189 2981 ! count = (/ nxr-nxl+2, nyn-nys+1 /) ) 3190 2982 ! ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN 3191 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av), &3192 ! zw_w_inner(nxl:nxr,nys:nyn+1), &3193 ! start = (/ nxl+1, nys+1 /), &2983 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av), & 2984 ! zw_w_inner(nxl:nxr,nys:nyn+1), & 2985 ! start = (/ nxl+1, nys+1 /), & 3194 2986 ! count = (/ nxr-nxl+1, nyn-nys+2 /) ) 3195 2987 ! ELSEIF ( nxr == nx .AND. nyn == ny ) THEN 3196 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av), &3197 ! zw_w_inner(nxl:nxr+1,nys:nyn+1), &3198 ! start = (/ nxl+1, nys+1 /), &2988 ! nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av), & 2989 ! zw_w_inner(nxl:nxr+1,nys:nyn+1), & 2990 ! start = (/ nxl+1, nys+1 /), & 3199 2991 ! count = (/ nxr-nxl+2, nyn-nys+2 /) ) 3200 2992 ! ELSE 3201 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av), &3202 zw_w_inner(nxl:nxr,nys:nyn), &3203 start = (/ nxl+1, nys+1 /), &2993 nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av), & 2994 zw_w_inner(nxl:nxr,nys:nyn), & 2995 start = (/ nxl+1, nys+1 /), & 3204 2996 count = (/ nxr-nxl+1, nyn-nys+1 /) ) 3205 2997 ! ENDIF … … 3212 3004 ! 3213 3005 !-- Get the list of variables and compare with the actual run. 3214 !-- First var_list_old has to be reset, since GET_ATT does not assign 3215 !-- trailing blanks. 3006 !-- First var_list_old has to be reset, since GET_ATT does not assign trailing blanks. 3216 3007 var_list_old = ' ' 3217 nc_stat = NF90_GET_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', & 3218 var_list_old ) 3008 nc_stat = NF90_GET_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', var_list_old ) 3219 3009 CALL netcdf_handle_error( 'netcdf_define_header', 129 ) 3220 3010 3221 3011 var_list = ';' 3222 3012 i = 1 3223 DO WHILE ( do2d(av,i)(1:1) /= ' ' )3013 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) 3224 3014 IF ( INDEX( do2d(av,i), 'xy' ) /= 0 ) THEN 3225 3015 var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';' … … 3235 3025 3236 3026 IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN 3237 message_string = 'netCDF file for cross-sections ' // & 3238 TRIM( var ) // ' from previous run found,' // & 3239 '&but this file cannot be extended due to' // & 3240 ' variable mismatch.' // & 3241 '&New file is created instead.' 3027 message_string = 'netCDF file for cross-sections ' // & 3028 TRIM( var ) // ' from previous run found,' // & 3029 '&but this file cannot be extended due to' // & 3030 ' variable mismatch.' // '&New file is created instead.' 3242 3031 CALL message( 'define_netcdf_header', 'PA0249', 0, 1, 0, 6, 0 ) 3243 3032 extend = .FALSE. … … 3248 3037 !-- Calculate the number of current sections 3249 3038 ns = 1 3250 DO WHILE ( section(ns,1) /= -9999 .AND. ns <= 100 )3039 DO WHILE ( section(ns,1) /= -9999 .AND. ns <= 100 ) 3251 3040 ns = ns + 1 3252 3041 ENDDO … … 3258 3047 CALL netcdf_handle_error( 'netcdf_define_header', 130 ) 3259 3048 3260 nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_zu_xy(av), &3049 nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_zu_xy(av), & 3261 3050 dimids = id_dim_zu_xy_old ) 3262 3051 CALL netcdf_handle_error( 'netcdf_define_header', 131 ) 3263 3052 id_dim_zu_xy(av) = id_dim_zu_xy_old(1) 3264 3053 3265 nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_zu_xy(av), & 3266 len = ns_old ) 3054 nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_zu_xy(av), LEN = ns_old ) 3267 3055 CALL netcdf_handle_error( 'netcdf_define_header', 132 ) 3268 3056 3269 3057 IF ( ns /= ns_old ) THEN 3270 message_string = 'netCDF file for cross-sections ' // & 3271 TRIM( var ) // ' from previous run found,' // & 3272 '&but this file cannot be extended due to' // & 3273 ' mismatch in number of' // & 3274 ' cross sections.' // & 3058 message_string = 'netCDF file for cross-sections ' // & 3059 TRIM( var ) // ' from previous run found,' // & 3060 '&but this file cannot be extended due to' // & 3061 ' mismatch in number of' // ' cross sections.' // & 3275 3062 '&New file is created instead.' 3276 3063 CALL message( 'define_netcdf_header', 'PA0250', 0, 1, 0, 6, 0 ) … … 3289 3076 IF ( section(i,1) /= -1 ) THEN 3290 3077 IF ( zu(section(i,1)) /= netcdf_data(i) ) THEN 3291 message_string = 'netCDF file for cross-sections ' // & 3292 TRIM( var ) // ' from previous run found,' // & 3293 ' but this file cannot be extended' // & 3294 ' due to mismatch in cross' // & 3295 ' section levels.' // & 3296 ' New file is created instead.' 3297 CALL message( 'define_netcdf_header', 'PA0251', & 3298 0, 1, 0, 6, 0 ) 3078 message_string = 'netCDF file for cross-sections ' // & 3079 TRIM( var ) // ' from previous run found,' // & 3080 ' but this file cannot be extended' // & 3081 ' due to mismatch in cross' // ' section levels.' // & 3082 ' New file is created instead.' 3083 CALL message( 'define_netcdf_header', 'PA0251', 0, 1, 0, 6, 0 ) 3299 3084 extend = .FALSE. 3300 3085 RETURN … … 3302 3087 ELSE 3303 3088 IF ( -1.0_wp /= netcdf_data(i) ) THEN 3304 message_string = 'netCDF file for cross-sections ' // & 3305 TRIM( var ) // ' from previous run found,' // & 3306 ' but this file cannot be extended' // & 3307 ' due to mismatch in cross' // & 3308 ' section levels.' // & 3309 ' New file is created instead.' 3310 CALL message( 'define_netcdf_header', 'PA0251', & 3311 0, 1, 0, 6, 0 ) 3089 message_string = 'netCDF file for cross-sections ' // & 3090 TRIM( var ) // ' from previous run found,' // & 3091 ' but this file cannot be extended' // & 3092 ' due to mismatch in cross' // ' section levels.' // & 3093 ' New file is created instead.' 3094 CALL message( 'define_netcdf_header', 'PA0251', 0, 1, 0, 6, 0 ) 3312 3095 extend = .FALSE. 3313 3096 RETURN … … 3319 3102 3320 3103 ! 3321 !-- Get the id of the time coordinate (unlimited coordinate) and its 3322 !-- last index on the file. The next time level is do2d..count+1. 3323 !-- The current time must be larger than the last output time 3324 !-- on the file. 3104 !-- Get the id of the time coordinate (unlimited coordinate) and its last index on the file. 3105 !-- The next time level is do2d..count+1. 3106 !-- The current time must be larger than the last output time on the file. 3325 3107 nc_stat = NF90_INQ_VARID( id_set_xy(av), 'time', id_var_time_xy(av) ) 3326 3108 CALL netcdf_handle_error( 'netcdf_define_header', 134 ) 3327 3109 3328 nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_time_xy(av), &3110 nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_time_xy(av), & 3329 3111 dimids = id_dim_time_old ) 3330 3112 CALL netcdf_handle_error( 'netcdf_define_header', 135 ) 3331 3113 id_dim_time_xy(av) = id_dim_time_old(1) 3332 3114 3333 nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_time_xy(av), & 3334 len = ntime_count ) 3115 nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_time_xy(av), LEN = ntime_count ) 3335 3116 CALL netcdf_handle_error( 'netcdf_define_header', 136 ) 3336 3117 3337 3118 ! 3338 !-- For non-parallel output use the last output time level of the netcdf 3339 !-- file because the time dimension is unlimited. In case of parallel 3340 !-- output the variable ntime_count could get the value of 9*10E36 because 3341 !-- the time dimension is limited. 3119 !-- For non-parallel output use the last output time level of the netcdf file because the time 3120 !-- dimension is unlimited. In case of parallel output the variable ntime_count could get the 3121 !-- value of 9*10E36 because the time dimension is limited. 3342 3122 IF ( netcdf_data_format < 5 ) do2d_xy_time_count(av) = ntime_count 3343 3123 3344 nc_stat = NF90_GET_VAR( id_set_xy(av), id_var_time_xy(av), &3345 last_time_coordinate, &3346 start = (/ do2d_xy_time_count(av) /), &3124 nc_stat = NF90_GET_VAR( id_set_xy(av), id_var_time_xy(av), & 3125 last_time_coordinate, & 3126 start = (/ do2d_xy_time_count(av) /), & 3347 3127 count = (/ 1 /) ) 3348 3128 CALL netcdf_handle_error( 'netcdf_define_header', 137 ) 3349 3129 3350 3130 IF ( last_time_coordinate(1) >= simulated_time ) THEN 3351 message_string = 'netCDF file for cross sections ' // & 3352 TRIM( var ) // ' from previous run found,' // & 3353 '&but this file cannot be extended becaus' // & 3354 'e the current output time' // & 3355 '&is less or equal than the last output t' // & 3356 'ime on this file.' // & 3131 message_string = 'netCDF file for cross sections ' // & 3132 TRIM( var ) // ' from previous run found,' // & 3133 '&but this file cannot be extended because' // & 3134 ' the current output time' // & 3135 '&is less or equal than the last output time' // ' on this file.' // & 3357 3136 '&New file is created instead.' 3358 3137 CALL message( 'define_netcdf_header', 'PA0252', 0, 1, 0, 6, 0 ) … … 3364 3143 IF ( netcdf_data_format > 4 ) THEN 3365 3144 ! 3366 !-- Check if the needed number of output time levels is increased 3367 !-- compared to the number oftime levels in the existing file.3145 !-- Check if the needed number of output time levels is increased compared to the number of 3146 !-- time levels in the existing file. 3368 3147 IF ( ntdim_2d_xy(av) > ntime_count ) THEN 3369 message_string = 'netCDF file for cross sections ' // & 3370 TRIM( var ) // ' from previous run found,' // & 3371 '&but this file cannot be extended becaus' // & 3372 'e the number of output time levels has b' // & 3373 'een increased compared to the previous s' // & 3374 'imulation.' // & 3375 '&New file is created instead.' 3148 message_string = 'netCDF file for cross sections ' // & 3149 TRIM( var ) // ' from previous run found,' // & 3150 '&but this file cannot be extended becaus' // & 3151 'e the number of output time levels has b' // & 3152 'een increased compared to the previous s' // & 3153 'imulation.' // '&New file is created instead.' 3376 3154 CALL message( 'define_netcdf_header', 'PA0389', 0, 1, 0, 6, 0 ) 3377 3155 do2d_xy_time_count(av) = 0 … … 3380 3158 !-- Recalculate the needed time levels for the new file. 3381 3159 IF ( av == 0 ) THEN 3382 ntdim_2d_xy(0) = CEILING( & 3383 ( end_time - MAX( skip_time_do2d_xy, & 3384 simulated_time_at_begin ) & 3385 ) / dt_do2d_xy ) 3160 ntdim_2d_xy(0) = CEILING( ( end_time - MAX( skip_time_do2d_xy, & 3161 simulated_time_at_begin ) & 3162 ) / dt_do2d_xy ) 3386 3163 IF ( do2d_at_begin ) ntdim_2d_xy(0) = ntdim_2d_xy(0) + 1 3387 3164 ELSE 3388 ntdim_2d_xy(1) = CEILING( & 3389 ( end_time - MAX( skip_time_data_output_av, & 3390 simulated_time_at_begin ) & 3391 ) / dt_data_output_av ) 3165 ntdim_2d_xy(1) = CEILING( ( end_time - MAX( skip_time_data_output_av, & 3166 simulated_time_at_begin ) & 3167 ) / dt_data_output_av ) 3392 3168 ENDIF 3393 3169 RETURN … … 3399 3175 !-- Now get the variable ids. 3400 3176 i = 1 3401 DO WHILE ( do2d(av,i)(1:1) /= ' ' )3177 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) 3402 3178 IF ( INDEX( do2d(av,i), 'xy' ) /= 0 ) THEN 3403 nc_stat = NF90_INQ_VARID( id_set_xy(av), do2d(av,i), & 3404 id_var_do2d(av,i) ) 3179 nc_stat = NF90_INQ_VARID( id_set_xy(av), do2d(av,i), id_var_do2d(av,i) ) 3405 3180 CALL netcdf_handle_error( 'netcdf_define_header', 138 ) 3406 3181 #if defined( __netcdf4_parallel ) … … 3408 3183 !-- Set collective io operations for parallel io 3409 3184 IF ( netcdf_data_format > 4 ) THEN 3410 nc_stat = NF90_VAR_PAR_ACCESS( id_set_xy(av), & 3411 id_var_do2d(av,i), & 3185 nc_stat = NF90_VAR_PAR_ACCESS( id_set_xy(av), id_var_do2d(av,i), & 3412 3186 NF90_COLLECTIVE ) 3413 3187 CALL netcdf_handle_error( 'netcdf_define_header', 454 ) … … 3419 3193 3420 3194 ! 3421 !-- Update the title attribute on file 3422 !-- In order to avoid 'data mode' errors if updated attributes are larger 3423 !-- than their original size, NF90_PUT_ATT is called in 'define mode' 3424 !-- enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible 3425 !-- performance loss due to data copying; an alternative strategy would be 3426 !-- to ensure equal attribute size in a job chain. Maybe revise later. 3195 !-- Update the title attribute on file. 3196 !-- In order to avoid 'data mode' errors if updated attributes are larger than their original 3197 !-- size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF 3198 !-- calls. This implies a possible performance loss due to data copying; an alternative 3199 !-- strategy would be to ensure equal attribute size in a job chain. Maybe revise later. 3427 3200 IF ( av == 0 ) THEN 3428 3201 time_average_text = ' ' 3429 3202 ELSE 3430 WRITE (time_average_text, '('', '',F7.1,'' s average'')') & 3431 averaging_interval 3203 WRITE ( time_average_text, '('', '',F7.1,'' s average'')' ) averaging_interval 3432 3204 ENDIF 3433 3205 nc_stat = NF90_REDEF( id_set_xy(av) ) 3434 3206 CALL netcdf_handle_error( 'netcdf_define_header', 431 ) 3435 nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'title', & 3436 TRIM( run_description_header ) // & 3437 TRIM( time_average_text ) ) 3207 nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'title', & 3208 TRIM( run_description_header ) // TRIM( time_average_text ) ) 3438 3209 CALL netcdf_handle_error( 'netcdf_define_header', 139 ) 3439 3210 nc_stat = NF90_ENDDEF( id_set_xy(av) ) 3440 3211 CALL netcdf_handle_error( 'netcdf_define_header', 432 ) 3441 message_string = 'netCDF file for cross-sections ' // &3442 TRIM( var ) // ' from previous run found.' // &3212 message_string = 'netCDF file for cross-sections ' // & 3213 TRIM( var ) // ' from previous run found.' // & 3443 3214 '&This file will be extended.' 3444 3215 CALL message( 'define_netcdf_header', 'PA0253', 0, 0, 0, 6, 0 ) … … 3450 3221 !-- Define some global attributes of the dataset 3451 3222 IF ( av == 0 ) THEN 3452 CALL netcdf_create_global_atts( id_set_xz(av), 'xz', TRIM( run_description_header ), 140 ) 3223 CALL netcdf_create_global_atts( id_set_xz(av), 'xz', TRIM( run_description_header ), & 3224 140 ) 3453 3225 time_average_text = ' ' 3454 3226 ELSE 3455 CALL netcdf_create_global_atts( id_set_xz(av), 'xz_av', TRIM( run_description_header ), 140 ) 3227 CALL netcdf_create_global_atts( id_set_xz(av), 'xz_av', & 3228 TRIM( run_description_header ), 140 ) 3456 3229 WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval 3457 nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'time_avg', &3230 nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'time_avg', & 3458 3231 TRIM( time_average_text ) ) 3459 3232 CALL netcdf_handle_error( 'netcdf_define_header', 141 ) … … 3462 3235 ! 3463 3236 !-- Define time coordinate for xz sections. 3464 !-- For parallel output the time dimensions has to be limited, otherwise 3465 !-- the performance dropssignificantly.3237 !-- For parallel output the time dimensions has to be limited, otherwise the performance drops 3238 !-- significantly. 3466 3239 IF ( netcdf_data_format < 5 ) THEN 3467 CALL netcdf_create_dim( id_set_xz(av), 'time', NF90_UNLIMITED, &3468 id_dim_time_xz(av),142 )3240 CALL netcdf_create_dim( id_set_xz(av), 'time', NF90_UNLIMITED, id_dim_time_xz(av), & 3241 142 ) 3469 3242 ELSE 3470 CALL netcdf_create_dim( id_set_xz(av), 'time', ntdim_2d_xz(av), & 3471 id_dim_time_xz(av), 525 ) 3472 ENDIF 3473 3474 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_time_xz(av) /), & 3475 'time', NF90_DOUBLE, id_var_time_xz(av), & 3476 'seconds', 'time', 143, 144, 000 ) 3243 CALL netcdf_create_dim( id_set_xz(av), 'time', ntdim_2d_xz(av), id_dim_time_xz(av), & 3244 525 ) 3245 ENDIF 3246 3247 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_time_xz(av) /), 'time', NF90_DOUBLE, & 3248 id_var_time_xz(av), 'seconds', 'time', 143, 144, 000 ) 3477 3249 CALL netcdf_create_att( id_set_xz(av), id_var_time_xz(av), 'standard_name', 'time', 000) 3478 3250 CALL netcdf_create_att( id_set_xz(av), id_var_time_xz(av), 'axis', 'T', 000) … … 3492 3264 ! 3493 3265 !-- Define y-axis (for scalar position) 3494 CALL netcdf_create_dim( id_set_xz(av), 'y_xz', ns, id_dim_y_xz(av), & 3495 145 ) 3496 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_y_xz(av) /), & 3497 'y_xz', NF90_DOUBLE, id_var_y_xz(av), & 3498 'meters', '', 146, 147, 000 ) 3499 CALL netcdf_create_att( id_set_xz(av), id_var_y_xz(av), 'axis', & 3500 'Y', 000) 3266 CALL netcdf_create_dim( id_set_xz(av), 'y_xz', ns, id_dim_y_xz(av), 145 ) 3267 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_y_xz(av) /), 'y_xz', NF90_DOUBLE, & 3268 id_var_y_xz(av), 'meters', '', 146, 147, 000 ) 3269 CALL netcdf_create_att( id_set_xz(av), id_var_y_xz(av), 'axis', 'Y', 000) 3501 3270 ! 3502 3271 !-- Define y-axis (for v position) 3503 CALL netcdf_create_dim( id_set_xz(av), 'yv_xz', ns, & 3504 id_dim_yv_xz(av), 369 ) 3505 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_yv_xz(av) /), & 3506 'yv_xz', NF90_DOUBLE, id_var_yv_xz(av), & 3507 'meters', '', 370, 371, 000 ) 3508 CALL netcdf_create_att( id_set_xz(av), id_var_yv_xz(av), 'axis', & 3509 'Y', 000) 3510 ! 3511 !-- Define a variable to store the layer indices of the vertical cross 3512 !-- sections 3513 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_y_xz(av) /), & 3514 'ind_y_xz', NF90_DOUBLE, & 3515 id_var_ind_y_xz(av), 'gridpoints', '', 148, & 3516 149, 000 ) 3272 CALL netcdf_create_dim( id_set_xz(av), 'yv_xz', ns, id_dim_yv_xz(av), 369 ) 3273 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_yv_xz(av) /), 'yv_xz', NF90_DOUBLE, & 3274 id_var_yv_xz(av), 'meters', '', 370, 371, 000 ) 3275 CALL netcdf_create_att( id_set_xz(av), id_var_yv_xz(av), 'axis', 'Y', 000) 3276 ! 3277 !-- Define a variable to store the layer indices of the vertical cross sections 3278 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_y_xz(av) /), 'ind_y_xz', NF90_DOUBLE, & 3279 id_var_ind_y_xz(av), 'gridpoints', '', 148, 149, 000 ) 3517 3280 ! 3518 3281 !-- Define x-axis (for scalar position) 3519 CALL netcdf_create_dim( id_set_xz(av), 'x', nx+1, id_dim_x_xz(av), & 3520 150 ) 3521 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_x_xz(av) /), 'x', & 3522 NF90_DOUBLE, id_var_x_xz(av), 'meters', '', & 3523 151, 152, 000 ) 3524 CALL netcdf_create_att( id_set_xz(av), id_var_x_xz(av), 'axis', & 3525 'X', 000) 3282 CALL netcdf_create_dim( id_set_xz(av), 'x', nx+1, id_dim_x_xz(av), 150 ) 3283 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_x_xz(av) /), 'x', NF90_DOUBLE, & 3284 id_var_x_xz(av), 'meters', '', 151, 152, 000 ) 3285 CALL netcdf_create_att( id_set_xz(av), id_var_x_xz(av), 'axis', 'X', 000) 3526 3286 ! 3527 3287 !-- Define x-axis (for u position) 3528 CALL netcdf_create_dim( id_set_xz(av), 'xu', nx+1, id_dim_xu_xz(av), & 3529 372 ) 3530 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_xu_xz(av) /), 'xu', & 3531 NF90_DOUBLE, id_var_xu_xz(av), 'meters', '', & 3532 373, 374, 000 ) 3533 CALL netcdf_create_att( id_set_xz(av), id_var_xu_xz(av), 'axis', & 3534 'X', 000) 3535 3288 CALL netcdf_create_dim( id_set_xz(av), 'xu', nx+1, id_dim_xu_xz(av), 372 ) 3289 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_xu_xz(av) /), 'xu', NF90_DOUBLE, & 3290 id_var_xu_xz(av), 'meters', '', 373, 374, 000 ) 3291 CALL netcdf_create_att( id_set_xz(av), id_var_xu_xz(av), 'axis', 'X', 000) 3292 3536 3293 ! 3537 3294 !-- Define the three z-axes (zu, zw, and zs) 3538 CALL netcdf_create_dim( id_set_xz(av), 'zu', nz+2, id_dim_zu_xz(av), & 3539 153 ) 3540 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zu_xz(av) /), 'zu', & 3541 NF90_DOUBLE, id_var_zu_xz(av), 'meters', '', & 3542 154, 155, 000 ) 3543 CALL netcdf_create_att( id_set_xz(av), id_var_zu_xz(av), 'axis', & 3544 'Z', 000) 3545 3546 CALL netcdf_create_dim( id_set_xz(av), 'zw', nz+2, id_dim_zw_xz(av), & 3547 156 ) 3548 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zw_xz(av) /), 'zw', & 3549 NF90_DOUBLE, id_var_zw_xz(av), 'meters', '', & 3550 157, 158, 000 ) 3551 CALL netcdf_create_att( id_set_xz(av), id_var_zw_xz(av), 'axis', & 3552 'Z', 000) 3295 CALL netcdf_create_dim( id_set_xz(av), 'zu', nz+2, id_dim_zu_xz(av), 153 ) 3296 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zu_xz(av) /), 'zu', NF90_DOUBLE, & 3297 id_var_zu_xz(av), 'meters', '', 154, 155, 000 ) 3298 CALL netcdf_create_att( id_set_xz(av), id_var_zu_xz(av), 'axis', 'Z', 000) 3299 3300 CALL netcdf_create_dim( id_set_xz(av), 'zw', nz+2, id_dim_zw_xz(av), 156 ) 3301 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zw_xz(av) /), 'zw', NF90_DOUBLE, & 3302 id_var_zw_xz(av), 'meters', '', 157, 158, 000 ) 3303 CALL netcdf_create_att( id_set_xz(av), id_var_zw_xz(av), 'axis', 'Z', 000) 3553 3304 ! 3554 3305 !-- Define UTM and geographic coordinates 3555 CALL define_geo_coordinates( id_set_xz(av), &3556 (/ id_dim_x_xz(av), id_dim_xu_xz(av) /),&3557 (/ id_dim_y_xz(av), id_dim_yv_xz(av) /),&3558 id_var_eutm_xz(:,av), id_var_nutm_xz(:,av),&3559 id_var_lat_xz(:,av), id_var_lon_xz(:,av) )3306 CALL define_geo_coordinates( id_set_xz(av), & 3307 (/ id_dim_x_xz(av), id_dim_xu_xz(av) /), & 3308 (/ id_dim_y_xz(av), id_dim_yv_xz(av) /), & 3309 id_var_eutm_xz(:,av), id_var_nutm_xz(:,av), & 3310 id_var_lat_xz(:,av), id_var_lon_xz(:,av) ) 3560 3311 ! 3561 3312 !-- Define coordinate-reference system … … 3564 3315 IF ( land_surface ) THEN 3565 3316 3566 CALL netcdf_create_dim( id_set_xz(av), 'zs', nzs, & 3567 id_dim_zs_xz(av), 542 ) 3568 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zs_xz(av) /), & 3569 'zs', NF90_DOUBLE, id_var_zs_xz(av), & 3570 'meters', '', 543, 544, 000 ) 3571 CALL netcdf_create_att( id_set_xz(av), id_var_zs_xz(av), 'axis', & 3572 'Z', 000) 3317 CALL netcdf_create_dim( id_set_xz(av), 'zs', nzs, id_dim_zs_xz(av), 542 ) 3318 CALL netcdf_create_var( id_set_xz(av), (/ id_dim_zs_xz(av) /), 'zs', NF90_DOUBLE, & 3319 id_var_zs_xz(av), 'meters', '', 543, 544, 000 ) 3320 CALL netcdf_create_att( id_set_xz(av), id_var_zs_xz(av), 'axis', 'Z', 000) 3573 3321 3574 3322 ENDIF … … 3625 3373 !-- Check for land surface quantities 3626 3374 IF ( land_surface ) THEN 3627 CALL lsm_define_netcdf_grid( do2d(av,i), found, & 3628 grid_x, grid_y, grid_z ) 3375 CALL lsm_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 3629 3376 ENDIF 3630 3377 3631 3378 IF ( .NOT. found ) THEN 3632 CALL tcm_define_netcdf_grid( do2d(av,i), found, & 3633 grid_x, grid_y, grid_z ) 3379 CALL tcm_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 3634 3380 ENDIF 3635 3381 … … 3637 3383 !-- Check for ocean quantities 3638 3384 IF ( .NOT. found .AND. ocean_mode ) THEN 3639 CALL ocean_define_netcdf_grid( do2d(av,i), found, & 3640 grid_x, grid_y, grid_z ) 3385 CALL ocean_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 3641 3386 ENDIF 3642 3387 ! 3643 3388 !-- Check for radiation quantities 3644 3389 IF ( .NOT. found .AND. radiation ) THEN 3645 CALL radiation_define_netcdf_grid( do2d(av,i), found, & 3646 grid_x, grid_y, & 3390 CALL radiation_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, & 3647 3391 grid_z ) 3648 3392 ENDIF … … 3650 3394 !-- Check for SALSA quantities 3651 3395 IF ( .NOT. found .AND. salsa ) THEN 3652 CALL salsa_define_netcdf_grid( do2d(av,i), found, & 3653 grid_x, grid_y, grid_z ) 3396 CALL salsa_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 3654 3397 ENDIF 3655 3398 … … 3657 3400 !-- Check for gust module quantities 3658 3401 IF ( .NOT. found .AND. gust_module_enabled ) THEN 3659 CALL gust_define_netcdf_grid( do2d(av,i), found, & 3660 grid_x, grid_y, grid_z ) 3402 CALL gust_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 3661 3403 ENDIF 3662 3404 … … 3664 3406 !-- Check for chemistry quantities 3665 3407 IF ( .NOT. found .AND. air_chemistry ) THEN 3666 CALL chem_define_netcdf_grid( do2d(av,i), found, & 3667 grid_x, grid_y, & 3668 grid_z ) 3408 CALL chem_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 3669 3409 ENDIF 3670 3410 3671 IF ( .NOT. found ) & 3672 CALL doq_define_netcdf_grid( do2d(av,i), found, & 3673 grid_x, grid_y, grid_z ) 3411 IF ( .NOT. found ) & 3412 CALL doq_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 3674 3413 3675 3414 ! 3676 3415 !-- Check for user-defined quantities 3677 3416 IF ( .NOT. found .AND. user_module_enabled ) THEN 3678 CALL user_define_netcdf_grid( do2d(av,i), found, & 3679 grid_x, grid_y, grid_z ) 3417 CALL user_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 3680 3418 ENDIF 3681 3419 3682 3420 IF ( .NOT. found ) THEN 3683 WRITE ( message_string, * ) 'no grid defined for', & 3684 ' variable ', TRIM( do2d(av,i) ) 3685 CALL message( 'define_netcdf_header', 'PA0244', & 3686 0, 1, 0, 6, 0 ) 3421 WRITE ( message_string, * ) 'no grid defined for', ' variable ', & 3422 TRIM( do2d(av,i) ) 3423 CALL message( 'define_netcdf_header', 'PA0244', 0, 1, 0, 6, 0 ) 3687 3424 ENDIF 3688 3425 … … 3713 3450 ! 3714 3451 !-- Define the grid 3715 CALL netcdf_create_var( id_set_xz(av), (/ id_x, id_y, id_z, & 3716 id_dim_time_xz(av) /), do2d(av,i), & 3717 nc_precision(2), id_var_do2d(av,i), & 3718 TRIM( do2d_unit(av,i) ), do2d(av,i), & 3719 159, 160, 355, .TRUE. ) 3452 CALL netcdf_create_var( id_set_xz(av), (/ id_x, id_y, id_z, id_dim_time_xz(av) /), & 3453 do2d(av,i), nc_precision(2), id_var_do2d(av,i), & 3454 TRIM( do2d_unit(av,i) ), do2d(av,i), 159, 160, 355, .TRUE. ) 3720 3455 3721 3456 #if defined( __netcdf4_parallel ) … … 3729 3464 CALL netcdf_handle_error( 'netcdf_define_header', 534 ) 3730 3465 ! 3731 !-- Set independent io operations for parallel io. Collective io 3732 !-- is only allowed in case of a 1d-decomposition along x,3733 !-- because otherwise, not all PEs have outputdata.3466 !-- Set independent io operations for parallel io. Collective io is only allowed in 3467 !-- case of a 1d-decomposition along x, because otherwise, not all PEs have output 3468 !-- data. 3734 3469 IF ( npey == 1 ) THEN 3735 nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av), &3736 id_var_do2d(av,i), &3470 nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av), & 3471 id_var_do2d(av,i), & 3737 3472 NF90_COLLECTIVE ) 3738 3473 ELSE 3739 3474 ! 3740 !-- Test simulations showed that the output of cross sections 3741 !-- by all PEs in data_output_2d using NF90_COLLECTIVE is 3742 !-- faster than the output by the first row of PEs in 3743 !-- x-direction using NF90_INDEPENDENT. 3744 nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av), & 3745 id_var_do2d(av,i), & 3746 NF90_COLLECTIVE ) 3747 ! nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av), & 3748 ! id_var_do2d(av,i), & 3475 !-- Test simulations showed that the output of cross sections by all PEs in 3476 !-- data_output_2d using NF90_COLLECTIVE is faster than the output by the first 3477 !-- row of PEs in x-direction using NF90_INDEPENDENT. 3478 nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av), & 3479 id_var_do2d(av,i), & 3480 NF90_COLLECTIVE ) 3481 ! nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av), & 3482 ! id_var_do2d(av,i), & 3749 3483 ! NF90_INDEPENDENT ) 3750 3484 ENDIF … … 3765 3499 3766 3500 ! 3767 !-- Write the list of variables as global attribute (this is used by 3768 !-- restart runs and by combine_plot_fields) 3769 nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', & 3770 var_list ) 3501 !-- Write the list of variables as global attribute (this is used by restart runs and by 3502 !-- combine_plot_fields) 3503 nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', var_list ) 3771 3504 CALL netcdf_handle_error( 'netcdf_define_header', 161 ) 3772 3505 3773 3506 ! 3774 !-- Set general no fill, otherwise the performance drops significantly for 3775 !-- parallel output. 3507 !-- Set general no fill, otherwise the performance drops significantly for parallel output. 3776 3508 nc_stat = NF90_SET_FILL( id_set_xz(av), NF90_NOFILL, oldmode ) 3777 3509 CALL netcdf_handle_error( 'netcdf_define_header', 530 ) … … 3783 3515 3784 3516 ! 3785 !-- These data are only written by PE0 for parallel output to increase 3786 !-- the performance. 3517 !-- These data are only written by PE0 for parallel output to increase the performance. 3787 3518 IF ( myid == 0 .OR. netcdf_data_format < 5 ) THEN 3788 3519 … … 3800 3531 ENDIF 3801 3532 ENDDO 3802 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_y_xz(av), &3803 netcdf_data, start = (/ 1 /), &3533 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_y_xz(av), & 3534 netcdf_data, start = (/ 1 /), & 3804 3535 count = (/ ns /) ) 3805 3536 CALL netcdf_handle_error( 'netcdf_define_header', 163 ) … … 3814 3545 ENDIF 3815 3546 ENDDO 3816 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_yv_xz(av), &3817 netcdf_data, start = (/ 1 /), &3547 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_yv_xz(av), & 3548 netcdf_data, start = (/ 1 /), & 3818 3549 count = (/ ns /) ) 3819 3550 CALL netcdf_handle_error( 'netcdf_define_header', 375 ) … … 3822 3553 !-- Write gridpoint number data 3823 3554 netcdf_data(1:ns) = section(1:ns,2) 3824 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_ind_y_xz(av), &3825 netcdf_data, start = (/ 1 /), &3555 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_ind_y_xz(av), & 3556 netcdf_data, start = (/ 1 /), & 3826 3557 count = (/ ns /) ) 3827 3558 CALL netcdf_handle_error( 'netcdf_define_header', 164 ) … … 3838 3569 ENDDO 3839 3570 3840 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_x_xz(av), &3841 netcdf_data, start = (/ 1 /), &3571 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_x_xz(av), & 3572 netcdf_data, start = (/ 1 /), & 3842 3573 count = (/ nx+1 /) ) 3843 3574 CALL netcdf_handle_error( 'netcdf_define_header', 165 ) … … 3847 3578 ENDDO 3848 3579 3849 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_xu_xz(av), &3850 netcdf_data, start = (/ 1 /), &3580 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_xu_xz(av), & 3581 netcdf_data, start = (/ 1 /), & 3851 3582 count = (/ nx+1 /) ) 3852 3583 CALL netcdf_handle_error( 'netcdf_define_header', 377 ) … … 3859 3590 3860 3591 netcdf_data(0:nz+1) = zu(nzb:nzt+1) 3861 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zu_xz(av), &3862 netcdf_data, start = (/ 1 /), &3592 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zu_xz(av), & 3593 netcdf_data, start = (/ 1 /), & 3863 3594 count = (/ nz+2 /) ) 3864 3595 CALL netcdf_handle_error( 'netcdf_define_header', 166 ) 3865 3596 3866 3597 netcdf_data(0:nz+1) = zw(nzb:nzt+1) 3867 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zw_xz(av), &3868 netcdf_data, start = (/ 1 /), &3598 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zw_xz(av), & 3599 netcdf_data, start = (/ 1 /), & 3869 3600 count = (/ nz+2 /) ) 3870 3601 CALL netcdf_handle_error( 'netcdf_define_header', 167 ) … … 3874 3605 IF ( land_surface ) THEN 3875 3606 netcdf_data(0:nzs-1) = - zs(nzb_soil:nzt_soil) 3876 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zs_xz(av), &3877 netcdf_data(0:nzs), start = (/ 1 /), &3607 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zs_xz(av), & 3608 netcdf_data(0:nzs), start = (/ 1 /), & 3878 3609 count = (/ nzt_soil-nzb_soil+1 /) ) 3879 3610 CALL netcdf_handle_error( 'netcdf_define_header', 548 ) … … 3906 3637 3907 3638 DO i = 0, nx 3908 netcdf_data(i) = init_model%origin_x & 3909 + cos_rot_angle * ( i + shift_x ) * dx 3639 netcdf_data(i) = init_model%origin_x + cos_rot_angle * ( i + shift_x ) * dx 3910 3640 ENDDO 3911 3641 3912 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_eutm_xz(k,av), &3913 netcdf_data, start = (/ 1 /), &3642 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_eutm_xz(k,av), & 3643 netcdf_data, start = (/ 1 /), & 3914 3644 count = (/ nx+1 /) ) 3915 3645 CALL netcdf_handle_error( 'netcdf_define_header', 555 ) … … 3939 3669 netcdf_data(i) = -1.0_wp ! section averaged along y 3940 3670 ELSE 3941 netcdf_data(i) = init_model%origin_y &3942 + cos_rot_angle * ( section(i,2) + shift_y ) * dy3671 netcdf_data(i) = init_model%origin_y & 3672 + cos_rot_angle * ( section(i,2) + shift_y ) * dy 3943 3673 ENDIF 3944 3674 ENDDO 3945 3675 3946 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_nutm_xz(k,av), &3947 netcdf_data, start = (/ 1 /), &3676 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_nutm_xz(k,av), & 3677 netcdf_data, start = (/ 1 /), & 3948 3678 count = (/ ns /) ) 3949 3679 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) … … 3979 3709 ELSE 3980 3710 DO i = 0, nx 3981 netcdf_data_2d(i,j) = init_model%origin_x &3982 + cos_rot_angle * ( i + shift_x ) * dx&3983 + sin_rot_angle * ( section(j,2) + shift_y ) * dy3711 netcdf_data_2d(i,j) = init_model%origin_x & 3712 + cos_rot_angle * ( i + shift_x ) * dx & 3713 + sin_rot_angle * ( section(j,2) + shift_y ) * dy 3984 3714 ENDDO 3985 3715 ENDIF 3986 3716 ENDDO 3987 3717 3988 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_eutm_xz(k,av), &3989 netcdf_data_2d, start = (/ 1, 1 /), &3718 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_eutm_xz(k,av), & 3719 netcdf_data_2d, start = (/ 1, 1 /), & 3990 3720 count = (/ nx+1, ns /) ) 3991 3721 CALL netcdf_handle_error( 'netcdf_define_header', 555 ) … … 3996 3726 ELSE 3997 3727 DO i = 0, nx 3998 netcdf_data_2d(i,j) = init_model%origin_y &3999 - sin_rot_angle * ( i + shift_x ) * dx&4000 + cos_rot_angle * ( section(j,2) + shift_y ) * dy3728 netcdf_data_2d(i,j) = init_model%origin_y & 3729 - sin_rot_angle * ( i + shift_x ) * dx & 3730 + cos_rot_angle * ( section(j,2) + shift_y ) * dy 4001 3731 ENDDO 4002 3732 ENDIF 4003 3733 ENDDO 4004 3734 4005 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_nutm_xz(k,av), &4006 netcdf_data_2d, start = (/ 1, 1 /), &3735 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_nutm_xz(k,av), & 3736 netcdf_data_2d, start = (/ 1, 1 /), & 4007 3737 count = (/ nx+1, ns /) ) 4008 3738 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) … … 4039 3769 ELSE 4040 3770 DO i = 0, nx 4041 eutm = init_model%origin_x & 4042 + cos_rot_angle * ( i + shift_x ) * dx & 4043 + sin_rot_angle * ( section(j,2) + shift_y ) * dy 4044 nutm = init_model%origin_y & 4045 - sin_rot_angle * ( i + shift_x ) * dx & 4046 + cos_rot_angle * ( section(j,2) + shift_y ) * dy 4047 4048 CALL convert_utm_to_geographic( crs_list, & 4049 eutm, nutm, & 4050 lon(i,j), lat(i,j) ) 3771 eutm = init_model%origin_x & 3772 + cos_rot_angle * ( i + shift_x ) * dx & 3773 + sin_rot_angle * ( section(j,2) + shift_y ) * dy 3774 nutm = init_model%origin_y & 3775 - sin_rot_angle * ( i + shift_x ) * dx & 3776 + cos_rot_angle * ( section(j,2) + shift_y ) * dy 3777 3778 CALL convert_utm_to_geographic( crs_list, eutm, nutm, lon(i,j), lat(i,j) ) 4051 3779 ENDDO 4052 3780 ENDIF 4053 3781 ENDDO 4054 3782 4055 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_lon_xz(k,av), &4056 lon, start = (/ 1, 1 /),&4057 count = (/ nx+1, ns /) )3783 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_lon_xz(k,av), & 3784 lon, start = (/ 1, 1 /), & 3785 count = (/ nx+1, ns /) ) 4058 3786 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) 4059 3787 4060 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_lat_xz(k,av), &4061 lat, start = (/ 1, 1 /),&4062 count = (/ nx+1, ns /) )3788 nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_lat_xz(k,av), & 3789 lat, start = (/ 1, 1 /), & 3790 count = (/ nx+1, ns /) ) 4063 3791 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) 4064 3792 ENDDO … … 4074 3802 ! 4075 3803 !-- Get the list of variables and compare with the actual run. 4076 !-- First var_list_old has to be reset, since GET_ATT does not assign 4077 !-- trailing blanks. 3804 !-- First var_list_old has to be reset, since GET_ATT does not assign trailing blanks. 4078 3805 var_list_old = ' ' 4079 nc_stat = NF90_GET_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', & 4080 var_list_old ) 3806 nc_stat = NF90_GET_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', var_list_old ) 4081 3807 CALL netcdf_handle_error( 'netcdf_define_header', 168 ) 4082 3808 … … 4097 3823 4098 3824 IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN 4099 message_string = 'netCDF file for cross-sections ' // & 4100 TRIM( var ) // ' from previous run found,' // & 4101 '&but this file cannot be extended due to' // & 4102 ' variable mismatch.' // & 4103 '&New file is created instead.' 3825 message_string = 'netCDF file for cross-sections ' // TRIM( var ) // & 3826 ' from previous run found,' // & 3827 '&but this file cannot be extended due to' // & 3828 ' variable mismatch.' // '&New file is created instead.' 4104 3829 CALL message( 'define_netcdf_header', 'PA0249', 0, 1, 0, 6, 0 ) 4105 3830 extend = .FALSE. … … 4120 3845 CALL netcdf_handle_error( 'netcdf_define_header', 169 ) 4121 3846 4122 nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_y_xz(av), &3847 nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_y_xz(av), & 4123 3848 dimids = id_dim_y_xz_old ) 4124 3849 CALL netcdf_handle_error( 'netcdf_define_header', 170 ) 4125 3850 id_dim_y_xz(av) = id_dim_y_xz_old(1) 4126 3851 4127 nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_y_xz(av), & 4128 len = ns_old ) 3852 nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_y_xz(av), LEN = ns_old ) 4129 3853 CALL netcdf_handle_error( 'netcdf_define_header', 171 ) 4130 3854 4131 3855 IF ( ns /= ns_old ) THEN 4132 message_string = 'netCDF file for cross-sections ' // & 4133 TRIM( var ) // ' from previous run found,' // & 4134 '&but this file cannot be extended due to' // & 4135 ' mismatch in number of' // & 4136 ' cross sections.' // & 3856 message_string = 'netCDF file for cross-sections ' // TRIM( var ) // & 3857 ' from previous run found,' // & 3858 '&but this file cannot be extended due to' // & 3859 ' mismatch in number of' // ' cross sections.' // & 4137 3860 '&New file is created instead.' 4138 3861 CALL message( 'define_netcdf_header', 'PA0250', 0, 1, 0, 6, 0 ) … … 4151 3874 IF ( section(i,2) /= -1 ) THEN 4152 3875 IF ( ( ( section(i,2) + 0.5 ) * dy ) /= netcdf_data(i) ) THEN 4153 message_string = 'netCDF file for cross-sections ' // & 4154 TRIM( var ) // ' from previous run found,' // & 4155 ' but this file cannot be extended' // & 4156 ' due to mismatch in cross' // & 4157 ' section levels.' // & 4158 ' New file is created instead.' 4159 CALL message( 'define_netcdf_header', 'PA0251', & 4160 0, 1, 0, 6, 0 ) 3876 message_string = 'netCDF file for cross-sections ' // TRIM( var ) // & 3877 ' from previous run found,' // & 3878 ' but this file cannot be extended' // & 3879 ' due to mismatch in cross' // ' section levels.' // & 3880 ' New file is created instead.' 3881 CALL message( 'define_netcdf_header', 'PA0251', 0, 1, 0, 6, 0 ) 4161 3882 extend = .FALSE. 4162 3883 RETURN … … 4164 3885 ELSE 4165 3886 IF ( -1.0_wp /= netcdf_data(i) ) THEN 4166 message_string = 'netCDF file for cross-sections ' // & 4167 TRIM( var ) // ' from previous run found,' // & 4168 ' but this file cannot be extended' // & 4169 ' due to mismatch in cross' // & 4170 ' section levels.' // & 4171 ' New file is created instead.' 4172 CALL message( 'define_netcdf_header', 'PA0251', & 4173 0, 1, 0, 6, 0 ) 3887 message_string = 'netCDF file for cross-sections ' // TRIM( var ) // & 3888 ' from previous run found,' // & 3889 ' but this file cannot be extended' // & 3890 ' due to mismatch in cross' // ' section levels.' // & 3891 ' New file is created instead.' 3892 CALL message( 'define_netcdf_header', 'PA0251', 0, 1, 0, 6, 0 ) 4174 3893 extend = .FALSE. 4175 3894 RETURN … … 4181 3900 4182 3901 ! 4183 !-- Get the id of the time coordinate (unlimited coordinate) and its 4184 !-- last index on the file. The next time level is do2d..count+1. 4185 !-- The current time must be larger than the last output time 4186 !-- on the file. 3902 !-- Get the id of the time coordinate (unlimited coordinate) and its last index on the file. 3903 !-- The next time level is do2d..count+1. 3904 !-- The current time must be larger than the last output time on the file. 4187 3905 nc_stat = NF90_INQ_VARID( id_set_xz(av), 'time', id_var_time_xz(av) ) 4188 3906 CALL netcdf_handle_error( 'netcdf_define_header', 173 ) 4189 3907 4190 nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_time_xz(av), &3908 nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_time_xz(av), & 4191 3909 dimids = id_dim_time_old ) 4192 3910 CALL netcdf_handle_error( 'netcdf_define_header', 174 ) 4193 3911 id_dim_time_xz(av) = id_dim_time_old(1) 4194 3912 4195 nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_time_xz(av), & 4196 len = ntime_count ) 3913 nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_time_xz(av), LEN = ntime_count ) 4197 3914 CALL netcdf_handle_error( 'netcdf_define_header', 175 ) 4198 3915 4199 3916 ! 4200 !-- For non-parallel output use the last output time level of the netcdf 4201 !-- file because the time dimension is unlimited. In case of parallel 4202 !-- output the variable ntime_count could get the value of 9*10E36 because 4203 !-- the time dimension is limited. 3917 !-- For non-parallel output use the last output time level of the netcdf file because the time 3918 !-- dimension is unlimited. In case of parallel output the variable ntime_count could get the 3919 !-- value of 9*10E36 because the time dimension is limited. 4204 3920 IF ( netcdf_data_format < 5 ) do2d_xz_time_count(av) = ntime_count 4205 3921 4206 nc_stat = NF90_GET_VAR( id_set_xz(av), id_var_time_xz(av), &4207 last_time_coordinate, &4208 start = (/ do2d_xz_time_count(av) /), &3922 nc_stat = NF90_GET_VAR( id_set_xz(av), id_var_time_xz(av), & 3923 last_time_coordinate, & 3924 start = (/ do2d_xz_time_count(av) /), & 4209 3925 count = (/ 1 /) ) 4210 3926 CALL netcdf_handle_error( 'netcdf_define_header', 176 ) 4211 3927 4212 3928 IF ( last_time_coordinate(1) >= simulated_time ) THEN 4213 message_string = 'netCDF file for cross sections ' // & 4214 TRIM( var ) // ' from previous run found,' // & 4215 '&but this file cannot be extended becaus' // & 4216 'e the current output time' // & 4217 '&is less or equal than the last output t' // & 4218 'ime on this file.' // & 3929 message_string = 'netCDF file for cross sections ' // TRIM( var ) // & 3930 ' from previous run found,' // & 3931 '&but this file cannot be extended because' // & 3932 ' the current output time' // & 3933 '&is less or equal than the last output time' // ' on this file.' // & 4219 3934 '&New file is created instead.' 4220 3935 CALL message( 'define_netcdf_header', 'PA0252', 0, 1, 0, 6, 0 ) … … 4226 3941 IF ( netcdf_data_format > 4 ) THEN 4227 3942 ! 4228 !-- Check if the needed number of output time levels is increased 4229 !-- compared to the number oftime levels in the existing file.3943 !-- Check if the needed number of output time levels is increased compared to the number of 3944 !-- time levels in the existing file. 4230 3945 IF ( ntdim_2d_xz(av) > ntime_count ) THEN 4231 message_string = 'netCDF file for cross sections ' // & 4232 TRIM( var ) // ' from previous run found,' // & 4233 '&but this file cannot be extended becaus' // & 4234 'e the number of output time levels has b' // & 4235 'een increased compared to the previous s' // & 4236 'imulation.' // & 3946 message_string = 'netCDF file for cross sections ' // TRIM( var ) // & 3947 ' from previous run found,' // & 3948 '&but this file cannot be extended becaus' // & 3949 'e the number of output time levels has b' // & 3950 'een increased compared to the previous s' // 'imulation.' // & 4237 3951 '&New file is created instead.' 4238 3952 CALL message( 'define_netcdf_header', 'PA0390', 0, 1, 0, 6, 0 ) … … 4242 3956 !-- Recalculate the needed time levels for the new file. 4243 3957 IF ( av == 0 ) THEN 4244 ntdim_2d_xz(0) = CEILING( & 4245 ( end_time - MAX( skip_time_do2d_xz, & 4246 simulated_time_at_begin ) & 4247 ) / dt_do2d_xz ) 3958 ntdim_2d_xz(0) = CEILING( ( end_time - MAX( skip_time_do2d_xz, & 3959 simulated_time_at_begin ) & 3960 ) / dt_do2d_xz ) 4248 3961 IF ( do2d_at_begin ) ntdim_2d_xz(0) = ntdim_2d_xz(0) + 1 4249 3962 ELSE 4250 ntdim_2d_xz(1) = CEILING( & 4251 ( end_time - MAX( skip_time_data_output_av, & 4252 simulated_time_at_begin ) & 4253 ) / dt_data_output_av ) 3963 ntdim_2d_xz(1) = CEILING( ( end_time - MAX( skip_time_data_output_av, & 3964 simulated_time_at_begin ) & 3965 ) / dt_data_output_av ) 4254 3966 ENDIF 4255 3967 RETURN … … 4263 3975 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) 4264 3976 IF ( INDEX( do2d(av,i), 'xz' ) /= 0 ) THEN 4265 nc_stat = NF90_INQ_VARID( id_set_xz(av), do2d(av,i), & 4266 id_var_do2d(av,i) ) 3977 nc_stat = NF90_INQ_VARID( id_set_xz(av), do2d(av,i), id_var_do2d(av,i) ) 4267 3978 CALL netcdf_handle_error( 'netcdf_define_header', 177 ) 4268 3979 #if defined( __netcdf4_parallel ) 4269 3980 ! 4270 !-- Set independent io operations for parallel io. Collective io 4271 !-- is only allowed in case of a 1d-decomposition along x, because 4272 !-- otherwise, not all PEs have output data. 3981 !-- Set independent io operations for parallel io. Collective io is only allowed in case 3982 !-- of a 1d-decomposition along x, because otherwise, not all PEs have output data. 4273 3983 IF ( netcdf_data_format > 4 ) THEN 4274 3984 IF ( npey == 1 ) THEN 4275 nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av), &4276 id_var_do2d(av,i), &3985 nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av), & 3986 id_var_do2d(av,i), & 4277 3987 NF90_COLLECTIVE ) 4278 3988 ELSE 4279 3989 ! 4280 !-- Test simulations showed that the output of cross sections 4281 !-- by all PEs in data_output_2d using NF90_COLLECTIVE is 4282 !-- faster than the output by the first row of PEs in 4283 !-- x-direction using NF90_INDEPENDENT. 4284 nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av), & 4285 id_var_do2d(av,i), & 3990 !-- Test simulations showed that the output of cross sections by all PEs in 3991 !-- data_output_2d using NF90_COLLECTIVE is faster than the output by the first 3992 !-- row of PEs in x-direction using NF90_INDEPENDENT. 3993 nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av), & 3994 id_var_do2d(av,i), & 4286 3995 NF90_COLLECTIVE ) 4287 ! nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av), &4288 ! id_var_do2d(av,i), &3996 ! nc_stat = NF90_VAR_PAR_ACCESS( id_set_xz(av), & 3997 ! id_var_do2d(av,i), & 4289 3998 ! NF90_INDEPENDENT ) 4290 3999 ENDIF … … 4297 4006 4298 4007 ! 4299 !-- Update the title attribute on file 4300 !-- In order to avoid 'data mode' errors if updated attributes are larger 4301 !-- than their original size, NF90_PUT_ATT is called in 'define mode' 4302 !-- enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible 4303 !-- performance loss due to data copying; an alternative strategy would be 4304 !-- to ensure equal attribute size in a job chain. Maybe revise later. 4008 !-- Update the title attribute on file. 4009 !-- In order to avoid 'data mode' errors if updated attributes are larger than their original 4010 !-- size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF 4011 !-- calls. This implies a possible performance loss due to data copying; an alternative 4012 !-- strategy would be to ensure equal attribute size in a job chain. Maybe revise later. 4305 4013 IF ( av == 0 ) THEN 4306 4014 time_average_text = ' ' 4307 4015 ELSE 4308 WRITE (time_average_text, '('', '',F7.1,'' s average'')') & 4309 averaging_interval 4016 WRITE ( time_average_text, '('', '',F7.1,'' s average'')' ) averaging_interval 4310 4017 ENDIF 4311 4018 nc_stat = NF90_REDEF( id_set_xz(av) ) 4312 4019 CALL netcdf_handle_error( 'netcdf_define_header', 433 ) 4313 nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'title', & 4314 TRIM( run_description_header ) // & 4315 TRIM( time_average_text ) ) 4020 nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'title', & 4021 TRIM( run_description_header ) // TRIM( time_average_text ) ) 4316 4022 CALL netcdf_handle_error( 'netcdf_define_header', 178 ) 4317 4023 nc_stat = NF90_ENDDEF( id_set_xz(av) ) 4318 4024 CALL netcdf_handle_error( 'netcdf_define_header', 434 ) 4319 message_string = 'netCDF file for cross-sections ' // & 4320 TRIM( var ) // ' from previous run found.' // & 4321 '&This file will be extended.' 4025 message_string = 'netCDF file for cross-sections ' // TRIM( var ) // & 4026 ' from previous run found.' // '&This file will be extended.' 4322 4027 CALL message( 'define_netcdf_header', 'PA0253', 0, 0, 0, 6, 0 ) 4323 4028 … … 4328 4033 !-- Define some global attributes of the dataset 4329 4034 IF ( av == 0 ) THEN 4330 CALL netcdf_create_global_atts( id_set_yz(av), 'yz', TRIM( run_description_header ), 179 ) 4035 CALL netcdf_create_global_atts( id_set_yz(av), 'yz', TRIM( run_description_header ), & 4036 179 ) 4331 4037 time_average_text = ' ' 4332 4038 ELSE 4333 CALL netcdf_create_global_atts( id_set_yz(av), 'yz_av', TRIM( run_description_header ), 179 ) 4039 CALL netcdf_create_global_atts( id_set_yz(av), 'yz_av', & 4040 TRIM( run_description_header ), 179 ) 4334 4041 WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval 4335 nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'time_avg', &4042 nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'time_avg', & 4336 4043 TRIM( time_average_text ) ) 4337 4044 CALL netcdf_handle_error( 'netcdf_define_header', 180 ) … … 4340 4047 ! 4341 4048 !-- Define time coordinate for yz sections. 4342 !-- For parallel output the time dimensions has to be limited, otherwise 4343 !-- the performance dropssignificantly.4049 !-- For parallel output the time dimensions has to be limited, otherwise the performance drops 4050 !-- significantly. 4344 4051 IF ( netcdf_data_format < 5 ) THEN 4345 CALL netcdf_create_dim( id_set_yz(av), 'time', NF90_UNLIMITED, &4346 id_dim_time_yz(av),181 )4052 CALL netcdf_create_dim( id_set_yz(av), 'time', NF90_UNLIMITED, id_dim_time_yz(av), & 4053 181 ) 4347 4054 ELSE 4348 CALL netcdf_create_dim( id_set_yz(av), 'time', ntdim_2d_yz(av), & 4349 id_dim_time_yz(av), 526 ) 4350 ENDIF 4351 4352 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_time_yz(av) /), & 4353 'time', NF90_DOUBLE, id_var_time_yz(av), & 4354 'seconds', 'time', 182, 183, 000 ) 4055 CALL netcdf_create_dim( id_set_yz(av), 'time', ntdim_2d_yz(av), id_dim_time_yz(av), & 4056 526 ) 4057 ENDIF 4058 4059 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_time_yz(av) /), 'time', NF90_DOUBLE, & 4060 id_var_time_yz(av), 'seconds', 'time', 182, 183, 000 ) 4355 4061 CALL netcdf_create_att( id_set_yz(av), id_var_time_yz(av), 'standard_name', 'time', 000) 4356 4062 CALL netcdf_create_att( id_set_yz(av), id_var_time_yz(av), 'axis', 'T', 000) … … 4362 4068 ELSE 4363 4069 ns = 1 4364 DO WHILE ( section(ns,3) /= -9999 .AND. ns <= 100 )4070 DO WHILE ( section(ns,3) /= -9999 .AND. ns <= 100 ) 4365 4071 ns = ns + 1 4366 4072 ENDDO … … 4370 4076 ! 4371 4077 !-- Define x axis (for scalar position) 4372 CALL netcdf_create_dim( id_set_yz(av), 'x_yz', ns, id_dim_x_yz(av), & 4373 184 ) 4374 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_x_yz(av) /), & 4375 'x_yz', NF90_DOUBLE, id_var_x_yz(av), & 4376 'meters', '', 185, 186, 000 ) 4377 CALL netcdf_create_att( id_set_yz(av), id_var_x_yz(av), 'axis', & 4378 'X', 000) 4078 CALL netcdf_create_dim( id_set_yz(av), 'x_yz', ns, id_dim_x_yz(av), 184 ) 4079 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_x_yz(av) /), 'x_yz', NF90_DOUBLE, & 4080 id_var_x_yz(av), 'meters', '', 185, 186, 000 ) 4081 CALL netcdf_create_att( id_set_yz(av), id_var_x_yz(av), 'axis', 'X', 000) 4379 4082 ! 4380 4083 !-- Define x axis (for u position) 4381 CALL netcdf_create_dim( id_set_yz(av), 'xu_yz', ns, & 4382 id_dim_xu_yz(av), 377 ) 4383 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_xu_yz(av) /), & 4384 'xu_yz', NF90_DOUBLE, id_var_xu_yz(av), & 4385 'meters', '', 378, 379, 000 ) 4386 CALL netcdf_create_att( id_set_yz(av), id_var_xu_yz(av), 'axis', & 4387 'X', 000) 4388 ! 4389 !-- Define a variable to store the layer indices of the vertical cross 4390 !-- sections 4391 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_x_yz(av) /), & 4392 'ind_x_yz', NF90_DOUBLE, & 4393 id_var_ind_x_yz(av), 'gridpoints', '', 187, & 4394 188, 000 ) 4084 CALL netcdf_create_dim( id_set_yz(av), 'xu_yz', ns, id_dim_xu_yz(av), 377 ) 4085 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_xu_yz(av) /), 'xu_yz', NF90_DOUBLE, & 4086 id_var_xu_yz(av), 'meters', '', 378, 379, 000 ) 4087 CALL netcdf_create_att( id_set_yz(av), id_var_xu_yz(av), 'axis', 'X', 000) 4088 ! 4089 !-- Define a variable to store the layer indices of the vertical cross sections 4090 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_x_yz(av) /), 'ind_x_yz', NF90_DOUBLE, & 4091 id_var_ind_x_yz(av), 'gridpoints', '', 187, 188, 000 ) 4395 4092 ! 4396 4093 !-- Define y-axis (for scalar position) 4397 CALL netcdf_create_dim( id_set_yz(av), 'y', ny+1, id_dim_y_yz(av), & 4398 189 ) 4399 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_y_yz(av) /), 'y', & 4400 NF90_DOUBLE, id_var_y_yz(av), 'meters', '', & 4401 190, 191, 000 ) 4402 CALL netcdf_create_att( id_set_yz(av), id_var_y_yz(av), 'axis', & 4403 'Y', 000) 4094 CALL netcdf_create_dim( id_set_yz(av), 'y', ny+1, id_dim_y_yz(av), 189 ) 4095 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_y_yz(av) /), 'y', NF90_DOUBLE, & 4096 id_var_y_yz(av), 'meters', '', 190, 191, 000 ) 4097 CALL netcdf_create_att( id_set_yz(av), id_var_y_yz(av), 'axis', 'Y', 000) 4404 4098 ! 4405 4099 !-- Define y-axis (for v position) 4406 CALL netcdf_create_dim( id_set_yz(av), 'yv', ny+1, id_dim_yv_yz(av), & 4407 380 ) 4408 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_yv_yz(av) /), 'yv', & 4409 NF90_DOUBLE, id_var_yv_yz(av), 'meters', '', & 4410 381, 382, 000 ) 4411 CALL netcdf_create_att( id_set_yz(av), id_var_yv_yz(av), 'axis', & 4412 'Y', 000) 4100 CALL netcdf_create_dim( id_set_yz(av), 'yv', ny+1, id_dim_yv_yz(av), 380 ) 4101 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_yv_yz(av) /), 'yv', NF90_DOUBLE, & 4102 id_var_yv_yz(av), 'meters', '', 381, 382, 000 ) 4103 CALL netcdf_create_att( id_set_yz(av), id_var_yv_yz(av), 'axis', 'Y', 000) 4413 4104 ! 4414 4105 !-- Define the two z-axes (zu and zw) 4415 CALL netcdf_create_dim( id_set_yz(av), 'zu', nz+2, id_dim_zu_yz(av), & 4416 192 ) 4417 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_zu_yz(av) /), 'zu', & 4418 NF90_DOUBLE, id_var_zu_yz(av), 'meters', '', & 4419 193, 194, 000 ) 4420 CALL netcdf_create_att( id_set_yz(av), id_var_zu_yz(av), 'axis', & 4421 'Z', 000) 4422 4423 CALL netcdf_create_dim( id_set_yz(av), 'zw', nz+2, id_dim_zw_yz(av), & 4424 195 ) 4425 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_zw_yz(av) /), 'zw', & 4426 NF90_DOUBLE, id_var_zw_yz(av), 'meters', '', & 4427 196, 197, 000 ) 4428 CALL netcdf_create_att( id_set_yz(av), id_var_zw_yz(av), 'axis', & 4429 'Z', 000) 4106 CALL netcdf_create_dim( id_set_yz(av), 'zu', nz+2, id_dim_zu_yz(av), 192 ) 4107 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_zu_yz(av) /), 'zu', NF90_DOUBLE, & 4108 id_var_zu_yz(av), 'meters', '', 193, 194, 000 ) 4109 CALL netcdf_create_att( id_set_yz(av), id_var_zu_yz(av), 'axis', 'Z', 000) 4110 4111 CALL netcdf_create_dim( id_set_yz(av), 'zw', nz+2, id_dim_zw_yz(av), 195 ) 4112 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_zw_yz(av) /), 'zw', NF90_DOUBLE, & 4113 id_var_zw_yz(av), 'meters', '', 196, 197, 000 ) 4114 CALL netcdf_create_att( id_set_yz(av), id_var_zw_yz(av), 'axis', 'Z', 000) 4430 4115 ! 4431 4116 !-- Define UTM and geographic coordinates 4432 CALL define_geo_coordinates( id_set_yz(av), &4433 (/ id_dim_x_yz(av), id_dim_xu_yz(av) /),&4434 (/ id_dim_y_yz(av), id_dim_yv_yz(av) /),&4435 id_var_eutm_yz(:,av), id_var_nutm_yz(:,av),&4436 id_var_lat_yz(:,av), id_var_lon_yz(:,av) )4117 CALL define_geo_coordinates( id_set_yz(av), & 4118 (/ id_dim_x_yz(av), id_dim_xu_yz(av) /), & 4119 (/ id_dim_y_yz(av), id_dim_yv_yz(av) /), & 4120 id_var_eutm_yz(:,av), id_var_nutm_yz(:,av), & 4121 id_var_lat_yz(:,av), id_var_lon_yz(:,av) ) 4437 4122 ! 4438 4123 !-- Define coordinate-reference system … … 4441 4126 IF ( land_surface ) THEN 4442 4127 4443 CALL netcdf_create_dim( id_set_yz(av), 'zs', nzs, & 4444 id_dim_zs_yz(av), 545 ) 4445 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_zs_yz(av) /), & 4446 'zs', NF90_DOUBLE, id_var_zs_yz(av), & 4447 'meters', '', 546, 547, 000 ) 4448 CALL netcdf_create_att( id_set_yz(av), id_var_zs_yz(av), 'axis', & 4449 'Z', 000) 4128 CALL netcdf_create_dim( id_set_yz(av), 'zs', nzs, id_dim_zs_yz(av), 545 ) 4129 CALL netcdf_create_var( id_set_yz(av), (/ id_dim_zs_yz(av) /), 'zs', NF90_DOUBLE, & 4130 id_var_zs_yz(av), 'meters', '', 546, 547, 000 ) 4131 CALL netcdf_create_att( id_set_yz(av), id_var_zs_yz(av), 'axis', 'Z', 000) 4450 4132 4451 4133 ENDIF … … 4502 4184 !-- Check for land surface quantities 4503 4185 IF ( land_surface ) THEN 4504 CALL lsm_define_netcdf_grid( do2d(av,i), found, & 4505 grid_x, grid_y, grid_z ) 4186 CALL lsm_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 4506 4187 ENDIF 4507 4188 4508 4189 IF ( .NOT. found ) THEN 4509 CALL tcm_define_netcdf_grid( do2d(av,i), found, & 4510 grid_x, grid_y, grid_z ) 4190 CALL tcm_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 4511 4191 ENDIF 4512 4192 … … 4514 4194 !-- Check for ocean quantities 4515 4195 IF ( .NOT. found .AND. ocean_mode ) THEN 4516 CALL ocean_define_netcdf_grid( do2d(av,i), found, & 4517 grid_x, grid_y, grid_z ) 4196 CALL ocean_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 4518 4197 ENDIF 4519 4198 ! 4520 4199 !-- Check for radiation quantities 4521 4200 IF ( .NOT. found .AND. radiation ) THEN 4522 CALL radiation_define_netcdf_grid( do2d(av,i), found, & 4523 grid_x, grid_y, & 4201 CALL radiation_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, & 4524 4202 grid_z ) 4525 4203 ENDIF … … 4527 4205 !-- Check for SALSA quantities 4528 4206 IF ( .NOT. found .AND. salsa ) THEN 4529 CALL salsa_define_netcdf_grid( do2d(av,i), found, & 4530 grid_x, grid_y, grid_z ) 4207 CALL salsa_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 4531 4208 ENDIF 4532 4209 ! 4533 4210 !-- Check for gust module quantities 4534 4211 IF ( .NOT. found .AND. gust_module_enabled ) THEN 4535 CALL gust_define_netcdf_grid( do2d(av,i), found, & 4536 grid_x, grid_y, grid_z ) 4212 CALL gust_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 4537 4213 ENDIF 4538 4214 … … 4540 4216 !-- Check for chemistry quantities 4541 4217 IF ( .NOT. found .AND. air_chemistry ) THEN 4542 CALL chem_define_netcdf_grid( do2d(av,i), found, & 4543 grid_x, grid_y, & 4544 grid_z ) 4218 CALL chem_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 4545 4219 ENDIF 4546 4220 4547 IF ( .NOT. found ) & 4548 CALL doq_define_netcdf_grid( & 4549 do2d(av,i), found, grid_x, & 4550 grid_y, grid_z ) 4221 IF ( .NOT. found ) & 4222 CALL doq_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 4551 4223 ! 4552 4224 !-- Check for user-defined quantities 4553 4225 IF ( .NOT. found .AND. user_module_enabled ) THEN 4554 CALL user_define_netcdf_grid( do2d(av,i), found, & 4555 grid_x, grid_y, grid_z ) 4226 CALL user_define_netcdf_grid( do2d(av,i), found, grid_x, grid_y, grid_z ) 4556 4227 ENDIF 4557 4228 4558 4229 IF ( .NOT. found ) THEN 4559 WRITE ( message_string, * ) 'no grid defined for', & 4560 ' variable ', TRIM( do2d(av,i) ) 4561 CALL message( 'define_netcdf_header', 'PA0244', & 4562 0, 1, 0, 6, 0 ) 4230 WRITE ( message_string, * ) 'no grid defined for', ' variable ', & 4231 TRIM( do2d(av,i) ) 4232 CALL message( 'define_netcdf_header', 'PA0244', 0, 1, 0, 6, 0 ) 4563 4233 ENDIF 4564 4234 … … 4589 4259 ! 4590 4260 !-- Define the grid 4591 CALL netcdf_create_var( id_set_yz(av), (/ id_x, id_y, id_z, & 4592 id_dim_time_yz(av) /), do2d(av,i), & 4593 nc_precision(3), id_var_do2d(av,i), & 4594 TRIM( do2d_unit(av,i) ), do2d(av,i), & 4595 198, 199, 356, .TRUE. ) 4261 CALL netcdf_create_var( id_set_yz(av), (/ id_x, id_y, id_z, id_dim_time_yz(av) /),& 4262 do2d(av,i), nc_precision(3), id_var_do2d(av,i), & 4263 TRIM( do2d_unit(av,i) ), do2d(av,i), 198, 199, 356, .TRUE. ) 4596 4264 4597 4265 #if defined( __netcdf4_parallel ) … … 4599 4267 ! 4600 4268 !-- Set no fill for every variable to increase performance. 4601 nc_stat = NF90_DEF_VAR_FILL( id_set_yz(av), &4602 id_var_do2d(av,i), &4269 nc_stat = NF90_DEF_VAR_FILL( id_set_yz(av), & 4270 id_var_do2d(av,i), & 4603 4271 NF90_NOFILL, 0 ) 4604 4272 CALL netcdf_handle_error( 'netcdf_define_header', 535 ) 4605 4273 ! 4606 !-- Set independent io operations for parallel io. Collective io 4607 !-- is only allowed in case of a 1d-decomposition along y,4608 !-- because otherwise, not all PEs have outputdata.4274 !-- Set independent io operations for parallel io. Collective io is only allowed in 4275 !-- case of a 1d-decomposition along y, because otherwise, not all PEs have output 4276 !-- data. 4609 4277 IF ( npex == 1 ) THEN 4610 nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av), &4611 id_var_do2d(av,i), &4278 nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av), & 4279 id_var_do2d(av,i), & 4612 4280 NF90_COLLECTIVE ) 4613 4281 ELSE 4614 4282 ! 4615 !-- Test simulations showed that the output of cross sections 4616 !-- by all PEs in data_output_2d using NF90_COLLECTIVE is 4617 !-- faster than the output by the first row of PEs in 4618 !-- y-direction using NF90_INDEPENDENT. 4619 nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av), & 4620 id_var_do2d(av,i), & 4283 !-- Test simulations showed that the output of cross sections by all PEs in 4284 !-- data_output_2d using NF90_COLLECTIVE is faster than the output by the first 4285 !-- row of PEs in y-direction using NF90_INDEPENDENT. 4286 nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av), & 4287 id_var_do2d(av,i), & 4621 4288 NF90_COLLECTIVE ) 4622 ! nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av), &4623 ! id_var_do2d(av,i), &4289 ! nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av), & 4290 ! id_var_do2d(av,i), & 4624 4291 ! NF90_INDEPENDENT ) 4625 4292 ENDIF … … 4640 4307 4641 4308 ! 4642 !-- Write the list of variables as global attribute (this is used by 4643 !-- restart runs and by combine_plot_fields) 4644 nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'VAR_LIST', & 4645 var_list ) 4309 !-- Write the list of variables as global attribute (this is used by restart runs and by 4310 !-- combine_plot_fields) 4311 nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'VAR_LIST', var_list ) 4646 4312 CALL netcdf_handle_error( 'netcdf_define_header', 200 ) 4647 4313 4648 4314 ! 4649 !-- Set general no fill, otherwise the performance drops significantly for 4650 !-- parallel output. 4315 !-- Set general no fill, otherwise the performance drops significantly for parallel output. 4651 4316 nc_stat = NF90_SET_FILL( id_set_yz(av), NF90_NOFILL, oldmode ) 4652 4317 CALL netcdf_handle_error( 'netcdf_define_header', 531 ) … … 4658 4323 4659 4324 ! 4660 !-- These data are only written by PE0 for parallel output to increase 4661 !-- the performance. 4325 !-- These data are only written by PE0 for parallel output to increase the performance. 4662 4326 IF ( myid == 0 .OR. netcdf_data_format < 5 ) THEN 4663 4327 … … 4675 4339 ENDIF 4676 4340 ENDDO 4677 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_x_yz(av), &4678 netcdf_data, start = (/ 1 /), &4341 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_x_yz(av), & 4342 netcdf_data, start = (/ 1 /), & 4679 4343 count = (/ ns /) ) 4680 4344 CALL netcdf_handle_error( 'netcdf_define_header', 202 ) … … 4689 4353 ENDIF 4690 4354 ENDDO 4691 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_xu_yz(av), &4692 netcdf_data, start = (/ 1 /), &4355 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_xu_yz(av), & 4356 netcdf_data, start = (/ 1 /), & 4693 4357 count = (/ ns /) ) 4694 4358 CALL netcdf_handle_error( 'netcdf_define_header', 383 ) … … 4697 4361 !-- Write gridpoint number data 4698 4362 netcdf_data(1:ns) = section(1:ns,3) 4699 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_ind_x_yz(av), &4700 netcdf_data, start = (/ 1 /), &4363 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_ind_x_yz(av), & 4364 netcdf_data, start = (/ 1 /), & 4701 4365 count = (/ ns /) ) 4702 4366 CALL netcdf_handle_error( 'netcdf_define_header', 203 ) … … 4712 4376 ENDDO 4713 4377 4714 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_y_yz(av), &4715 netcdf_data, start = (/ 1 /), &4378 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_y_yz(av), & 4379 netcdf_data, start = (/ 1 /), & 4716 4380 count = (/ ny+1 /) ) 4717 4381 CALL netcdf_handle_error( 'netcdf_define_header', 204 ) … … 4721 4385 ENDDO 4722 4386 4723 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_yv_yz(av), &4724 netcdf_data, start = (/ 1 /), &4387 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_yv_yz(av), & 4388 netcdf_data, start = (/ 1 /), & 4725 4389 count = (/ ny+1 /) ) 4726 4390 CALL netcdf_handle_error( 'netcdf_define_header', 384 ) … … 4733 4397 4734 4398 netcdf_data(0:nz+1) = zu(nzb:nzt+1) 4735 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_zu_yz(av), &4736 netcdf_data, start = (/ 1 /), &4399 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_zu_yz(av), & 4400 netcdf_data, start = (/ 1 /), & 4737 4401 count = (/ nz+2 /) ) 4738 4402 CALL netcdf_handle_error( 'netcdf_define_header', 205 ) 4739 4403 4740 4404 netcdf_data(0:nz+1) = zw(nzb:nzt+1) 4741 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_zw_yz(av), &4742 netcdf_data, start = (/ 1 /), &4405 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_zw_yz(av), & 4406 netcdf_data, start = (/ 1 /), & 4743 4407 count = (/ nz+2 /) ) 4744 4408 CALL netcdf_handle_error( 'netcdf_define_header', 206 ) … … 4773 4437 netcdf_data(i) = -1.0_wp ! section averaged along x 4774 4438 ELSE 4775 netcdf_data(i) = init_model%origin_x &4776 + cos_rot_angle * ( section(i,3) + shift_x ) * dx4439 netcdf_data(i) = init_model%origin_x & 4440 + cos_rot_angle * ( section(i,3) + shift_x ) * dx 4777 4441 ENDIF 4778 4442 ENDDO 4779 4443 4780 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_eutm_yz(k,av), &4781 netcdf_data, start = (/ 1 /), &4444 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_eutm_yz(k,av), & 4445 netcdf_data, start = (/ 1 /), & 4782 4446 count = (/ ns /) ) 4783 4447 CALL netcdf_handle_error( 'netcdf_define_header', 555 ) … … 4804 4468 4805 4469 DO i = 0, ny 4806 netcdf_data(i) = init_model%origin_y & 4807 + cos_rot_angle * ( i + shift_y ) * dy 4470 netcdf_data(i) = init_model%origin_y + cos_rot_angle * ( i + shift_y ) * dy 4808 4471 ENDDO 4809 4472 4810 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_nutm_yz(k,av), &4811 netcdf_data, start = (/ 1 /), &4473 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_nutm_yz(k,av), & 4474 netcdf_data, start = (/ 1 /), & 4812 4475 count = (/ ny+1 /) ) 4813 4476 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) … … 4843 4506 netcdf_data_2d(i,:) = -1.0_wp !section averaged along x 4844 4507 ELSE 4845 netcdf_data_2d(i,j) = init_model%origin_x &4846 + cos_rot_angle * ( section(i,3) + shift_x ) * dx &4847 + sin_rot_angle * ( j + shift_y ) * dy4508 netcdf_data_2d(i,j) = init_model%origin_x & 4509 + cos_rot_angle * ( section(i,3) + shift_x ) * dx & 4510 + sin_rot_angle * ( j + shift_y ) * dy 4848 4511 ENDIF 4849 4512 ENDDO 4850 4513 ENDDO 4851 4514 4852 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_eutm_yz(k,av), &4853 netcdf_data_2d, start = (/ 1, 1 /), &4515 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_eutm_yz(k,av), & 4516 netcdf_data_2d, start = (/ 1, 1 /), & 4854 4517 count = (/ ns, ny+1 /) ) 4855 4518 CALL netcdf_handle_error( 'netcdf_define_header', 555 ) … … 4860 4523 netcdf_data_2d(i,:) = -1.0_wp !section averaged along x 4861 4524 ELSE 4862 netcdf_data_2d(i,j) = init_model%origin_y &4863 - sin_rot_angle * ( section(i,3) + shift_x ) * dx &4864 + cos_rot_angle * ( j + shift_y ) * dy4525 netcdf_data_2d(i,j) = init_model%origin_y & 4526 - sin_rot_angle * ( section(i,3) + shift_x ) * dx & 4527 + cos_rot_angle * ( j + shift_y ) * dy 4865 4528 ENDIF 4866 4529 ENDDO 4867 4530 ENDDO 4868 4531 4869 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_nutm_yz(k,av), &4870 netcdf_data_2d, start = (/ 1, 1 /), &4532 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_nutm_yz(k,av), & 4533 netcdf_data_2d, start = (/ 1, 1 /), & 4871 4534 count = (/ ns, ny+1 /) ) 4872 4535 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) … … 4903 4566 lon(i,:) = -180.0_wp ! section averaged along x 4904 4567 ELSE 4905 eutm = init_model%origin_x & 4906 + cos_rot_angle * ( section(i,3) + shift_x ) * dx & 4907 + sin_rot_angle * ( j + shift_y ) * dy 4908 nutm = init_model%origin_y & 4909 - sin_rot_angle * ( section(i,3) + shift_x ) * dx & 4910 + cos_rot_angle * ( j + shift_y ) * dy 4911 4912 CALL convert_utm_to_geographic( crs_list, & 4913 eutm, nutm, & 4914 lon(i,j), lat(i,j) ) 4568 eutm = init_model%origin_x & 4569 + cos_rot_angle * ( section(i,3) + shift_x ) * dx & 4570 + sin_rot_angle * ( j + shift_y ) * dy 4571 nutm = init_model%origin_y & 4572 - sin_rot_angle * ( section(i,3) + shift_x ) * dx & 4573 + cos_rot_angle * ( j + shift_y ) * dy 4574 4575 CALL convert_utm_to_geographic( crs_list, eutm, nutm, lon(i,j), lat(i,j) ) 4915 4576 ENDIF 4916 4577 ENDDO 4917 4578 ENDDO 4918 4579 4919 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_lon_yz(k,av), &4920 lon, start = (/ 1, 1 /),&4921 count = (/ ns, ny+1 /) )4580 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_lon_yz(k,av), & 4581 lon, start = (/ 1, 1 /), & 4582 count = (/ ns, ny+1 /) ) 4922 4583 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) 4923 4584 4924 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_lat_yz(k,av), &4925 lat, start = (/ 1, 1 /),&4926 count = (/ ns, ny+1 /) )4585 nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_lat_yz(k,av), & 4586 lat, start = (/ 1, 1 /), & 4587 count = (/ ns, ny+1 /) ) 4927 4588 CALL netcdf_handle_error( 'netcdf_define_header', 556 ) 4928 4589 ENDDO … … 4938 4599 ! 4939 4600 !-- Get the list of variables and compare with the actual run. 4940 !-- First var_list_old has to be reset, since GET_ATT does not assign 4941 !-- trailing blanks. 4601 !-- First var_list_old has to be reset, since GET_ATT does not assign trailing blanks. 4942 4602 var_list_old = ' ' 4943 nc_stat = NF90_GET_ATT( id_set_yz(av), NF90_GLOBAL, 'VAR_LIST', & 4944 var_list_old ) 4603 nc_stat = NF90_GET_ATT( id_set_yz(av), NF90_GLOBAL, 'VAR_LIST', var_list_old ) 4945 4604 CALL netcdf_handle_error( 'netcdf_define_header', 207 ) 4946 4605 4947 4606 var_list = ';' 4948 4607 i = 1 4949 DO WHILE ( do2d(av,i)(1:1) /= ' ' )4608 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) 4950 4609 IF ( INDEX( do2d(av,i), 'yz' ) /= 0 ) THEN 4951 4610 var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';' … … 4961 4620 4962 4621 IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN 4963 message_string = 'netCDF file for cross-sections ' // & 4964 TRIM( var ) // ' from previous run found,' // & 4965 '&but this file cannot be extended due to' // & 4966 ' variable mismatch.' // & 4967 '&New file is created instead.' 4622 message_string = 'netCDF file for cross-sections ' // TRIM( var ) // & 4623 ' from previous run found,' // & 4624 '&but this file cannot be extended due to' // & 4625 ' variable mismatch.' // '&New file is created instead.' 4968 4626 CALL message( 'define_netcdf_header', 'PA0249', 0, 1, 0, 6, 0 ) 4969 4627 extend = .FALSE. … … 4989 4647 id_dim_x_yz(av) = id_dim_x_yz_old(1) 4990 4648 4991 nc_stat = NF90_INQUIRE_DIMENSION( id_set_yz(av), id_dim_x_yz(av), & 4992 len = ns_old ) 4649 nc_stat = NF90_INQUIRE_DIMENSION( id_set_yz(av), id_dim_x_yz(av), LEN = ns_old ) 4993 4650 CALL netcdf_handle_error( 'netcdf_define_header', 210 ) 4994 4651 4995 4652 IF ( ns /= ns_old ) THEN 4996 message_string = 'netCDF file for cross-sections ' // & 4997 TRIM( var ) // ' from previous run found,' // & 4998 '&but this file cannot be extended due to' // & 4999 ' mismatch in number of' // & 5000 ' cross sections.' // & 4653 message_string = 'netCDF file for cross-sections ' // TRIM( var ) // & 4654 ' from previous run found,' // & 4655 '&but this file cannot be extended due to' // & 4656 ' mismatch in number of' // ' cross sections.' // & 5001 4657 '&New file is created instead.' 5002 4658 CALL message( 'define_netcdf_header', 'PA0250', 0, 1, 0, 6, 0 ) … … 5015 4671 IF ( section(i,3) /= -1 ) THEN 5016 4672 IF ( ( ( section(i,3) + 0.5 ) * dx ) /= netcdf_data(i) ) THEN 5017 message_string = 'netCDF file for cross-sections ' // & 5018 TRIM( var ) // ' from previous run found,' // & 5019 ' but this file cannot be extended' // & 5020 ' due to mismatch in cross' // & 5021 ' section levels.' // & 5022 ' New file is created instead.' 5023 CALL message( 'define_netcdf_header', 'PA0251', & 5024 0, 1, 0, 6, 0 ) 4673 message_string = 'netCDF file for cross-sections ' // TRIM( var ) // & 4674 ' from previous run found,' // & 4675 ' but this file cannot be extended' // & 4676 ' due to mismatch in cross' // ' section levels.' // & 4677 ' New file is created instead.' 4678 CALL message( 'define_netcdf_header', 'PA0251', 0, 1, 0, 6, 0 ) 5025 4679 extend = .FALSE. 5026 4680 RETURN … … 5028 4682 ELSE 5029 4683 IF ( -1.0_wp /= netcdf_data(i) ) THEN 5030 message_string = 'netCDF file for cross-sections ' // & 5031 TRIM( var ) // ' from previous run found,' // & 5032 ' but this file cannot be extended' // & 5033 ' due to mismatch in cross' // & 5034 ' section levels.' // & 5035 ' New file is created instead.' 5036 CALL message( 'define_netcdf_header', 'PA0251', & 5037 0, 1, 0, 6, 0 ) 4684 message_string = 'netCDF file for cross-sections ' // TRIM( var ) // & 4685 ' from previous run found,' // & 4686 ' but this file cannot be extended' // & 4687 ' due to mismatch in cross' // ' section levels.' // & 4688 ' New file is created instead.' 4689 CALL message( 'define_netcdf_header', 'PA0251', 0, 1, 0, 6, 0 ) 5038 4690 extend = .FALSE. 5039 4691 RETURN … … 5045 4697 5046 4698 ! 5047 !-- Get the id of the time coordinate (unlimited coordinate) and its 5048 !-- last index on the file. The next time level is pl2d..count+1. 5049 !-- The current time must be larger than the last output time 5050 !-- on the file. 4699 !-- Get the id of the time coordinate (unlimited coordinate) and its last index on the file. 4700 !-- The next time level is pl2d..count+1. 4701 !-- The current time must be larger than the last output time on the file. 5051 4702 nc_stat = NF90_INQ_VARID( id_set_yz(av), 'time', id_var_time_yz(av) ) 5052 4703 CALL netcdf_handle_error( 'netcdf_define_header', 212 ) 5053 4704 5054 nc_stat = NF90_INQUIRE_VARIABLE( id_set_yz(av), id_var_time_yz(av), &4705 nc_stat = NF90_INQUIRE_VARIABLE( id_set_yz(av), id_var_time_yz(av), & 5055 4706 dimids = id_dim_time_old ) 5056 4707 CALL netcdf_handle_error( 'netcdf_define_header', 213 ) 5057 4708 id_dim_time_yz(av) = id_dim_time_old(1) 5058 4709 5059 nc_stat = NF90_INQUIRE_DIMENSION( id_set_yz(av), id_dim_time_yz(av), & 5060 len = ntime_count ) 4710 nc_stat = NF90_INQUIRE_DIMENSION( id_set_yz(av), id_dim_time_yz(av), LEN = ntime_count ) 5061 4711 CALL netcdf_handle_error( 'netcdf_define_header', 214 ) 5062 4712 5063 4713 ! 5064 !-- For non-parallel output use the last output time level of the netcdf 5065 !-- file because the time dimension is unlimited. In case of parallel 5066 !-- output the variable ntime_count could get the value of 9*10E36 because 5067 !-- the time dimension is limited. 4714 !-- For non-parallel output use the last output time level of the netcdf file because the time 4715 !-- dimension is unlimited. In case of parallel output the variable ntime_count could get the 4716 !-- value of 9*10E36 because the time dimension is limited. 5068 4717 IF ( netcdf_data_format < 5 ) do2d_yz_time_count(av) = ntime_count 5069 4718 5070 nc_stat = NF90_GET_VAR( id_set_yz(av), id_var_time_yz(av), &5071 last_time_coordinate, &5072 start = (/ do2d_yz_time_count(av) /), &4719 nc_stat = NF90_GET_VAR( id_set_yz(av), id_var_time_yz(av), & 4720 last_time_coordinate, & 4721 start = (/ do2d_yz_time_count(av) /), & 5073 4722 count = (/ 1 /) ) 5074 4723 CALL netcdf_handle_error( 'netcdf_define_header', 215 ) 5075 4724 5076 4725 IF ( last_time_coordinate(1) >= simulated_time ) THEN 5077 message_string = 'netCDF file for cross sections ' // & 5078 TRIM( var ) // ' from previous run found,' // & 5079 '&but this file cannot be extended becaus' // & 5080 'e the current output time' // & 5081 '&is less or equal than the last output t' // & 5082 'ime on this file.' // & 4726 message_string = 'netCDF file for cross sections ' // TRIM( var ) // & 4727 ' from previous run found,' // & 4728 '&but this file cannot be extended because' // & 4729 ' the current output time' // & 4730 '&is less or equal than the last output time' // ' on this file.' // & 5083 4731 '&New file is created instead.' 5084 4732 CALL message( 'define_netcdf_header', 'PA0252', 0, 1, 0, 6, 0 ) … … 5093 4741 !-- compared to the number of time levels in the existing file. 5094 4742 IF ( ntdim_2d_yz(av) > ntime_count ) THEN 5095 message_string = 'netCDF file for cross sections ' // & 5096 TRIM( var ) // ' from previous run found,' // & 5097 '&but this file cannot be extended becaus' // & 5098 'e the number of output time levels has b' // & 5099 'een increased compared to the previous s' // & 5100 'imulation.' // & 4743 message_string = 'netCDF file for cross sections ' // TRIM( var ) // & 4744 ' from previous run found,' // & 4745 '&but this file cannot be extended because' // & 4746 ' the number of output time levels has ' // & 4747 'been increased compared to the previous ' // 'simulation.' // & 5101 4748 '&New file is created instead.' 5102 4749 CALL message( 'define_netcdf_header', 'PA0391', 0, 1, 0, 6, 0 ) … … 5106 4753 !-- Recalculate the needed time levels for the new file. 5107 4754 IF ( av == 0 ) THEN 5108 ntdim_2d_yz(0) = CEILING( & 5109 ( end_time - MAX( skip_time_do2d_yz, & 5110 simulated_time_at_begin ) & 5111 ) / dt_do2d_yz ) 4755 ntdim_2d_yz(0) = CEILING( ( end_time - MAX( skip_time_do2d_yz, & 4756 simulated_time_at_begin ) & 4757 ) / dt_do2d_yz ) 5112 4758 IF ( do2d_at_begin ) ntdim_2d_yz(0) = ntdim_2d_yz(0) + 1 5113 4759 ELSE 5114 ntdim_2d_yz(1) = CEILING( & 5115 ( end_time - MAX( skip_time_data_output_av, & 5116 simulated_time_at_begin ) & 5117 ) / dt_data_output_av ) 4760 ntdim_2d_yz(1) = CEILING( ( end_time - MAX( skip_time_data_output_av, & 4761 simulated_time_at_begin ) & 4762 ) / dt_data_output_av ) 5118 4763 ENDIF 5119 4764 RETURN … … 5127 4772 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) 5128 4773 IF ( INDEX( do2d(av,i), 'yz' ) /= 0 ) THEN 5129 nc_stat = NF90_INQ_VARID( id_set_yz(av), do2d(av,i), & 5130 id_var_do2d(av,i) ) 4774 nc_stat = NF90_INQ_VARID( id_set_yz(av), do2d(av,i), id_var_do2d(av,i) ) 5131 4775 CALL netcdf_handle_error( 'netcdf_define_header', 216 ) 5132 4776 #if defined( __netcdf4_parallel ) 5133 4777 ! 5134 !-- Set independent io operations for parallel io. Collective io 5135 !-- is only allowed in case of a 1d-decomposition along y, because 5136 !-- otherwise, not all PEs have output data. 4778 !-- Set independent io operations for parallel io. Collective io is only allowed in case 4779 !-- of a 1d-decomposition along y, because otherwise, not all PEs have output data. 5137 4780 IF ( netcdf_data_format > 4 ) THEN 5138 4781 IF ( npex == 1 ) THEN 5139 nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av), &5140 id_var_do2d(av,i), &4782 nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av), & 4783 id_var_do2d(av,i), & 5141 4784 NF90_COLLECTIVE ) 5142 4785 ELSE 5143 4786 ! 5144 !-- Test simulations showed that the output of cross sections 5145 !-- by all PEs in data_output_2d using NF90_COLLECTIVE is 5146 !-- faster than the output by the first row of PEs in 5147 !-- y-direction using NF90_INDEPENDENT. 5148 nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av), & 5149 id_var_do2d(av,i), & 4787 !-- Test simulations showed that the output of cross sections by all PEs in 4788 !-- data_output_2d using NF90_COLLECTIVE is faster than the output by the first 4789 !-- row of PEs in y-direction using NF90_INDEPENDENT. 4790 nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av), & 4791 id_var_do2d(av,i), & 5150 4792 NF90_COLLECTIVE ) 5151 ! nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av), &5152 ! id_var_do2d(av,i), &4793 ! nc_stat = NF90_VAR_PAR_ACCESS( id_set_yz(av), & 4794 ! id_var_do2d(av,i), & 5153 4795 ! NF90_INDEPENDENT ) 5154 4796 ENDIF … … 5161 4803 5162 4804 ! 5163 !-- Update the title attribute on file 5164 !-- In order to avoid 'data mode' errors if updated attributes are larger 5165 !-- than their original size, NF90_PUT_ATT is called in 'define mode' 5166 !-- enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible 5167 !-- performance loss due to data copying; an alternative strategy would be 5168 !-- to ensure equal attribute size in a job chain. Maybe revise later. 4805 !-- Update the title attribute on file. 4806 !-- In order to avoid 'data mode' errors if updated attributes are larger than their original 4807 !-- size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF 4808 !-- calls. This implies a possible performance loss due to data copying; an alternative 4809 !-- strategy would be to ensure equal attribute size in a job chain. Maybe revise later. 5169 4810 IF ( av == 0 ) THEN 5170 4811 time_average_text = ' ' 5171 4812 ELSE 5172 WRITE (time_average_text, '('', '',F7.1,'' s average'')') & 5173 averaging_interval 4813 WRITE ( time_average_text, '('', '',F7.1,'' s average'')' ) averaging_interval 5174 4814 ENDIF 5175 4815 nc_stat = NF90_REDEF( id_set_yz(av) ) 5176 4816 CALL netcdf_handle_error( 'netcdf_define_header', 435 ) 5177 nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'title', & 5178 TRIM( run_description_header ) // & 5179 TRIM( time_average_text ) ) 4817 nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'title', & 4818 TRIM( run_description_header ) // TRIM( time_average_text ) ) 5180 4819 CALL netcdf_handle_error( 'netcdf_define_header', 217 ) 5181 4820 nc_stat = NF90_ENDDEF( id_set_yz(av) ) 5182 4821 CALL netcdf_handle_error( 'netcdf_define_header', 436 ) 5183 message_string = 'netCDF file for cross-sections ' // &5184 TRIM( var ) // ' from previous run found.' // &4822 message_string = 'netCDF file for cross-sections ' // & 4823 TRIM( var ) // ' from previous run found.' // & 5185 4824 '&This file will be extended.' 5186 4825 CALL message( 'define_netcdf_header', 'PA0253', 0, 0, 0, 6, 0 ) … … 5193 4832 5194 4833 IF ( averaging_interval_pr /= 0.0_wp ) THEN 5195 CALL netcdf_create_global_atts( id_set_pr, 'podsprav', TRIM( run_description_header ), 451 ) 4834 CALL netcdf_create_global_atts( id_set_pr, 'podsprav', TRIM( run_description_header ),& 4835 451 ) 5196 4836 WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval_pr 5197 nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'time_avg', & 5198 TRIM( time_average_text ) ) 4837 nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'time_avg', TRIM( time_average_text ) ) 5199 4838 ELSE 5200 CALL netcdf_create_global_atts( id_set_pr, 'podspr', TRIM( run_description_header ), 451 ) 4839 CALL netcdf_create_global_atts( id_set_pr, 'podspr', TRIM( run_description_header ), & 4840 451 ) 5201 4841 ENDIF 5202 4842 CALL netcdf_handle_error( 'netcdf_define_header', 219 ) 5203 4843 ! 5204 !-- Write number of columns and rows of coordinate systems to be plotted 5205 !-- on one page to thenetcdf header.4844 !-- Write number of columns and rows of coordinate systems to be plotted on one page to the 4845 !-- netcdf header. 5206 4846 !-- This information can be used by palmplot. 5207 nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, &5208 'no_rows', &4847 nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, & 4848 'no_rows', & 5209 4849 profile_rows ) 5210 4850 CALL netcdf_handle_error( 'netcdf_define_header', 519 ) 5211 4851 5212 nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, &5213 'no_columns', &4852 nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, & 4853 'no_columns', & 5214 4854 profile_columns ) 5215 4855 CALL netcdf_handle_error( 'netcdf_define_header', 520 ) … … 5221 4861 5222 4862 ! 5223 !-- Each profile defined in cross_profiles is written to an array 5224 !-- (cross_profiles_char). The number of the respective coordinate5225 !-- system is assigned in a second array(cross_profiles_numb).4863 !-- Each profile defined in cross_profiles is written to an array (cross_profiles_char). The 4864 !-- number of the respective coordinate system is assigned in a second array 4865 !-- (cross_profiles_numb). 5226 4866 k = 1 5227 4867 … … 5235 4875 IF ( delim == 1 ) EXIT 5236 4876 kk = MIN( crmax, k ) 5237 cross_profiles_char(kk) = cross_profiles_adj(i)(delim_old+1: & 5238 delim_old+delim-1) 4877 cross_profiles_char(kk) = cross_profiles_adj(i)(delim_old+1:delim_old+delim-1) 5239 4878 cross_profiles_numb(kk) = i 5240 4879 k = k + 1 … … 5247 4886 cross_profiles_count = MIN( crmax, k-1 ) 5248 4887 ! 5249 !-- Check if all profiles defined in cross_profiles are defined in 5250 !-- data_output_pr. If not,they will be skipped.4888 !-- Check if all profiles defined in cross_profiles are defined in data_output_pr. If not, 4889 !-- they will be skipped. 5251 4890 DO i = 1, cross_profiles_count 5252 4891 DO j = 1, dopr_n 5253 4892 5254 IF ( TRIM(cross_profiles_char(i)) == TRIM(data_output_pr(j)) ) & 5255 THEN 4893 IF ( TRIM( cross_profiles_char(i) ) == TRIM( data_output_pr(j) ) ) THEN 5256 4894 EXIT 5257 4895 ENDIF … … 5267 4905 IF ( cross_profiles_numb(i) == 999999 ) THEN 5268 4906 DO j = i + 1, crmax 5269 IF ( cross_profiles_numb(j) /= 999999 ) THEN4907 IF ( cross_profiles_numb(j) /= 999999 ) THEN 5270 4908 cross_profiles_char(i) = cross_profiles_char(j) 5271 4909 cross_profiles_numb(i) = cross_profiles_numb(j) … … 5284 4922 ENDDO 5285 4923 ! 5286 !-- Check if all profiles defined in data_output_pr are defined in 5287 !- - cross_profiles. If not,they will be added to cross_profiles.4924 !-- Check if all profiles defined in data_output_pr are defined in cross_profiles. If not, 4925 !- they will be added to cross_profiles. 5288 4926 DO i = 1, dopr_n 5289 4927 DO j = 1, cross_profiles_count 5290 4928 5291 IF ( TRIM(cross_profiles_char(j)) == TRIM(data_output_pr(i))) & 5292 THEN 4929 IF ( TRIM( cross_profiles_char(j) ) == TRIM( data_output_pr(i) ) ) THEN 5293 4930 EXIT 5294 4931 ENDIF 5295 4932 5296 IF ( ( j == cross_profiles_count ) .AND.&5297 ( cross_profiles_count <= crmax - 1))THEN4933 IF ( ( j == cross_profiles_count ) .AND. ( cross_profiles_count <= crmax - 1) ) & 4934 THEN 5298 4935 cross_profiles_count = cross_profiles_count + 1 5299 4936 cross_profiles_maxi = cross_profiles_maxi + 1 5300 cross_profiles_char(MIN( crmax, cross_profiles_count )) = & 5301 TRIM( data_output_pr(i) ) 5302 cross_profiles_numb(MIN( crmax, cross_profiles_count )) = & 5303 cross_profiles_maxi 4937 cross_profiles_char(MIN( crmax, cross_profiles_count )) = & 4938 TRIM( data_output_pr(i) ) 4939 cross_profiles_numb(MIN( crmax, cross_profiles_count )) = cross_profiles_maxi 5304 4940 ENDIF 5305 4941 … … 5308 4944 5309 4945 IF ( cross_profiles_count >= crmax ) THEN 5310 message_string = 'It is not allowed to arrange more than ' & 5311 // '100 profiles with & cross_profiles. Apart' & 5312 // ' from that, all profiles are saved & to ' & 5313 // 'the netCDF file.' 4946 message_string = 'It is not allowed to arrange more than ' // & 4947 '100 profiles with & cross_profiles. Apart' // & 4948 ' from that, all profiles are saved & to ' // 'the netCDF file.' 5314 4949 CALL message( 'define_netcdf_header', 'PA0354', 0, 0, 0, 6, 0 ) 5315 4950 ENDIF 5316 4951 5317 4952 ! 5318 !-- Writing cross_profiles to netcdf header. This information can be 5319 !-- used by palmplot. Each profile is separated by ",", each cross is 5320 !-- separated by ";". 4953 !-- Writing cross_profiles to netcdf header. This information can be used by palmplot. Each 4954 !-- profile is separated by ",", each cross is separated by ";". 5321 4955 char_cross_profiles = ';' 5322 4956 id_last = 1 … … 5327 4961 IF ( cross_profiles_numb(i) /= 999999 ) THEN 5328 4962 IF ( TRIM( char_cross_profiles ) == ';' ) THEN 5329 char_cross_profiles = TRIM( char_cross_profiles ) // &4963 char_cross_profiles = TRIM( char_cross_profiles ) // & 5330 4964 TRIM( cross_profiles_char(i) ) 5331 4965 ELSEIF ( id_last == cross_profiles_numb(i) ) THEN 5332 char_cross_profiles = TRIM( char_cross_profiles ) // &4966 char_cross_profiles = TRIM( char_cross_profiles ) // & 5333 4967 ',' // TRIM( cross_profiles_char(i) ) 5334 4968 ELSE 5335 char_cross_profiles = TRIM( char_cross_profiles ) // &4969 char_cross_profiles = TRIM( char_cross_profiles ) // & 5336 4970 ';' // TRIM( cross_profiles_char(i) ) 5337 4971 ENDIF … … 5343 4977 char_cross_profiles = TRIM( char_cross_profiles ) // ';' 5344 4978 5345 nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'cross_profiles', &4979 nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'cross_profiles', & 5346 4980 TRIM( char_cross_profiles ) ) 5347 4981 CALL netcdf_handle_error( 'netcdf_define_header', 521 ) … … 5349 4983 ! 5350 4984 !-- Define time coordinate for profiles (unlimited dimension) 5351 CALL netcdf_create_dim( id_set_pr, 'time', NF90_UNLIMITED, & 5352 id_dim_time_pr, 220 ) 5353 CALL netcdf_create_var( id_set_pr, (/ id_dim_time_pr /), 'time', & 5354 NF90_DOUBLE, id_var_time_pr, 'seconds', 'time', & 5355 221, 222, 000 ) 4985 CALL netcdf_create_dim( id_set_pr, 'time', NF90_UNLIMITED, id_dim_time_pr, 220 ) 4986 CALL netcdf_create_var( id_set_pr, (/ id_dim_time_pr /), 'time', NF90_DOUBLE, & 4987 id_var_time_pr, 'seconds', 'time', 221, 222, 000 ) 5356 4988 CALL netcdf_create_att( id_set_pr, id_var_time_pr, 'standard_name', 'time', 000) 5357 4989 CALL netcdf_create_att( id_set_pr, id_var_time_pr, 'axis', 'T', 000) … … 5365 4997 ! 5366 4998 !-- Define the z-axes (each variable gets its own z-axis) 5367 CALL netcdf_create_dim( id_set_pr, & 5368 'z' // TRIM( data_output_pr(i) ), & 5369 nzt+2-nzb, id_dim_z_pr(i,0), 223 ) 5370 CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,0) /), & 5371 'z' // TRIM( data_output_pr(i) ), & 5372 NF90_DOUBLE, id_var_z_pr(i,0), & 4999 CALL netcdf_create_dim( id_set_pr, 'z' // TRIM( data_output_pr(i) ), nzt+2-nzb, & 5000 id_dim_z_pr(i,0), 223 ) 5001 CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,0) /), 'z' // & 5002 TRIM( data_output_pr(i) ), NF90_DOUBLE, id_var_z_pr(i,0), & 5373 5003 'meters', '', 224, 225, 000 ) 5374 CALL netcdf_create_att( id_set_pr, id_var_z_pr(i,0), 'axis', & 5375 'Z', 000) 5004 CALL netcdf_create_att( id_set_pr, id_var_z_pr(i,0), 'axis', 'Z', 000) 5376 5005 ! 5377 5006 !-- Define the variable 5378 CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,0), & 5379 id_dim_time_pr /), data_output_pr(i), & 5380 nc_precision(5), id_var_dopr(i,0), & 5381 TRIM( dopr_unit(i) ), & 5382 TRIM( data_output_pr(i) ), 226, 227, & 5007 CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,0), id_dim_time_pr /), & 5008 data_output_pr(i), nc_precision(5), id_var_dopr(i,0), & 5009 TRIM( dopr_unit(i) ), TRIM( data_output_pr(i) ), 226, 227, & 5383 5010 228 ) 5384 5011 … … 5387 5014 ELSE 5388 5015 ! 5389 !-- If statistic regions are defined, add suffix _SR+#SR to the 5390 !-- names 5016 !-- If statistic regions are defined, add suffix _SR+#SR to the names. 5391 5017 DO j = 0, statistic_regions 5392 5018 WRITE ( suffix, '(''_'',I2.2)' ) j … … 5394 5020 ! 5395 5021 !-- Define the z-axes (each variable gets it own z-axis) 5396 CALL netcdf_create_dim( id_set_pr, 'z' // & 5397 TRIM(data_output_pr(i)) // suffix, & 5022 CALL netcdf_create_dim( id_set_pr, 'z' // TRIM(data_output_pr(i)) // suffix, & 5398 5023 nzt+2-nzb, id_dim_z_pr(i,j), 229 ) 5399 CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,j) /), & 5400 'z' // TRIM(data_output_pr(i)) // & 5401 suffix, NF90_DOUBLE, & 5402 id_var_z_pr(i,j), 'meters', '', & 5403 230, 231, 000 ) 5404 CALL netcdf_create_att( id_set_pr, id_var_z_pr(i,j), 'axis',& 5405 'Z', 000) 5024 CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,j) /),'z' // & 5025 TRIM(data_output_pr(i)) // suffix, NF90_DOUBLE, & 5026 id_var_z_pr(i,j), 'meters', '', 230, 231, 000 ) 5027 CALL netcdf_create_att( id_set_pr, id_var_z_pr(i,j), 'axis', 'Z', 000) 5406 5028 ! 5407 5029 !-- Define the variable 5408 CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,j), & 5409 id_dim_time_pr /), & 5410 TRIM(data_output_pr(i)) // suffix, & 5411 nc_precision(5), id_var_dopr(i,j), & 5412 TRIM( dopr_unit(i) ), & 5413 TRIM( data_output_pr(i) ) // & 5414 ' SR ', 232, 233, 234 ) 5415 5416 var_list = TRIM( var_list ) // TRIM( data_output_pr(i) ) // & 5417 suffix // ';' 5030 CALL netcdf_create_var( id_set_pr, (/ id_dim_z_pr(i,j), id_dim_time_pr /), & 5031 TRIM(data_output_pr(i)) // suffix, nc_precision(5), & 5032 id_var_dopr(i,j), TRIM( dopr_unit(i) ), & 5033 TRIM( data_output_pr(i) ) // ' SR ', 232, 233, 234 ) 5034 5035 var_list = TRIM( var_list ) // TRIM( data_output_pr(i) ) // suffix // ';' 5418 5036 5419 5037 ENDDO … … 5424 5042 5425 5043 ! 5426 !-- Write the list of variables as global attribute (this is used by 5427 !-- restart runs) 5044 !-- Write the list of variables as global attribute (this is used by restart runs). 5428 5045 nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'VAR_LIST', var_list ) 5429 5046 CALL netcdf_handle_error( 'netcdf_define_header', 235 ) … … 5433 5050 DO i = 1, dopr_norm_num 5434 5051 5435 CALL netcdf_create_var( id_set_pr, (/ id_dim_time_pr /), & 5436 'NORM_' // TRIM( dopr_norm_names(i) ), & 5437 nc_precision(5), id_var_norm_dopr(i), & 5438 '', TRIM( dopr_norm_longnames(i) ), 236, & 5052 CALL netcdf_create_var( id_set_pr, (/ id_dim_time_pr /), 'NORM_' // & 5053 TRIM( dopr_norm_names(i) ), nc_precision(5), & 5054 id_var_norm_dopr(i), '', TRIM( dopr_norm_longnames(i) ), 236, & 5439 5055 000, 237 ) 5440 5056 … … 5451 5067 DO j = 0, statistic_regions 5452 5068 5453 nc_stat = NF90_PUT_VAR( id_set_pr, id_var_z_pr(i,j), &5454 hom(nzb:nzt+1,2,dopr_index(i),0), &5455 start = (/ 1 /), &5069 nc_stat = NF90_PUT_VAR( id_set_pr, id_var_z_pr(i,j), & 5070 hom(nzb:nzt+1,2,dopr_index(i),0), & 5071 start = (/ 1 /), & 5456 5072 count = (/ nzt-nzb+2 /) ) 5457 5073 CALL netcdf_handle_error( 'netcdf_define_header', 239 ) … … 5465 5081 ! 5466 5082 !-- Get the list of variables and compare with the actual run. 5467 !-- First var_list_old has to be reset, since GET_ATT does not assign 5468 !-- trailing blanks. 5083 !-- First var_list_old has to be reset, since GET_ATT does not assign trailing blanks. 5469 5084 var_list_old = ' ' 5470 nc_stat = NF90_GET_ATT( id_set_pr, NF90_GLOBAL, 'VAR_LIST', & 5471 var_list_old ) 5085 nc_stat = NF90_GET_ATT( id_set_pr, NF90_GLOBAL, 'VAR_LIST', var_list_old ) 5472 5086 CALL netcdf_handle_error( 'netcdf_define_header', 240 ) 5473 5087 … … 5480 5094 DO j = 0, statistic_regions 5481 5095 WRITE ( suffix, '(''_'',I2.2)' ) j 5482 var_list = TRIM( var_list ) // TRIM( data_output_pr(i) ) // & 5483 suffix // ';' 5096 var_list = TRIM( var_list ) // TRIM( data_output_pr(i) ) // suffix // ';' 5484 5097 ENDDO 5485 5098 ENDIF … … 5488 5101 5489 5102 IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN 5490 message_string = 'netCDF file for vertical profiles ' // & 5491 'from previous run found,' // & 5492 '&but this file cannot be extended due to' // & 5493 ' variable mismatch.' // & 5494 '&New file is created instead.' 5103 message_string = 'netCDF file for vertical profiles ' // 'from previous run found,' //& 5104 '&but this file cannot be extended due to' // & 5105 ' variable mismatch.' // '&New file is created instead.' 5495 5106 CALL message( 'define_netcdf_header', 'PA0254', 0, 1, 0, 6, 0 ) 5496 5107 extend = .FALSE. … … 5499 5110 5500 5111 ! 5501 !-- Get the id of the time coordinate (unlimited coordinate) and its 5502 !-- last index on the file. The next time level is dopr..count+1. 5503 !-- The current time must be larger than the last output time 5504 !-- on the file. 5112 !-- Get the id of the time coordinate (unlimited coordinate) and its last index on the file. 5113 !-- The next time level is dopr..count+1. 5114 !-- The current time must be larger than the last output time on the file. 5505 5115 nc_stat = NF90_INQ_VARID( id_set_pr, 'time', id_var_time_pr ) 5506 5116 CALL netcdf_handle_error( 'netcdf_define_header', 241 ) 5507 5117 5508 nc_stat = NF90_INQUIRE_VARIABLE( id_set_pr, id_var_time_pr, & 5509 dimids = id_dim_time_old ) 5118 nc_stat = NF90_INQUIRE_VARIABLE( id_set_pr, id_var_time_pr, dimids = id_dim_time_old ) 5510 5119 CALL netcdf_handle_error( 'netcdf_define_header', 242 ) 5511 5120 id_dim_time_pr = id_dim_time_old(1) 5512 5121 5513 nc_stat = NF90_INQUIRE_DIMENSION( id_set_pr, id_dim_time_pr, & 5514 len = dopr_time_count ) 5122 nc_stat = NF90_INQUIRE_DIMENSION( id_set_pr, id_dim_time_pr, LEN = dopr_time_count ) 5515 5123 CALL netcdf_handle_error( 'netcdf_define_header', 243 ) 5516 5124 5517 nc_stat = NF90_GET_VAR( id_set_pr, id_var_time_pr, &5518 last_time_coordinate, &5519 start = (/ dopr_time_count /), &5125 nc_stat = NF90_GET_VAR( id_set_pr, id_var_time_pr, & 5126 last_time_coordinate, & 5127 start = (/ dopr_time_count /), & 5520 5128 count = (/ 1 /) ) 5521 5129 CALL netcdf_handle_error( 'netcdf_define_header', 244 ) 5522 5130 5523 5131 IF ( last_time_coordinate(1) >= simulated_time ) THEN 5524 message_string = 'netCDF file for vertical profiles ' // & 5525 'from previous run found,' // & 5526 '&but this file cannot be extended becaus' // & 5527 'e the current output time' // & 5528 '&is less or equal than the last output t' // & 5529 'ime on this file.' // & 5132 message_string = 'netCDF file for vertical profiles ' // 'from previous run found,' //& 5133 '&but this file cannot be extended because' // & 5134 ' the current output time' // & 5135 '&is less or equal than the last output ' // 'time on this file.' // & 5530 5136 '&New file is created instead.' 5531 5137 CALL message( 'define_netcdf_header', 'PA0255', 0, 1, 0, 6, 0 ) … … 5542 5148 5543 5149 IF ( statistic_regions == 0 ) THEN 5544 nc_stat = NF90_INQ_VARID( id_set_pr, data_output_pr(i), & 5545 id_var_dopr(i,0) ) 5150 nc_stat = NF90_INQ_VARID( id_set_pr, data_output_pr(i), id_var_dopr(i,0) ) 5546 5151 CALL netcdf_handle_error( 'netcdf_define_header', 245 ) 5547 5152 ELSE … … 5549 5154 WRITE ( suffix, '(''_'',I2.2)' ) j 5550 5155 netcdf_var_name = TRIM( data_output_pr(i) ) // suffix 5551 nc_stat = NF90_INQ_VARID( id_set_pr, netcdf_var_name, & 5552 id_var_dopr(i,j) ) 5156 nc_stat = NF90_INQ_VARID( id_set_pr, netcdf_var_name, id_var_dopr(i,j) ) 5553 5157 CALL netcdf_handle_error( 'netcdf_define_header', 246 ) 5554 5158 ENDDO … … 5560 5164 !-- Get ids of the normalization variables 5561 5165 DO i = 1, dopr_norm_num 5562 nc_stat = NF90_INQ_VARID( id_set_pr, & 5563 'NORM_' // TRIM( dopr_norm_names(i) ), & 5166 nc_stat = NF90_INQ_VARID( id_set_pr, 'NORM_' // TRIM( dopr_norm_names(i) ), & 5564 5167 id_var_norm_dopr(i) ) 5565 5168 CALL netcdf_handle_error( 'netcdf_define_header', 247 ) … … 5567 5170 5568 5171 ! 5569 !-- Update the title attribute on file 5570 !-- In order to avoid 'data mode' errors if updated attributes are larger 5571 !-- than their original size, NF90_PUT_ATT is called in 'define mode' 5572 !-- enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible 5573 !-- performance loss due to data copying; an alternative strategy would be 5574 !-- to ensure equal attribute size in a job chain. Maybe revise later. 5172 !-- Update the title attribute on file. 5173 !-- In order to avoid 'data mode' errors if updated attributes are larger than their original 5174 !-- size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF 5175 !-- calls. This implies a possible performance loss due to data copying; an alternative 5176 !-- strategy would be to ensure equal attribute size in a job chain. Maybe revise later. 5575 5177 IF ( averaging_interval_pr == 0.0_wp ) THEN 5576 5178 time_average_text = ' ' 5577 5179 ELSE 5578 WRITE (time_average_text, '('', '',F7.1,'' s average'')') & 5579 averaging_interval_pr 5180 WRITE ( time_average_text, '('', '',F7.1,'' s average'')' ) averaging_interval_pr 5580 5181 ENDIF 5581 5182 nc_stat = NF90_REDEF( id_set_pr ) 5582 5183 CALL netcdf_handle_error( 'netcdf_define_header', 437 ) 5583 nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'title', & 5584 TRIM( run_description_header ) // & 5585 TRIM( time_average_text ) ) 5184 nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'title', & 5185 TRIM( run_description_header ) // TRIM( time_average_text ) ) 5586 5186 CALL netcdf_handle_error( 'netcdf_define_header', 248 ) 5587 5187 5588 5188 nc_stat = NF90_ENDDEF( id_set_pr ) 5589 5189 CALL netcdf_handle_error( 'netcdf_define_header', 438 ) 5590 message_string = 'netCDF file for vertical profiles ' // & 5591 'from previous run found.' // & 5190 message_string = 'netCDF file for vertical profiles ' // 'from previous run found.' // & 5592 5191 '&This file will be extended.' 5593 5192 CALL message( 'define_netcdf_header', 'PA0256', 0, 0, 0, 6, 0 ) … … 5600 5199 CALL netcdf_create_global_atts( id_set_ts, 'podsts', TRIM(run_description_header), 329 ) 5601 5200 5602 ! nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'title', & 5603 ! TRIM( run_description_header ) ) 5201 ! nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'title', TRIM( run_description_header ) ) 5604 5202 ! CALL netcdf_handle_error( 'netcdf_define_header', 249 ) 5605 5203 5606 5204 ! 5607 5205 !-- Define time coordinate for time series (unlimited dimension) 5608 CALL netcdf_create_dim( id_set_ts, 'time', NF90_UNLIMITED, & 5609 id_dim_time_ts, 250 ) 5610 CALL netcdf_create_var( id_set_ts, (/ id_dim_time_ts /), 'time', & 5611 NF90_DOUBLE, id_var_time_ts, 'seconds', 'time', & 5612 251, 252, 000 ) 5206 CALL netcdf_create_dim( id_set_ts, 'time', NF90_UNLIMITED, id_dim_time_ts, 250 ) 5207 CALL netcdf_create_var( id_set_ts, (/ id_dim_time_ts /), 'time', NF90_DOUBLE, & 5208 id_var_time_ts, 'seconds', 'time', 251, 252, 000 ) 5613 5209 CALL netcdf_create_att( id_set_ts, id_var_time_ts, 'standard_name', 'time', 000) 5614 5210 CALL netcdf_create_att( id_set_ts, id_var_time_ts, 'axis', 'T', 000) … … 5620 5216 IF ( statistic_regions == 0 ) THEN 5621 5217 5622 CALL netcdf_create_var( id_set_ts, (/ id_dim_time_ts /), & 5623 dots_label(i), nc_precision(6), & 5624 id_var_dots(i,0), & 5625 TRIM( dots_unit(i) ), & 5218 CALL netcdf_create_var( id_set_ts, (/ id_dim_time_ts /), dots_label(i), & 5219 nc_precision(6), id_var_dots(i,0), TRIM( dots_unit(i) ), & 5626 5220 TRIM( dots_label(i) ), 253, 254, 255 ) 5627 5221 … … 5630 5224 ELSE 5631 5225 ! 5632 !-- If statistic regions are defined, add suffix _SR+#SR to the 5633 !-- names 5226 !-- If statistic regions are defined, add suffix _SR+#SR to the names. 5634 5227 DO j = 0, statistic_regions 5635 5228 WRITE ( suffix, '(''_'',I2.2)' ) j 5636 5229 5637 CALL netcdf_create_var( id_set_ts, (/ id_dim_time_ts /), & 5638 TRIM( dots_label(i) ) // suffix, & 5639 nc_precision(6), id_var_dots(i,j), & 5640 TRIM( dots_unit(i) ), & 5641 TRIM( dots_label(i) ) // ' SR ' // & 5230 CALL netcdf_create_var( id_set_ts, (/ id_dim_time_ts /), TRIM( dots_label(i) ) & 5231 // suffix, nc_precision(6), id_var_dots(i,j), & 5232 TRIM( dots_unit(i) ), TRIM( dots_label(i) ) // ' SR ' //& 5642 5233 suffix(2:2), 256, 257, 347) 5643 5234 … … 5652 5243 5653 5244 ! 5654 !-- Write the list of variables as global attribute (this is used by 5655 !-- restart runs) 5245 !-- Write the list of variables as global attribute (this is used by restart runs). 5656 5246 nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'VAR_LIST', var_list ) 5657 5247 CALL netcdf_handle_error( 'netcdf_define_header', 258 ) … … 5667 5257 ! 5668 5258 !-- Get the list of variables and compare with the actual run. 5669 !-- First var_list_old has to be reset, since GET_ATT does not assign 5670 !-- trailing blanks. 5259 !-- First var_list_old has to be reset, since GET_ATT does not assign trailing blanks. 5671 5260 var_list_old = ' ' 5672 nc_stat = NF90_GET_ATT( id_set_ts, NF90_GLOBAL, 'VAR_LIST', & 5673 var_list_old ) 5261 nc_stat = NF90_GET_ATT( id_set_ts, NF90_GLOBAL, 'VAR_LIST', var_list_old ) 5674 5262 CALL netcdf_handle_error( 'netcdf_define_header', 260 ) 5675 5263 … … 5683 5271 DO j = 0, statistic_regions 5684 5272 WRITE ( suffix, '(''_'',I2.2)' ) j 5685 var_list = TRIM( var_list ) // TRIM( dots_label(i) ) // & 5686 suffix // ';' 5273 var_list = TRIM( var_list ) // TRIM( dots_label(i) ) // suffix // ';' 5687 5274 ENDDO 5688 5275 ENDIF … … 5691 5278 5692 5279 IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN 5693 message_string = 'netCDF file for time series ' // & 5694 'from previous run found,' // & 5695 '&but this file cannot be extended due to' // & 5696 ' variable mismatch.' // & 5697 '&New file is created instead.' 5280 message_string = 'netCDF file for time series ' // 'from previous run found,' // & 5281 '&but this file cannot be extended due to' // & 5282 ' variable mismatch.' // '&New file is created instead.' 5698 5283 CALL message( 'define_netcdf_header', 'PA0257', 0, 1, 0, 6, 0 ) 5699 5284 extend = .FALSE. … … 5702 5287 5703 5288 ! 5704 !-- Get the id of the time coordinate (unlimited coordinate) and its 5705 !-- last index on the file. The next time level is dots..count+1. 5706 !-- The current time must be larger than the last output time 5707 !-- on the file. 5289 !-- Get the id of the time coordinate (unlimited coordinate) and its last index on the file. 5290 !-- The next time level is dots..count+1. 5291 !-- The current time must be larger than the last output time on the file. 5708 5292 nc_stat = NF90_INQ_VARID( id_set_ts, 'time', id_var_time_ts ) 5709 5293 CALL netcdf_handle_error( 'netcdf_define_header', 261 ) 5710 5294 5711 nc_stat = NF90_INQUIRE_VARIABLE( id_set_ts, id_var_time_ts, & 5712 dimids = id_dim_time_old ) 5295 nc_stat = NF90_INQUIRE_VARIABLE( id_set_ts, id_var_time_ts, dimids = id_dim_time_old ) 5713 5296 CALL netcdf_handle_error( 'netcdf_define_header', 262 ) 5714 5297 id_dim_time_ts = id_dim_time_old(1) 5715 5298 5716 nc_stat = NF90_INQUIRE_DIMENSION( id_set_ts, id_dim_time_ts, & 5717 len = dots_time_count ) 5299 nc_stat = NF90_INQUIRE_DIMENSION( id_set_ts, id_dim_time_ts, LEN = dots_time_count ) 5718 5300 CALL netcdf_handle_error( 'netcdf_define_header', 263 ) 5719 5301 5720 nc_stat = NF90_GET_VAR( id_set_ts, id_var_time_ts, &5721 last_time_coordinate, &5722 start = (/ dots_time_count /), &5302 nc_stat = NF90_GET_VAR( id_set_ts, id_var_time_ts, & 5303 last_time_coordinate, & 5304 start = (/ dots_time_count /), & 5723 5305 count = (/ 1 /) ) 5724 5306 CALL netcdf_handle_error( 'netcdf_define_header', 264 ) 5725 5307 5726 5308 IF ( last_time_coordinate(1) >= simulated_time ) THEN 5727 message_string = 'netCDF file for time series ' // & 5728 'from previous run found,' // & 5729 '&but this file cannot be extended becaus' // & 5730 'e the current output time' // & 5731 '&is less or equal than the last output t' // & 5732 'ime on this file.' // & 5309 message_string = 'netCDF file for time series ' // 'from previous run found,' // & 5310 '&but this file cannot be extended because' // & 5311 ' the current output time' // & 5312 '&is less or equal than the last output ' // 'time on this file.' // & 5733 5313 '&New file is created instead.' 5734 5314 CALL message( 'define_netcdf_header', 'PA0258', 0, 1, 0, 6, 0 ) … … 5745 5325 5746 5326 IF ( statistic_regions == 0 ) THEN 5747 nc_stat = NF90_INQ_VARID( id_set_ts, dots_label(i), & 5748 id_var_dots(i,0) ) 5327 nc_stat = NF90_INQ_VARID( id_set_ts, dots_label(i), id_var_dots(i,0) ) 5749 5328 CALL netcdf_handle_error( 'netcdf_define_header', 265 ) 5750 5329 ELSE … … 5752 5331 WRITE ( suffix, '(''_'',I2.2)' ) j 5753 5332 netcdf_var_name = TRIM( dots_label(i) ) // suffix 5754 nc_stat = NF90_INQ_VARID( id_set_ts, netcdf_var_name, & 5755 id_var_dots(i,j) ) 5333 nc_stat = NF90_INQ_VARID( id_set_ts, netcdf_var_name, id_var_dots(i,j) ) 5756 5334 CALL netcdf_handle_error( 'netcdf_define_header', 266 ) 5757 5335 ENDDO … … 5761 5339 5762 5340 ! 5763 !-- Update the title attribute on file 5764 !-- In order to avoid 'data mode' errors if updated attributes are larger 5765 !-- than their original size, NF90_PUT_ATT is called in 'define mode' 5766 !-- enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible 5767 !-- performance loss due to data copying; an alternative strategy would be 5768 !-- to ensure equal attribute size in a job chain. Maybe revise later. 5341 !-- Update the title attribute on file. 5342 !-- In order to avoid 'data mode' errors if updated attributes are larger than their original 5343 !-- size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF 5344 !-- calls. This implies a possible performance loss due to data copying; an alternative 5345 !-- strategy would be to ensure equal attribute size in a job chain. Maybe revise later. 5769 5346 nc_stat = NF90_REDEF( id_set_ts ) 5770 5347 CALL netcdf_handle_error( 'netcdf_define_header', 439 ) 5771 nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'title', & 5772 TRIM( run_description_header ) ) 5348 nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'title', TRIM( run_description_header ) ) 5773 5349 CALL netcdf_handle_error( 'netcdf_define_header', 267 ) 5774 5350 nc_stat = NF90_ENDDEF( id_set_ts ) 5775 5351 CALL netcdf_handle_error( 'netcdf_define_header', 440 ) 5776 message_string = 'netCDF file for time series ' // & 5777 'from previous run found.' // & 5352 message_string = 'netCDF file for time series ' // 'from previous run found.' // & 5778 5353 '&This file will be extended.' 5779 5354 CALL message( 'define_netcdf_header', 'PA0259', 0, 0, 0, 6, 0 ) … … 5785 5360 !-- Define some global attributes of the dataset 5786 5361 IF ( averaging_interval_sp /= 0.0_wp ) THEN 5787 WRITE (time_average_text,'('', '',F7.1,'' s average'')') & 5788 averaging_interval_sp 5789 nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', & 5790 TRIM( run_description_header ) // & 5791 TRIM( time_average_text ) ) 5362 WRITE ( time_average_text,'('', '',F7.1,'' s average'')' ) averaging_interval_sp 5363 nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', & 5364 TRIM( run_description_header ) // TRIM( time_average_text ) ) 5792 5365 CALL netcdf_handle_error( 'netcdf_define_header', 268 ) 5793 5366 5794 5367 WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval_sp 5795 nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'time_avg', & 5796 TRIM( time_average_text ) ) 5368 nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'time_avg', TRIM( time_average_text ) ) 5797 5369 ELSE 5798 nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', &5370 nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', & 5799 5371 TRIM( run_description_header ) ) 5800 5372 ENDIF … … 5803 5375 ! 5804 5376 !-- Define time coordinate for spectra (unlimited dimension) 5805 CALL netcdf_create_dim( id_set_sp, 'time', NF90_UNLIMITED, & 5806 id_dim_time_sp, 270 ) 5807 CALL netcdf_create_var( id_set_sp, (/ id_dim_time_sp /), 'time', & 5808 NF90_DOUBLE, id_var_time_sp, 'seconds', 'time', & 5809 271, 272, 000 ) 5377 CALL netcdf_create_dim( id_set_sp, 'time', NF90_UNLIMITED, id_dim_time_sp, 270 ) 5378 CALL netcdf_create_var( id_set_sp, (/ id_dim_time_sp /), 'time', NF90_DOUBLE, & 5379 id_var_time_sp, 'seconds', 'time', 271, 272, 000 ) 5810 5380 CALL netcdf_create_att( id_set_sp, id_var_time_sp, 'standard_name', 'time', 000) 5811 5381 CALL netcdf_create_att( id_set_sp, id_var_time_sp, 'axis', 'T', 000) 5812 5382 ! 5813 5383 !-- Define the spatial dimensions and coordinates for spectra. 5814 !-- First, determine the number of vertical levels for which spectra 5815 !-- are to be output. 5384 !-- First, determine the number of vertical levels for which spectra are to be output. 5816 5385 ns = 1 5817 5386 DO WHILE ( comp_spectra_level(ns) /= 999999 .AND. ns <= 100 ) … … 5823 5392 !-- Define vertical coordinate grid (zu grid) 5824 5393 CALL netcdf_create_dim( id_set_sp, 'zu_sp', ns, id_dim_zu_sp, 273 ) 5825 CALL netcdf_create_var( id_set_sp, (/ id_dim_zu_sp /), 'zu_sp', & 5826 NF90_DOUBLE, id_var_zu_sp, 'meters', '', & 5827 274, 275, 000 ) 5394 CALL netcdf_create_var( id_set_sp, (/ id_dim_zu_sp /), 'zu_sp', NF90_DOUBLE, & 5395 id_var_zu_sp, 'meters', '', 274, 275, 000 ) 5828 5396 CALL netcdf_create_att( id_set_sp, id_var_zu_sp, 'axis', 'Z', 000) 5829 5397 ! 5830 5398 !-- Define vertical coordinate grid (zw grid) 5831 5399 CALL netcdf_create_dim( id_set_sp, 'zw_sp', ns, id_dim_zw_sp, 276 ) 5832 CALL netcdf_create_var( id_set_sp, (/ id_dim_zw_sp /), 'zw_sp', & 5833 NF90_DOUBLE, id_var_zw_sp, 'meters', '', & 5834 277, 278, 000 ) 5400 CALL netcdf_create_var( id_set_sp, (/ id_dim_zw_sp /), 'zw_sp', NF90_DOUBLE, & 5401 id_var_zw_sp, 'meters', '', 277, 278, 000 ) 5835 5402 CALL netcdf_create_att( id_set_sp, id_var_zw_sp, 'axis', 'Z', 000) 5836 5403 ! 5837 5404 !-- Define x-axis 5838 5405 CALL netcdf_create_dim( id_set_sp, 'k_x', nx/2, id_dim_x_sp, 279 ) 5839 CALL netcdf_create_var( id_set_sp, (/ id_dim_x_sp /), 'k_x', & 5840 NF90_DOUBLE, id_var_x_sp, 'm-1', '', 280, & 5841 281, 000 ) 5406 CALL netcdf_create_var( id_set_sp, (/ id_dim_x_sp /), 'k_x', NF90_DOUBLE, & 5407 id_var_x_sp, 'm-1', '', 280, 281, 000 ) 5842 5408 CALL netcdf_create_att( id_set_sp, id_var_x_sp, 'axis', 'X', 000) 5843 5409 ! 5844 5410 !-- Define y-axis 5845 5411 CALL netcdf_create_dim( id_set_sp, 'k_y', ny/2, id_dim_y_sp, 282 ) 5846 CALL netcdf_create_var( id_set_sp, (/ id_dim_y_sp /), 'k_y', & 5847 NF90_DOUBLE, id_var_y_sp, 'm-1', '', 283, & 5848 284, 000 ) 5412 CALL netcdf_create_var( id_set_sp, (/ id_dim_y_sp /), 'k_y', NF90_DOUBLE, & 5413 id_var_y_sp, 'm-1', '', 283, 284, 000 ) 5849 5414 CALL netcdf_create_att( id_set_sp, id_var_y_sp, 'axis', 'Y', 000) 5850 5415 ! … … 5873 5438 CASE DEFAULT 5874 5439 ! 5875 !-- Check for user-defined quantities (found, grid_x and grid_y 5876 !-- are dummies) 5440 !-- Check for user-defined quantities (found, grid_x and grid_y are dummies). 5877 5441 IF ( user_module_enabled ) THEN 5878 CALL user_define_netcdf_grid( data_output_sp(i), found, &5879 grid_ x, grid_y, grid_z )5442 CALL user_define_netcdf_grid( data_output_sp(i), found, grid_x, grid_y, & 5443 grid_z ) 5880 5444 ENDIF 5881 5445 … … 5888 5452 netcdf_var_name = TRIM( data_output_sp(i) ) // '_x' 5889 5453 IF ( TRIM( grid_z ) == 'zw' ) THEN 5890 CALL netcdf_create_var( id_set_sp, (/ id_dim_x_sp, & 5891 id_dim_zw_sp, id_dim_time_sp /), & 5892 netcdf_var_name, nc_precision(7), & 5893 id_var_dospx(i), 'unknown', & 5894 netcdf_var_name, 285, 286, 287 ) 5454 CALL netcdf_create_var( id_set_sp, (/ id_dim_x_sp, id_dim_zw_sp, & 5455 id_dim_time_sp /), netcdf_var_name, nc_precision(7), & 5456 id_var_dospx(i), 'unknown', netcdf_var_name, 285, 286, & 5457 287 ) 5895 5458 ELSE 5896 CALL netcdf_create_var( id_set_sp, (/ id_dim_x_sp, & 5897 id_dim_zu_sp, id_dim_time_sp /), & 5898 netcdf_var_name, nc_precision(7), & 5899 id_var_dospx(i), 'unknown', & 5900 netcdf_var_name, 285, 286, 287 ) 5459 CALL netcdf_create_var( id_set_sp, (/ id_dim_x_sp, id_dim_zu_sp, & 5460 id_dim_time_sp /), netcdf_var_name, nc_precision(7), & 5461 id_var_dospx(i), 'unknown', netcdf_var_name, 285, 286, & 5462 287 ) 5901 5463 ENDIF 5902 5464 … … 5911 5473 netcdf_var_name = TRIM( data_output_sp(i) ) // '_y' 5912 5474 IF ( TRIM( grid_z ) == 'zw' ) THEN 5913 CALL netcdf_create_var( id_set_sp, (/ id_dim_y_sp, & 5914 id_dim_zw_sp, id_dim_time_sp /), & 5915 netcdf_var_name, nc_precision(7), & 5916 id_var_dospy(i), 'unknown', & 5917 netcdf_var_name, 288, 289, 290 ) 5475 CALL netcdf_create_var( id_set_sp, (/ id_dim_y_sp, id_dim_zw_sp, & 5476 id_dim_time_sp /), netcdf_var_name, nc_precision(7), & 5477 id_var_dospy(i), 'unknown', netcdf_var_name, 288, 289, & 5478 290 ) 5918 5479 ELSE 5919 CALL netcdf_create_var( id_set_sp, (/ id_dim_y_sp, & 5920 id_dim_zu_sp, id_dim_time_sp /), & 5921 netcdf_var_name, nc_precision(7), & 5922 id_var_dospy(i), 'unknown', & 5923 netcdf_var_name, 288, 289, 290 ) 5480 CALL netcdf_create_var( id_set_sp, (/ id_dim_y_sp, id_dim_zu_sp, & 5481 id_dim_time_sp /), netcdf_var_name, nc_precision(7), & 5482 id_var_dospy(i), 'unknown', netcdf_var_name, 288, 289, & 5483 290 ) 5924 5484 ENDIF 5925 5485 … … 5933 5493 5934 5494 ! 5935 !-- Write the list of variables as global attribute (this is used by 5936 !-- restart runs) 5495 !-- Write the list of variables as global attribute (this is used by restart runs) 5937 5496 nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'VAR_LIST', var_list ) 5938 5497 CALL netcdf_handle_error( 'netcdf_define_header', 291 ) … … 5950 5509 !-- Write zu data 5951 5510 netcdf_data(1:ns) = zu( comp_spectra_level(1:ns) ) 5952 nc_stat = NF90_PUT_VAR( id_set_sp, id_var_zu_sp, netcdf_data, & 5953 start = (/ 1 /), count = (/ ns /) ) 5511 nc_stat = NF90_PUT_VAR( id_set_sp, id_var_zu_sp, netcdf_data, & 5512 start = (/ 1 /), & 5513 count = (/ ns /) ) 5954 5514 CALL netcdf_handle_error( 'netcdf_define_header', 293 ) 5955 5515 … … 5957 5517 !-- Write zw data 5958 5518 netcdf_data(1:ns) = zw( comp_spectra_level(1:ns) ) 5959 nc_stat = NF90_PUT_VAR( id_set_sp, id_var_zw_sp, netcdf_data, & 5960 start = (/ 1 /), count = (/ ns /) ) 5519 nc_stat = NF90_PUT_VAR( id_set_sp, id_var_zw_sp, netcdf_data, & 5520 start = (/ 1 /), & 5521 count = (/ ns /) ) 5961 5522 CALL netcdf_handle_error( 'netcdf_define_header', 294 ) 5962 5523 … … 5970 5531 ENDDO 5971 5532 5972 nc_stat = NF90_PUT_VAR( id_set_sp, id_var_x_sp, netcdf_data, & 5973 start = (/ 1 /), count = (/ nx/2 /) ) 5533 nc_stat = NF90_PUT_VAR( id_set_sp, id_var_x_sp, netcdf_data, & 5534 start = (/ 1 /), & 5535 count = (/ nx/2 /) ) 5974 5536 CALL netcdf_handle_error( 'netcdf_define_header', 295 ) 5975 5537 … … 5981 5543 ENDDO 5982 5544 5983 nc_stat = NF90_PUT_VAR( id_set_sp, id_var_y_sp, netcdf_data, & 5984 start = (/ 1 /), count = (/ ny/2 /) ) 5545 nc_stat = NF90_PUT_VAR( id_set_sp, id_var_y_sp, netcdf_data, & 5546 start = (/ 1 /), & 5547 count = (/ ny/2 /) ) 5985 5548 CALL netcdf_handle_error( 'netcdf_define_header', 296 ) 5986 5549 … … 5992 5555 ! 5993 5556 !-- Get the list of variables and compare with the actual run. 5994 !-- First var_list_old has to be reset, since GET_ATT does not assign 5995 !-- trailing blanks. 5557 !-- First var_list_old has to be reset, since GET_ATT does not assign trailing blanks. 5996 5558 var_list_old = ' ' 5997 nc_stat = NF90_GET_ATT( id_set_sp, NF90_GLOBAL, 'VAR_LIST', & 5998 var_list_old ) 5559 nc_stat = NF90_GET_ATT( id_set_sp, NF90_GLOBAL, 'VAR_LIST', var_list_old ) 5999 5560 CALL netcdf_handle_error( 'netcdf_define_header', 297 ) 6000 5561 var_list = ';' 6001 5562 i = 1 6002 DO WHILE ( data_output_sp(i) /= ' ' .AND. i <= 10 )5563 DO WHILE ( data_output_sp(i) /= ' ' .AND. i <= 10 ) 6003 5564 6004 5565 IF ( INDEX( spectra_direction(i), 'x' ) /= 0 ) THEN … … 6017 5578 6018 5579 IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN 6019 message_string = 'netCDF file for spectra ' // & 6020 'from previous run found,' // & 6021 '&but this file cannot be extended due to' // & 6022 ' variable mismatch.' // & 6023 '&New file is created instead.' 5580 message_string = 'netCDF file for spectra ' // 'from previous run found,' // & 5581 '&but this file cannot be extended due to' // & 5582 ' variable mismatch.' // '&New file is created instead.' 6024 5583 CALL message( 'define_netcdf_header', 'PA0260', 0, 1, 0, 6, 0 ) 6025 5584 extend = .FALSE. … … 6028 5587 6029 5588 ! 6030 !-- Determine the number of current vertical levels for which spectra 6031 !-- shall be output 5589 !-- Determine the number of current vertical levels for which spectra shall be output. 6032 5590 ns = 1 6033 DO WHILE ( comp_spectra_level(ns) /= 999999 .AND. ns <= 100 )5591 DO WHILE ( comp_spectra_level(ns) /= 999999 .AND. ns <= 100 ) 6034 5592 ns = ns + 1 6035 5593 ENDDO … … 6041 5599 CALL netcdf_handle_error( 'netcdf_define_header', 298 ) 6042 5600 6043 nc_stat = NF90_INQUIRE_VARIABLE( id_set_sp, id_var_zu_sp, & 6044 dimids = id_dim_zu_sp_old ) 5601 nc_stat = NF90_INQUIRE_VARIABLE( id_set_sp, id_var_zu_sp, dimids = id_dim_zu_sp_old ) 6045 5602 CALL netcdf_handle_error( 'netcdf_define_header', 299 ) 6046 5603 id_dim_zu_sp = id_dim_zu_sp_old(1) 6047 5604 6048 nc_stat = NF90_INQUIRE_DIMENSION( id_set_sp, id_dim_zu_sp, & 6049 len = ns_old ) 5605 nc_stat = NF90_INQUIRE_DIMENSION( id_set_sp, id_dim_zu_sp, LEN = ns_old ) 6050 5606 CALL netcdf_handle_error( 'netcdf_define_header', 300 ) 6051 5607 6052 5608 IF ( ns /= ns_old ) THEN 6053 message_string = 'netCDF file for spectra ' // & 6054 ' from previous run found,' // & 6055 '&but this file cannot be extended due to' // & 6056 ' mismatch in number of' // & 6057 ' vertical levels.' // & 5609 message_string = 'netCDF file for spectra ' // ' from previous run found,' // & 5610 '&but this file cannot be extended due to' // & 5611 ' mismatch in number of' // ' vertical levels.' // & 6058 5612 '&New file is created instead.' 6059 5613 CALL message( 'define_netcdf_header', 'PA0261', 0, 1, 0, 6, 0 ) … … 6071 5625 DO i = 1, ns 6072 5626 IF ( zu(comp_spectra_level(i)) /= netcdf_data(i) ) THEN 6073 message_string = 'netCDF file for spectra ' // & 6074 ' from previous run found,' // & 6075 '&but this file cannot be extended due to' // & 6076 ' mismatch in heights of' // & 6077 ' vertical levels.' // & 5627 message_string = 'netCDF file for spectra ' // ' from previous run found,' // & 5628 '&but this file cannot be extended due to' // & 5629 ' mismatch in heights of' // ' vertical levels.' // & 6078 5630 '&New file is created instead.' 6079 5631 CALL message( 'define_netcdf_header', 'PA0262', 0, 1, 0, 6, 0 ) … … 6086 5638 6087 5639 ! 6088 !-- Get the id of the time coordinate (unlimited coordinate) and its 6089 !-- last index on the file. The next time level is plsp..count+1. 6090 !-- The current time must be larger than the last output time 6091 !-- on the file. 5640 !-- Get the id of the time coordinate (unlimited coordinate) and its last index on the file. 5641 !-- The next time level is plsp..count+1. 5642 !-- The current time must be larger than the last output time on the file. 6092 5643 nc_stat = NF90_INQ_VARID( id_set_sp, 'time', id_var_time_sp ) 6093 5644 CALL netcdf_handle_error( 'netcdf_define_header', 302 ) 6094 5645 6095 nc_stat = NF90_INQUIRE_VARIABLE( id_set_sp, id_var_time_sp, & 6096 dimids = id_dim_time_old ) 5646 nc_stat = NF90_INQUIRE_VARIABLE( id_set_sp, id_var_time_sp, dimids = id_dim_time_old ) 6097 5647 CALL netcdf_handle_error( 'netcdf_define_header', 303 ) 6098 5648 id_dim_time_sp = id_dim_time_old(1) 6099 5649 6100 nc_stat = NF90_INQUIRE_DIMENSION( id_set_sp, id_dim_time_sp, & 6101 len = dosp_time_count ) 5650 nc_stat = NF90_INQUIRE_DIMENSION( id_set_sp, id_dim_time_sp, LEN = dosp_time_count ) 6102 5651 CALL netcdf_handle_error( 'netcdf_define_header', 304 ) 6103 5652 6104 nc_stat = NF90_GET_VAR( id_set_sp, id_var_time_sp, &6105 last_time_coordinate, &6106 start = (/ dosp_time_count /), &5653 nc_stat = NF90_GET_VAR( id_set_sp, id_var_time_sp, & 5654 last_time_coordinate, & 5655 start = (/ dosp_time_count /), & 6107 5656 count = (/ 1 /) ) 6108 5657 CALL netcdf_handle_error( 'netcdf_define_header', 305 ) 6109 5658 6110 5659 IF ( last_time_coordinate(1) >= simulated_time ) THEN 6111 message_string = 'netCDF file for spectra ' // & 6112 'from previous run found,' // & 6113 '&but this file cannot be extended becaus' // & 6114 'e the current output time' // & 6115 '&is less or equal than the last output t' // & 6116 'ime on this file.' // & 5660 message_string = 'netCDF file for spectra ' // 'from previous run found,' // & 5661 '&but this file cannot be extended because' // & 5662 ' the current output time' // & 5663 '&is less or equal than the last output ' // 'time on this file.' // & 6117 5664 '&New file is created instead.' 6118 5665 CALL message( 'define_netcdf_header', 'PA0263', 0, 1, 0, 6, 0 ) … … 6126 5673 !-- Now get the variable ids. 6127 5674 i = 1 6128 DO WHILE ( data_output_sp(i) /= ' ' .AND. i <= 10 )5675 DO WHILE ( data_output_sp(i) /= ' ' .AND. i <= 10 ) 6129 5676 6130 5677 IF ( INDEX( spectra_direction(i), 'x' ) /= 0 ) THEN 6131 5678 netcdf_var_name = TRIM( data_output_sp(i) ) // '_x' 6132 nc_stat = NF90_INQ_VARID( id_set_sp, netcdf_var_name, & 6133 id_var_dospx(i) ) 5679 nc_stat = NF90_INQ_VARID( id_set_sp, netcdf_var_name, id_var_dospx(i) ) 6134 5680 CALL netcdf_handle_error( 'netcdf_define_header', 306 ) 6135 5681 ENDIF … … 6137 5683 IF ( INDEX( spectra_direction(i), 'y' ) /= 0 ) THEN 6138 5684 netcdf_var_name = TRIM( data_output_sp(i) ) // '_y' 6139 nc_stat = NF90_INQ_VARID( id_set_sp, netcdf_var_name, & 6140 id_var_dospy(i) ) 5685 nc_stat = NF90_INQ_VARID( id_set_sp, netcdf_var_name, id_var_dospy(i) ) 6141 5686 CALL netcdf_handle_error( 'netcdf_define_header', 307 ) 6142 5687 ENDIF … … 6147 5692 6148 5693 ! 6149 !-- Update the title attribute on file 6150 !-- In order to avoid 'data mode' errors if updated attributes are larger 6151 !-- than their original size, NF90_PUT_ATT is called in 'define mode' 6152 !-- enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible 6153 !-- performance loss due to data copying; an alternative strategy would be 6154 !-- to ensure equal attribute size in a job chain. Maybe revise later. 5694 !-- Update the title attribute on file. 5695 !-- In order to avoid 'data mode' errors if updated attributes are larger than their original 5696 !-- size, NF90_PUT_ATT is called in 'define mode'enclosed by NF90_REDEF and NF90_ENDDEF 5697 !-- calls. This implies a possible performance loss due to data copying; an alternative 5698 !-- strategy would be to ensure equal attribute size in a job chain. Maybe revise later. 6155 5699 nc_stat = NF90_REDEF( id_set_sp ) 6156 5700 CALL netcdf_handle_error( 'netcdf_define_header', 441 ) 6157 5701 IF ( averaging_interval_sp /= 0.0_wp ) THEN 6158 WRITE (time_average_text,'('', '',F7.1,'' s average'')') & 6159 averaging_interval_sp 6160 nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', & 6161 TRIM( run_description_header ) // & 6162 TRIM( time_average_text ) ) 5702 WRITE ( time_average_text, '('', '',F7.1,'' s average'')' ) averaging_interval_sp 5703 nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', & 5704 TRIM( run_description_header ) // TRIM( time_average_text ) ) 6163 5705 CALL netcdf_handle_error( 'netcdf_define_header', 308 ) 6164 5706 6165 5707 WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval_sp 6166 nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'time_avg', & 6167 TRIM( time_average_text ) ) 5708 nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'time_avg', TRIM( time_average_text ) ) 6168 5709 ELSE 6169 nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', &5710 nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', & 6170 5711 TRIM( run_description_header ) ) 6171 5712 ENDIF … … 6173 5714 nc_stat = NF90_ENDDEF( id_set_sp ) 6174 5715 CALL netcdf_handle_error( 'netcdf_define_header', 442 ) 6175 message_string = 'netCDF file for spectra ' // & 6176 'from previous run found.' // & 5716 message_string = 'netCDF file for spectra ' // 'from previous run found.' // & 6177 5717 '&This file will be extended.' 6178 5718 CALL message( 'define_netcdf_header', 'PA0264', 0, 0, 0, 6, 0 ) … … 6184 5724 ! 6185 5725 !-- Define some global attributes of the dataset 6186 ! nc_stat = NF90_PUT_ATT( id_set_prt, NF90_GLOBAL, 'title', & 6187 ! TRIM( run_description_header ) ) 5726 ! nc_stat = NF90_PUT_ATT( id_set_prt, NF90_GLOBAL, 'title', TRIM( run_description_header ) ) 6188 5727 ! CALL netcdf_handle_error( 'netcdf_define_header', 310 ) 6189 5728 6190 5729 ! 6191 5730 !-- Define time coordinate for particles (unlimited dimension) 6192 ! CALL netcdf_create_dim( id_set_prt, 'time', NF90_UNLIMITED, & 6193 ! id_dim_time_prt, 311 ) 6194 ! CALL netcdf_create_var( id_set_prt, (/ id_dim_time_prt /), 'time', & 6195 ! NF90_DOUBLE, id_var_time_prt, 'seconds', '', & 6196 ! 312, 313, 000 ) 5731 ! CALL netcdf_create_dim( id_set_prt, 'time', NF90_UNLIMITED, id_dim_time_prt, 311 ) 5732 ! CALL netcdf_create_var( id_set_prt, (/ id_dim_time_prt /), 'time', NF90_DOUBLE, & 5733 ! id_var_time_prt, 'seconds', '', 312, 313, 000 ) 6197 5734 ! 6198 5735 !-- netCDF4 allows more than one unlimited dimension 6199 ! CALL netcdf_create_dim( id_set_prt, 'particle_number', & 6200 ! NF90_UNLIMITED, id_dim_prtnum, 314 ) 6201 6202 ! CALL netcdf_create_var( id_set_prt, (/ id_dim_prtnum /), & 6203 ! 'particle_number', NF90_DOUBLE, & 6204 ! id_var_prtnum, 'particle number', '', 315, & 6205 ! 316, 000 ) 5736 ! CALL netcdf_create_dim( id_set_prt, 'particle_number', NF90_UNLIMITED, id_dim_prtnum, & 5737 ! 314 ) 5738 5739 ! CALL netcdf_create_var( id_set_prt, (/ id_dim_prtnum /), 'particle_number', NF90_DOUBLE, & 5740 ! id_var_prtnum, 'particle number', '', 315, 316, 000 ) 6206 5741 ! 6207 5742 !-- Define variable which contains the real number of particles in use 6208 ! CALL netcdf_create_var( id_set_prt, (/ id_dim_time_prt /), & 6209 ! 'real_num_of_prt', NF90_DOUBLE, & 6210 ! id_var_rnop_prt, 'particle number', '', 317, & 6211 ! 318, 000 ) 5743 ! CALL netcdf_create_var( id_set_prt, (/ id_dim_time_prt /), 'real_num_of_prt', & 5744 ! NF90_DOUBLE, id_var_rnop_prt, 'particle number', '', 317, 318, & 5745 ! 000 ) 6212 5746 ! 6213 5747 !-- Define the variables 6214 5748 ! DO i = 1, 17 6215 5749 6216 ! CALL netcdf_create_var( id_set_prt, (/ id_dim_prtnum, & 6217 ! id_dim_time_prt /), prt_var_names(i), & 6218 ! nc_precision(8), id_var_prt(i), & 6219 ! TRIM( prt_var_units(i) ), & 6220 ! TRIM( prt_var_names(i) ), 319, 320, 321 ) 5750 ! CALL netcdf_create_var( id_set_prt, (/ id_dim_prtnum, id_dim_time_prt /), & 5751 ! prt_var_names(i), nc_precision(8), id_var_prt(i), & 5752 ! TRIM( prt_var_units(i) ), TRIM( prt_var_names(i) ), 319, 320, & 5753 ! 321 ) 6221 5754 6222 5755 ! ENDDO … … 6232 5765 6233 5766 ! 6234 !-- Get the id of the time coordinate (unlimited coordinate) and its 6235 !-- last index on the file. The next time level is prt..count+1. 6236 !-- The current time must be larger than the last output time 6237 !-- on the file. 5767 !-- Get the id of the time coordinate (unlimited coordinate) and its last index on the file. 5768 !-- The next time level is prt..count+1. 5769 !-- The current time must be larger than the last output time on the file. 6238 5770 ! nc_stat = NF90_INQ_VARID( id_set_prt, 'time', id_var_time_prt ) 6239 5771 ! CALL netcdf_handle_error( 'netcdf_define_header', 323 ) 6240 5772 6241 ! nc_stat = NF90_INQUIRE_VARIABLE( id_set_prt, id_var_time_prt, & 6242 ! dimids = id_dim_time_old ) 5773 ! nc_stat = NF90_INQUIRE_VARIABLE( id_set_prt, id_var_time_prt, dimids = id_dim_time_old ) 6243 5774 ! CALL netcdf_handle_error( 'netcdf_define_header', 324 ) 6244 5775 ! id_dim_time_prt = id_dim_time_old(1) 6245 5776 6246 ! nc_stat = NF90_INQUIRE_DIMENSION( id_set_prt, id_dim_time_prt, & 6247 ! len = prt_time_count ) 5777 ! nc_stat = NF90_INQUIRE_DIMENSION( id_set_prt, id_dim_time_prt, LEN = prt_time_count ) 6248 5778 ! CALL netcdf_handle_error( 'netcdf_define_header', 325 ) 6249 5779 6250 ! nc_stat = NF90_GET_VAR( id_set_prt, id_var_time_prt, &6251 ! last_time_coordinate, &6252 ! start = (/ prt_time_count /), &5780 ! nc_stat = NF90_GET_VAR( id_set_prt, id_var_time_prt, & 5781 ! last_time_coordinate, & 5782 ! start = (/ prt_time_count /), & 6253 5783 ! count = (/ 1 /) ) 6254 5784 ! CALL netcdf_handle_error( 'netcdf_define_header', 326 ) 6255 5785 6256 5786 ! IF ( last_time_coordinate(1) >= simulated_time ) THEN 6257 ! message_string = 'netCDF file for particles ' // & 6258 ! 'from previous run found,' // & 6259 ! '&but this file cannot be extended becaus' // & 6260 ! 'e the current output time' // & 6261 ! '&is less or equal than the last output t' // & 6262 ! 'ime on this file.' // & 5787 ! message_string = 'netCDF file for particles ' // 'from previous run found,' // & 5788 ! '&but this file cannot be extended because' // & 5789 ! ' the current output time' // & 5790 ! '&is less or equal than the last output ' // 'time on this file.' // & 6263 5791 ! '&New file is created instead.' 6264 5792 ! CALL message( 'define_netcdf_header', 'PA0265', 0, 1, 0, 6, 0 ) … … 6271 5799 !-- Dataset seems to be extendable. 6272 5800 !-- Now get the variable ids. 6273 ! nc_stat = NF90_INQ_VARID( id_set_prt, 'real_num_of_prt', & 6274 ! id_var_rnop_prt ) 5801 ! nc_stat = NF90_INQ_VARID( id_set_prt, 'real_num_of_prt',id_var_rnop_prt ) 6275 5802 ! CALL netcdf_handle_error( 'netcdf_define_header', 327 ) 6276 5803 6277 5804 ! DO i = 1, 17 6278 5805 6279 ! nc_stat = NF90_INQ_VARID( id_set_prt, prt_var_names(i), & 6280 ! id_var_prt(i) ) 5806 ! nc_stat = NF90_INQ_VARID( id_set_prt, prt_var_names(i), id_var_prt(i) ) 6281 5807 ! CALL netcdf_handle_error( 'netcdf_define_header', 328 ) 6282 5808 6283 5809 ! ENDDO 6284 5810 6285 ! message_string = 'netCDF file for particles ' // & 6286 ! 'from previous run found.' // & 5811 ! message_string = 'netCDF file for particles ' // 'from previous run found.' // & 6287 5812 ! '&This file will be extended.' 6288 5813 ! CALL message( 'define_netcdf_header', 'PA0266', 0, 0, 0, 6, 0 ) … … 6294 5819 ! 6295 5820 !-- Define some global attributes of the dataset 6296 nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'title', & 6297 TRIM( run_description_header ) ) 5821 nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'title', TRIM( run_description_header ) ) 6298 5822 CALL netcdf_handle_error( 'netcdf_define_header', 396 ) 6299 5823 6300 5824 ! 6301 5825 !-- Define time coordinate for particle time series (unlimited dimension) 6302 CALL netcdf_create_dim( id_set_pts, 'time', NF90_UNLIMITED, & 6303 id_dim_time_pts, 397 ) 6304 CALL netcdf_create_var( id_set_pts, (/ id_dim_time_pts /), 'time', & 6305 NF90_DOUBLE, id_var_time_pts, 'seconds', 'time', & 6306 398, 399, 000 ) 5826 CALL netcdf_create_dim( id_set_pts, 'time', NF90_UNLIMITED, id_dim_time_pts, 397 ) 5827 CALL netcdf_create_var( id_set_pts, (/ id_dim_time_pts /), 'time', NF90_DOUBLE, & 5828 id_var_time_pts, 'seconds', 'time', 398, 399, 000 ) 6307 5829 CALL netcdf_create_att( id_set_pts, id_var_time_pts, 'standard_name', 'time', 000) 6308 5830 CALL netcdf_create_att( id_set_pts, id_var_time_pts, 'axis', 'T', 000) 6309 5831 ! 6310 !-- Define the variables. If more than one particle group is defined, 6311 !-- define seperate variables for each group5832 !-- Define the variables. If more than one particle group is defined, define seperate 5833 !-- variables for each group. 6312 5834 var_list = ';' 6313 5835 DO i = 1, dopts_num … … 6322 5844 6323 5845 IF ( j == 0 ) THEN 6324 CALL netcdf_create_var( id_set_pts, (/ id_dim_time_pts /), & 6325 TRIM( dopts_label(i) ) // suffix, & 6326 nc_precision(6), id_var_dopts(i,j), & 6327 TRIM( dopts_unit(i) ), & 6328 TRIM( dopts_label(i) ), 400, 401, & 6329 402 ) 5846 CALL netcdf_create_var( id_set_pts, (/ id_dim_time_pts /), & 5847 TRIM( dopts_label(i) ) // suffix, nc_precision(6), & 5848 id_var_dopts(i,j), TRIM( dopts_unit(i) ), & 5849 TRIM( dopts_label(i) ), 400, 401, 402 ) 6330 5850 ELSE 6331 CALL netcdf_create_var( id_set_pts, (/ id_dim_time_pts /), & 6332 TRIM( dopts_label(i) ) // suffix, & 6333 nc_precision(6), id_var_dopts(i,j), & 6334 TRIM( dopts_unit(i) ), & 6335 TRIM( dopts_label(i) ) // ' PG ' // & 6336 suffix(2:3), 400, 401, 402 ) 5851 CALL netcdf_create_var( id_set_pts, (/ id_dim_time_pts /), & 5852 TRIM( dopts_label(i) ) // suffix, nc_precision(6), & 5853 id_var_dopts(i,j), TRIM( dopts_unit(i) ), & 5854 TRIM( dopts_label(i) ) // ' PG ' // suffix(2:3), & 5855 400, 401, 402 ) 6337 5856 ENDIF 6338 5857 6339 var_list = TRIM( var_list ) // TRIM( dopts_label(i) ) // & 6340 suffix // ';' 5858 var_list = TRIM( var_list ) // TRIM( dopts_label(i) ) // suffix // ';' 6341 5859 6342 5860 IF ( number_of_particle_groups == 1 ) EXIT … … 6347 5865 6348 5866 ! 6349 !-- Write the list of variables as global attribute (this is used by 6350 !-- restart runs) 6351 nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'VAR_LIST', & 6352 var_list ) 5867 !-- Write the list of variables as global attribute (this is used by restart runs) 5868 nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'VAR_LIST', var_list ) 6353 5869 CALL netcdf_handle_error( 'netcdf_define_header', 403 ) 6354 5870 … … 6364 5880 ! 6365 5881 !-- Get the list of variables and compare with the actual run. 6366 !-- First var_list_old has to be reset, since GET_ATT does not assign 6367 !-- trailing blanks. 5882 !-- First var_list_old has to be reset, since GET_ATT does not assign trailing blanks. 6368 5883 var_list_old = ' ' 6369 nc_stat = NF90_GET_ATT( id_set_pts, NF90_GLOBAL, 'VAR_LIST', & 6370 var_list_old ) 5884 nc_stat = NF90_GET_ATT( id_set_pts, NF90_GLOBAL, 'VAR_LIST', var_list_old ) 6371 5885 CALL netcdf_handle_error( 'netcdf_define_header', 405 ) 6372 5886 … … 6383 5897 ENDIF 6384 5898 6385 var_list = TRIM( var_list ) // TRIM( dopts_label(i) ) // & 6386 suffix // ';' 5899 var_list = TRIM( var_list ) // TRIM( dopts_label(i) ) // suffix // ';' 6387 5900 6388 5901 IF ( number_of_particle_groups == 1 ) EXIT … … 6393 5906 6394 5907 IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN 6395 message_string = 'netCDF file for particle time series ' // & 6396 'from previous run found,' // & 6397 '&but this file cannot be extended due to' // & 6398 ' variable mismatch.' // & 6399 '&New file is created instead.' 5908 message_string = 'netCDF file for particle time series ' // & 5909 'from previous run found,' // & 5910 '&but this file cannot be extended due to' // & 5911 ' variable mismatch.' // '&New file is created instead.' 6400 5912 CALL message( 'define_netcdf_header', 'PA0267', 0, 1, 0, 6, 0 ) 6401 5913 extend = .FALSE. … … 6404 5916 6405 5917 ! 6406 !-- Get the id of the time coordinate (unlimited coordinate) and its 6407 !-- last index on the file. The next time level is dots..count+1. 6408 !-- The current time must be larger than the last output time 6409 !-- on the file. 5918 !-- Get the id of the time coordinate (unlimited coordinate) and its last index on the file. 5919 !-- The next time level is dots..count+1. 5920 !-- The current time must be larger than the last output time on the file. 6410 5921 nc_stat = NF90_INQ_VARID( id_set_pts, 'time', id_var_time_pts ) 6411 5922 CALL netcdf_handle_error( 'netcdf_define_header', 406 ) 6412 5923 6413 nc_stat = NF90_INQUIRE_VARIABLE( id_set_pts, id_var_time_pts, & 6414 dimids = id_dim_time_old ) 5924 nc_stat = NF90_INQUIRE_VARIABLE( id_set_pts, id_var_time_pts, dimids = id_dim_time_old ) 6415 5925 CALL netcdf_handle_error( 'netcdf_define_header', 407 ) 6416 5926 id_dim_time_pts = id_dim_time_old(1) 6417 5927 6418 nc_stat = NF90_INQUIRE_DIMENSION( id_set_pts, id_dim_time_pts, & 6419 len = dopts_time_count ) 5928 nc_stat = NF90_INQUIRE_DIMENSION( id_set_pts, id_dim_time_pts, LEN = dopts_time_count ) 6420 5929 CALL netcdf_handle_error( 'netcdf_define_header', 408 ) 6421 5930 6422 nc_stat = NF90_GET_VAR( id_set_pts, id_var_time_pts, &6423 last_time_coordinate, &6424 start = (/ dopts_time_count /), &5931 nc_stat = NF90_GET_VAR( id_set_pts, id_var_time_pts, & 5932 last_time_coordinate, & 5933 start = (/ dopts_time_count /), & 6425 5934 count = (/ 1 /) ) 6426 5935 CALL netcdf_handle_error( 'netcdf_define_header', 409 ) 6427 5936 6428 5937 IF ( last_time_coordinate(1) >= simulated_time ) THEN 6429 message_string = 'netCDF file for particle time series ' // & 6430 'from previous run found,' // & 6431 '&but this file cannot be extended becaus' // & 6432 'e the current output time' // & 6433 '&is less or equal than the last output t' // & 6434 'ime on this file.' // & 5938 message_string = 'netCDF file for particle time series ' // & 5939 'from previous run found,' // & 5940 '&but this file cannot be extended because' // & 5941 ' the current output time' // & 5942 '&is less or equal than the last output ' // 'time on this file.' // & 6435 5943 '&New file is created instead.' 6436 5944 CALL message( 'define_netcdf_header', 'PA0268', 0, 1, 0, 6, 0 ) … … 6456 5964 netcdf_var_name = TRIM( dopts_label(i) ) // suffix 6457 5965 6458 nc_stat = NF90_INQ_VARID( id_set_pts, netcdf_var_name, & 6459 id_var_dopts(i,j) ) 5966 nc_stat = NF90_INQ_VARID( id_set_pts, netcdf_var_name, id_var_dopts(i,j) ) 6460 5967 CALL netcdf_handle_error( 'netcdf_define_header', 410 ) 6461 5968 … … 6467 5974 6468 5975 ! 6469 !-- Update the title attribute on file 6470 !-- In order to avoid 'data mode' errors if updated attributes are larger 6471 !-- than their original size, NF90_PUT_ATT is called in 'define mode' 6472 !-- enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible 6473 !-- performance loss due to data copying; an alternative strategy would be 6474 !-- to ensure equal attribute size in a job chain. Maybe revise later. 5976 !-- Update the title attribute on file. 5977 !-- In order to avoid 'data mode' errors if updated attributes are larger than their original 5978 !-- size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF 5979 !-- calls. This implies a possible performance loss due to data copying; an alternative 5980 !-- strategy would be to ensure equal attribute size in a job chain. Maybe revise later. 6475 5981 nc_stat = NF90_REDEF( id_set_pts ) 6476 5982 CALL netcdf_handle_error( 'netcdf_define_header', 443 ) 6477 nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'title', & 6478 TRIM( run_description_header ) ) 5983 nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'title', TRIM( run_description_header ) ) 6479 5984 CALL netcdf_handle_error( 'netcdf_define_header', 411 ) 6480 5985 nc_stat = NF90_ENDDEF( id_set_pts ) 6481 5986 CALL netcdf_handle_error( 'netcdf_define_header', 444 ) 6482 message_string = 'netCDF file for particle time series ' // & 6483 'from previous run found.' // & 5987 message_string = 'netCDF file for particle time series ' // 'from previous run found.' //& 6484 5988 '&This file will be extended.' 6485 5989 CALL message( 'netcdf_define_header', 'PA0269', 0, 0, 0, 6, 0 ) … … 6490 5994 ! 6491 5995 !-- Define some global attributes of the dataset 6492 nc_stat = NF90_PUT_ATT( id_set_fl, NF90_GLOBAL, 'title', & 6493 TRIM( run_description_header ) ) 5996 nc_stat = NF90_PUT_ATT( id_set_fl, NF90_GLOBAL, 'title', TRIM( run_description_header ) ) 6494 5997 CALL netcdf_handle_error( 'netcdf_define_header', 249 ) 6495 5998 6496 5999 ! 6497 !-- Define time and location coordinates for flight space-time series 6498 !-- (unlimited dimension) 6000 !-- Define time and location coordinates for flight space-time series (unlimited dimension). 6499 6001 !-- Error number must still be set appropriately. 6500 CALL netcdf_create_dim( id_set_fl, 'time', NF90_UNLIMITED, & 6501 id_dim_time_fl, 250 ) 6502 CALL netcdf_create_var( id_set_fl, (/ id_dim_time_fl /), 'time', & 6503 NF90_DOUBLE, id_var_time_fl, 'seconds', 'time', & 6504 251, 252, 000 ) 6002 CALL netcdf_create_dim( id_set_fl, 'time', NF90_UNLIMITED, id_dim_time_fl, 250 ) 6003 CALL netcdf_create_var( id_set_fl, (/ id_dim_time_fl /), 'time', NF90_DOUBLE, & 6004 id_var_time_fl, 'seconds', 'time', 251, 252, 000 ) 6505 6005 CALL netcdf_create_att( id_set_fl, id_var_time_fl, 'standard_name', 'time', 000) 6506 6006 CALL netcdf_create_att( id_set_fl, id_var_time_fl, 'axis', 'T', 000) 6507 6007 6508 6008 DO l = 1, num_leg 6509 CALL netcdf_create_dim( id_set_fl, dofl_dim_label_x(l), & 6510 NF90_UNLIMITED, id_dim_x_fl(l), 250 ) 6511 CALL netcdf_create_dim( id_set_fl, dofl_dim_label_y(l), & 6512 NF90_UNLIMITED, id_dim_y_fl(l), 250 ) 6513 CALL netcdf_create_dim( id_set_fl, dofl_dim_label_z(l), & 6514 NF90_UNLIMITED, id_dim_z_fl(l), 250 ) 6515 6516 CALL netcdf_create_var( id_set_fl, (/ id_dim_x_fl(l) /), & 6517 dofl_dim_label_x(l), NF90_DOUBLE, & 6518 id_var_x_fl(l), 'm', '', 251, 252, 000 ) 6519 CALL netcdf_create_var( id_set_fl, (/ id_dim_y_fl(l) /), & 6520 dofl_dim_label_y(l), NF90_DOUBLE, & 6521 id_var_y_fl(l), 'm', '', 251, 252, 000 ) 6522 CALL netcdf_create_var( id_set_fl, (/ id_dim_z_fl(l) /), & 6523 dofl_dim_label_z(l), NF90_DOUBLE, & 6524 id_var_z_fl(l), 'm', '', 251, 252, 000 ) 6009 CALL netcdf_create_dim( id_set_fl, dofl_dim_label_x(l), NF90_UNLIMITED, & 6010 id_dim_x_fl(l), 250 ) 6011 CALL netcdf_create_dim( id_set_fl, dofl_dim_label_y(l), NF90_UNLIMITED, & 6012 id_dim_y_fl(l), 250 ) 6013 CALL netcdf_create_dim( id_set_fl, dofl_dim_label_z(l), NF90_UNLIMITED, & 6014 id_dim_z_fl(l), 250 ) 6015 6016 CALL netcdf_create_var( id_set_fl, (/ id_dim_x_fl(l) /), dofl_dim_label_x(l), & 6017 NF90_DOUBLE, id_var_x_fl(l), 'm', '', 251, 252, 000 ) 6018 CALL netcdf_create_var( id_set_fl, (/ id_dim_y_fl(l) /), dofl_dim_label_y(l), & 6019 NF90_DOUBLE, id_var_y_fl(l), 'm', '', 251, 252, 000 ) 6020 CALL netcdf_create_var( id_set_fl, (/ id_dim_z_fl(l) /), dofl_dim_label_z(l), & 6021 NF90_DOUBLE, id_var_z_fl(l), 'm', '', 251, 252, 000 ) 6525 6022 ENDDO 6526 6023 ! … … 6531 6028 DO i = 1, num_var_fl 6532 6029 6533 CALL netcdf_create_var( id_set_fl, (/ id_dim_time_fl /), & 6534 dofl_label(k), nc_precision(9), & 6535 id_var_dofl(k), & 6536 TRIM( dofl_unit(k) ), & 6030 CALL netcdf_create_var( id_set_fl, (/ id_dim_time_fl /), dofl_label(k), & 6031 nc_precision(9), id_var_dofl(k), TRIM( dofl_unit(k) ), & 6537 6032 TRIM( dofl_label(k) ), 253, 254, 255 ) 6538 6033 … … 6544 6039 6545 6040 ! 6546 !-- Write the list of variables as global attribute (this is used by 6547 !-- restart runs) 6041 !-- Write the list of variables as global attribute (this is used by restart runs). 6548 6042 nc_stat = NF90_PUT_ATT( id_set_fl, NF90_GLOBAL, 'VAR_LIST', var_list ) 6549 6043 CALL netcdf_handle_error( 'netcdf_define_header', 258 ) … … 6559 6053 ! 6560 6054 !-- Get the list of variables and compare with the actual run. 6561 !-- First var_list_old has to be reset, since GET_ATT does not assign 6562 !-- trailing blanks. 6055 !-- First var_list_old has to be reset, since GET_ATT does not assign trailing blanks. 6563 6056 var_list_old = ' ' 6564 nc_stat = NF90_GET_ATT( id_set_fl, NF90_GLOBAL, 'VAR_LIST', & 6565 var_list_old ) 6057 nc_stat = NF90_GET_ATT( id_set_fl, NF90_GLOBAL, 'VAR_LIST', var_list_old ) 6566 6058 CALL netcdf_handle_error( 'netcdf_define_header', 260 ) 6567 6059 … … 6575 6067 6576 6068 IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN 6577 message_string = 'netCDF file for flight time series ' // & 6578 'from previous run found,' // & 6579 '&but this file cannot be extended due to' // & 6580 ' variable mismatch.' // & 6581 '&New file is created instead.' 6069 message_string = 'netCDF file for flight time series ' // & 6070 'from previous run found,' // & 6071 '&but this file cannot be extended due to' // & 6072 ' variable mismatch.' // '&New file is created instead.' 6582 6073 CALL message( 'define_netcdf_header', 'PA0257', 0, 1, 0, 6, 0 ) 6583 6074 extend = .FALSE. … … 6586 6077 6587 6078 ! 6588 !-- Get the id of the time coordinate (unlimited coordinate) and its 6589 !-- last index on the file. The next time level is dofl_time_count+1. 6590 !-- The current time must be larger than the last output time 6591 !-- on the file. 6079 !-- Get the id of the time coordinate (unlimited coordinate) and its last index on the file. 6080 !-- The next time level is dofl_time_count+1. 6081 !-- The current time must be larger than the last output time on the file. 6592 6082 nc_stat = NF90_INQ_VARID( id_set_fl, 'time', id_var_time_fl ) 6593 6083 CALL netcdf_handle_error( 'netcdf_define_header', 261 ) 6594 6084 6595 nc_stat = NF90_INQUIRE_VARIABLE( id_set_fl, id_var_time_fl, & 6596 dimids = id_dim_time_old ) 6085 nc_stat = NF90_INQUIRE_VARIABLE( id_set_fl, id_var_time_fl, dimids = id_dim_time_old ) 6597 6086 CALL netcdf_handle_error( 'netcdf_define_header', 262 ) 6598 6087 id_dim_time_fl = id_dim_time_old(1) 6599 6088 6600 nc_stat = NF90_INQUIRE_DIMENSION( id_set_fl, id_dim_time_fl, & 6601 len = dofl_time_count ) 6089 nc_stat = NF90_INQUIRE_DIMENSION( id_set_fl, id_dim_time_fl, LEN = dofl_time_count ) 6602 6090 CALL netcdf_handle_error( 'netcdf_define_header', 263 ) 6603 6091 6604 nc_stat = NF90_GET_VAR( id_set_fl, id_var_time_fl, &6605 last_time_coordinate, &6606 start = (/ dofl_time_count /), &6092 nc_stat = NF90_GET_VAR( id_set_fl, id_var_time_fl, & 6093 last_time_coordinate, & 6094 start = (/ dofl_time_count /), & 6607 6095 count = (/ 1 /) ) 6608 6096 CALL netcdf_handle_error( 'netcdf_define_header', 264 ) 6609 6097 6610 6098 IF ( last_time_coordinate(1) >= simulated_time ) THEN 6611 message_string = 'netCDF file for flight-time series ' // & 6612 'from previous run found,' // & 6613 '&but this file cannot be extended becaus' // & 6614 'e the current output time' // & 6615 '&is less or equal than the last output t' // & 6616 'ime on this file.' // & 6099 message_string = 'netCDF file for flight-time series ' // & 6100 'from previous run found,' // & 6101 '&but this file cannot be extended because' // & 6102 ' the current output time' // & 6103 '&is less or equal than the last output ' // 'time on this file.' // & 6617 6104 '&New file is created instead.' 6618 6105 CALL message( 'define_netcdf_header', 'PA0258', 0, 1, 0, 6, 0 ) … … 6624 6111 ! 6625 6112 !-- Dataset seems to be extendable. 6626 !-- Now get the remaining dimension and variable ids 6113 !-- Now get the remaining dimension and variable ids. 6627 6114 DO l = 1, num_leg 6628 nc_stat = NF90_INQ_VARID( id_set_fl, dofl_dim_label_x(l), & 6629 id_var_x_fl(l) ) 6115 nc_stat = NF90_INQ_VARID( id_set_fl, dofl_dim_label_x(l), id_var_x_fl(l) ) 6630 6116 CALL netcdf_handle_error( 'netcdf_define_header', 265 ) 6631 nc_stat = NF90_INQ_VARID( id_set_fl, dofl_dim_label_y(l), & 6632 id_var_y_fl(l) ) 6117 nc_stat = NF90_INQ_VARID( id_set_fl, dofl_dim_label_y(l), id_var_y_fl(l) ) 6633 6118 CALL netcdf_handle_error( 'netcdf_define_header', 265 ) 6634 nc_stat = NF90_INQ_VARID( id_set_fl, dofl_dim_label_z(l), & 6635 id_var_z_fl(l) ) 6119 nc_stat = NF90_INQ_VARID( id_set_fl, dofl_dim_label_z(l), id_var_z_fl(l) ) 6636 6120 CALL netcdf_handle_error( 'netcdf_define_header', 265 ) 6637 6121 … … 6641 6125 DO i = 1, num_leg * num_var_fl 6642 6126 6643 nc_stat = NF90_INQ_VARID( id_set_fl, dofl_label(i), & 6644 id_var_dofl(i) ) 6127 nc_stat = NF90_INQ_VARID( id_set_fl, dofl_label(i), id_var_dofl(i) ) 6645 6128 CALL netcdf_handle_error( 'netcdf_define_header', 265 ) 6646 6129 … … 6648 6131 6649 6132 ! 6650 !-- Update the title attribute on file 6651 !-- In order to avoid 'data mode' errors if updated attributes are larger 6652 !-- than their original size, NF90_PUT_ATT is called in 'define mode' 6653 !-- enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible 6654 !-- performance loss due to data copying; an alternative strategy would be 6655 !-- to ensure equal attribute size in a job chain. Maybe revise later. 6133 !-- Update the title attribute on file. 6134 !-- In order to avoid 'data mode' errors if updated attributes are larger than their original 6135 !-- size, NF90_PUT_ATT is called in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF 6136 !-- calls. This implies a possible performance loss due to data copying; an alternative 6137 !-- strategy would be to ensure equal attribute size in a job chain. Maybe revise later. 6656 6138 nc_stat = NF90_REDEF( id_set_fl ) 6657 6139 CALL netcdf_handle_error( 'netcdf_define_header', 439 ) 6658 nc_stat = NF90_PUT_ATT( id_set_fl, NF90_GLOBAL, 'title', & 6659 TRIM( run_description_header ) ) 6140 nc_stat = NF90_PUT_ATT( id_set_fl, NF90_GLOBAL, 'title', TRIM( run_description_header ) ) 6660 6141 CALL netcdf_handle_error( 'netcdf_define_header', 267 ) 6661 6142 nc_stat = NF90_ENDDEF( id_set_fl ) 6662 6143 CALL netcdf_handle_error( 'netcdf_define_header', 440 ) 6663 message_string = 'netCDF file for flight-time series ' // & 6664 'from previous run found.' // & 6144 message_string = 'netCDF file for flight-time series ' // 'from previous run found.' // & 6665 6145 '&This file will be extended.' 6666 6146 CALL message( 'define_netcdf_header', 'PA0259', 0, 0, 0, 6, 0 ) … … 6678 6158 6679 6159 6680 !------------------------------------------------------------------------------ !6160 !--------------------------------------------------------------------------------------------------! 6681 6161 ! Description: 6682 6162 ! ------------ 6683 !> Creates a netCDF file and give back the id. The parallel flag has to be TRUE 6684 !> for parallel netCDF output support. 6685 !------------------------------------------------------------------------------! 6686 6163 !> Creates a netCDF file and give back the id. The parallel flag has to be TRUE for parallel netCDF 6164 !> output support. 6165 !--------------------------------------------------------------------------------------------------! 6687 6166 SUBROUTINE netcdf_create_file( filename , id, parallel, errno ) 6688 6167 #if defined( __netcdf ) … … 6693 6172 6694 6173 CHARACTER (LEN=*), INTENT(IN) :: filename 6174 6695 6175 INTEGER, INTENT(IN) :: errno 6696 6176 INTEGER, INTENT(OUT) :: id 6697 6177 INTEGER :: idum !< dummy variable used to avoid compiler warnings about unused variables 6178 6698 6179 LOGICAL, INTENT(IN) :: parallel 6699 6180 … … 6712 6193 ! 6713 6194 !-- 64bit-offset format 6714 nc_stat = NF90_CREATE( filename, & 6715 IOR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ), id ) 6195 nc_stat = NF90_CREATE( filename, IOR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ), id ) 6716 6196 6717 6197 #if defined( __netcdf4 ) 6718 ELSEIF ( netcdf_data_format == 3 .OR. 6719 ( .NOT. parallel .AND. netcdf_data_format == 5 ) )THEN6198 ELSEIF ( netcdf_data_format == 3 .OR. ( .NOT. parallel .AND. netcdf_data_format == 5 ) ) & 6199 THEN 6720 6200 ! 6721 6201 !-- netCDF4/HDF5 format 6722 6202 nc_stat = NF90_CREATE( filename, IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), id ) 6723 6203 6724 ELSEIF ( netcdf_data_format == 4 .OR. 6725 ( .NOT. parallel .AND. netcdf_data_format == 6 ) )THEN6204 ELSEIF ( netcdf_data_format == 4 .OR. ( .NOT. parallel .AND. netcdf_data_format == 6 ) ) & 6205 THEN 6726 6206 ! 6727 6207 !-- netCDF4/HDF5 format with classic model flag 6728 nc_stat = NF90_CREATE( filename, & 6729 IOR( NF90_NOCLOBBER, & 6730 IOR( NF90_CLASSIC_MODEL, NF90_HDF5 ) ), id ) 6208 nc_stat = NF90_CREATE( filename, & 6209 IOR( NF90_NOCLOBBER, IOR( NF90_CLASSIC_MODEL, NF90_HDF5 ) ), id ) 6731 6210 6732 6211 #if defined( __netcdf4_parallel ) … … 6734 6213 ! 6735 6214 !-- netCDF4/HDF5 format, parallel 6736 nc_stat = NF90_CREATE( filename, & 6737 IOR( NF90_NOCLOBBER, & 6738 IOR( NF90_NETCDF4, NF90_MPIIO ) ), & 6215 nc_stat = NF90_CREATE( filename, IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ), & 6739 6216 id, COMM = comm2d, INFO = MPI_INFO_NULL ) 6740 6217 … … 6742 6219 ! 6743 6220 !-- netCDF4/HDF5 format with classic model flag, parallel 6744 nc_stat = NF90_CREATE( filename, & 6745 IOR( NF90_NOCLOBBER, & 6746 IOR( NF90_MPIIO, & 6747 IOR( NF90_CLASSIC_MODEL, NF90_HDF5 ) ) ), & 6221 nc_stat = NF90_CREATE( filename, & 6222 IOR( NF90_NOCLOBBER, & 6223 IOR( NF90_MPIIO, IOR( NF90_CLASSIC_MODEL, NF90_HDF5 ) ) ), & 6748 6224 id, COMM = comm2d, INFO = MPI_INFO_NULL ) 6749 6225 … … 6756 6232 END SUBROUTINE netcdf_create_file 6757 6233 6758 !------------------------------------------------------------------------------ !6234 !--------------------------------------------------------------------------------------------------! 6759 6235 ! Description: 6760 6236 ! ------------ 6761 6237 !> Opens an existing netCDF file for writing and gives back the id. 6762 6238 !> The parallel flag has to be TRUE for parallel netCDF output support. 6763 !------------------------------------------------------------------------------ !6239 !--------------------------------------------------------------------------------------------------! 6764 6240 SUBROUTINE netcdf_open_write_file( filename, id, parallel, errno ) 6765 6241 #if defined( __netcdf ) … … 6770 6246 6771 6247 CHARACTER (LEN=*), INTENT(IN) :: filename 6248 6772 6249 INTEGER, INTENT(IN) :: errno 6773 6250 INTEGER, INTENT(OUT) :: id … … 6780 6257 #if defined( __netcdf4_parallel ) 6781 6258 ELSEIF ( netcdf_data_format > 4 .AND. parallel ) THEN 6782 nc_stat = NF90_OPEN( filename, IOR( NF90_WRITE, NF90_MPIIO ), id, &6783 COMM = comm2d,INFO = MPI_INFO_NULL )6259 nc_stat = NF90_OPEN( filename, IOR( NF90_WRITE, NF90_MPIIO ), id, COMM = comm2d, & 6260 INFO = MPI_INFO_NULL ) 6784 6261 #endif 6785 6262 #endif … … 6791 6268 6792 6269 6793 !------------------------------------------------------------------------------ !6270 !--------------------------------------------------------------------------------------------------! 6794 6271 ! Description: 6795 6272 ! ------------ 6796 6273 !> Prints out a text message corresponding to the current status. 6797 !------------------------------------------------------------------------------! 6798 6274 !--------------------------------------------------------------------------------------------------! 6799 6275 SUBROUTINE netcdf_handle_error( routine_name, errno ) 6800 6276 #if defined( __netcdf ) 6801 6277 6802 6278 6803 USE control_parameters, &6279 USE control_parameters, & 6804 6280 ONLY: message_string 6805 6281 … … 6811 6287 INTEGER(iwp) :: errno 6812 6288 6289 6813 6290 IF ( nc_stat /= NF90_NOERR ) THEN 6814 6291 … … 6825 6302 6826 6303 6827 !------------------------------------------------------------------------------ !6304 !--------------------------------------------------------------------------------------------------! 6828 6305 ! Description: 6829 6306 ! ------------ 6830 6307 !> Create a dimension in NetCDF file 6831 !------------------------------------------------------------------------------ !6832 6833 SUBROUTINE netcdf_create_dim( ncid, dim_name, ncdim_type, ncdim_id, error_no)6308 !--------------------------------------------------------------------------------------------------! 6309 6310 SUBROUTINE netcdf_create_dim( ncid, dim_name, ncdim_type, ncdim_id, error_no ) 6834 6311 6835 6312 #if defined( __netcdf ) … … 6856 6333 6857 6334 6858 !------------------------------------------------------------------------------ !6335 !--------------------------------------------------------------------------------------------------! 6859 6336 ! Description: 6860 6337 ! ------------ 6861 6338 !> Create a one dimensional variable in specific units in NetCDF file 6862 !------------------------------------------------------------------------------! 6863 6864 SUBROUTINE netcdf_create_var( ncid, dim_id, var_name, var_type, var_id, & 6865 unit_name, long_name, error_no1, error_no2, & 6866 error_no3, fill ) 6339 !--------------------------------------------------------------------------------------------------! 6340 6341 SUBROUTINE netcdf_create_var( ncid, dim_id, var_name, var_type, var_id, unit_name, long_name, & 6342 error_no1, error_no2, error_no3, fill ) 6867 6343 6868 6344 #if defined( __netcdf ) … … 6872 6348 CHARACTER(LEN=*), INTENT(IN) :: unit_name 6873 6349 CHARACTER(LEN=*), INTENT(IN) :: var_name 6874 6875 LOGICAL, OPTIONAL :: fill !< indicates setting of _FillValue attribute6876 6350 6877 6351 INTEGER, INTENT(IN) :: error_no1 … … 6884 6358 INTEGER, DIMENSION(:), INTENT(IN) :: dim_id 6885 6359 6360 LOGICAL, OPTIONAL :: fill !< indicates setting of _FillValue attribute 6361 6362 6886 6363 ! 6887 6364 !-- Define variable … … 6891 6368 #if defined( __netcdf4 ) 6892 6369 ! 6893 !-- Check if variable should be deflate (including shuffling) 6894 !-- and if it is possible (only NetCDF4 with HDF5 supports compression)6370 !-- Check if variable should be deflate (including shuffling) and if it is possible (only NetCDF4 6371 !-- with HDF5 supports compression). 6895 6372 IF ( netcdf_data_format > 2 .AND. netcdf_deflate > 0 ) THEN 6896 6373 nc_stat = NF90_DEF_VAR_DEFLATE( ncid, var_id, 1, 1, netcdf_deflate ) … … 6917 6394 IF ( PRESENT( fill ) ) THEN 6918 6395 IF ( var_type == NF90_REAL4 ) THEN 6919 nc_stat = NF90_PUT_ATT( ncid, var_id, '_FillValue', & 6920 REAL( fill_value, KIND = 4 ) ) 6396 nc_stat = NF90_PUT_ATT( ncid, var_id, '_FillValue', REAL( fill_value, KIND = 4 ) ) 6921 6397 CALL netcdf_handle_error( 'netcdf_create_var', 0 ) 6922 6398 ELSE 6923 nc_stat = NF90_PUT_ATT( ncid, var_id, '_FillValue', & 6924 REAL( fill_value, KIND = 8 ) ) 6399 nc_stat = NF90_PUT_ATT( ncid, var_id, '_FillValue', REAL( fill_value, KIND = 8 ) ) 6925 6400 CALL netcdf_handle_error( 'netcdf_create_var', 0 ) 6926 6401 ENDIF … … 6931 6406 6932 6407 6933 !------------------------------------------------------------------------------ !6408 !--------------------------------------------------------------------------------------------------! 6934 6409 ! Description: 6935 6410 ! ------------ 6936 6411 !> Write attributes to file. 6937 !------------------------------------------------------------------------------ !6412 !--------------------------------------------------------------------------------------------------! 6938 6413 SUBROUTINE netcdf_create_att_string( ncid, varid, name, value, err ) 6939 6414 … … 6947 6422 6948 6423 INTEGER, INTENT(IN), OPTIONAL :: varid !< variable id 6424 6949 6425 6950 6426 #if defined( __netcdf ) … … 6960 6436 6961 6437 6962 !------------------------------------------------------------------------------ !6438 !--------------------------------------------------------------------------------------------------! 6963 6439 ! Description: 6964 6440 ! ------------ 6965 6441 !> Write a set of global attributes to file. 6966 !------------------------------------------------------------------------------ !6442 !--------------------------------------------------------------------------------------------------! 6967 6443 SUBROUTINE netcdf_create_global_atts( ncid, data_content, title, error_no ) 6968 6444 6969 USE control_parameters, &6445 USE control_parameters, & 6970 6446 ONLY: revision, run_date, run_time, run_zone, runnr, version 6971 6447 6972 USE netcdf_data_input_mod, &6448 USE netcdf_data_input_mod, & 6973 6449 ONLY: input_file_atts 6974 6450 6975 USE palm_date_time_mod, &6451 USE palm_date_time_mod, & 6976 6452 ONLY: date_time_str_len, get_date_time 6977 6453 … … 6985 6461 INTEGER, INTENT(IN) :: error_no !< error number 6986 6462 INTEGER, INTENT(IN) :: ncid !< file id 6463 6987 6464 ! 6988 6465 !-- Get date-time string for origin_time … … 6994 6471 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'Conventions', 'CF-1.7' ) 6995 6472 CALL netcdf_handle_error( 'netcdf_create_global_atts 2', error_no ) 6996 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'creation_time', TRIM( run_date )//' '//TRIM( run_time )//' '//run_zone(1:3) ) 6473 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'creation_time', TRIM( run_date ) // ' ' // & 6474 TRIM( run_time ) // ' ' // run_zone(1:3) ) 6997 6475 CALL netcdf_handle_error( 'netcdf_create_global_atts 3', error_no ) 6998 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'data_content', TRIM( data_content) )6476 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'data_content', TRIM( data_content ) ) 6999 6477 CALL netcdf_handle_error( 'netcdf_create_global_atts 4', error_no ) 7000 6478 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'version', runnr+1 ) … … 7021 6499 CALL netcdf_handle_error( 'netcdf_create_global_atts 14', error_no ) 7022 6500 7023 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%author_char ), TRIM( input_file_atts%author ) ) 6501 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%author_char ), & 6502 TRIM( input_file_atts%author ) ) 7024 6503 CALL netcdf_handle_error( 'netcdf_create_global_atts 15', error_no ) 7025 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%contact_person_char ), TRIM( input_file_atts%contact_person ) ) 6504 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%contact_person_char ), & 6505 TRIM( input_file_atts%contact_person ) ) 7026 6506 CALL netcdf_handle_error( 'netcdf_create_global_atts 16', error_no ) 7027 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%institution_char ), TRIM( input_file_atts%institution ) ) 6507 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%institution_char ), & 6508 TRIM( input_file_atts%institution ) ) 7028 6509 CALL netcdf_handle_error( 'netcdf_create_global_atts 17', error_no ) 7029 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%acronym_char ), TRIM( input_file_atts%acronym ) ) 6510 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%acronym_char ), & 6511 TRIM( input_file_atts%acronym ) ) 7030 6512 CALL netcdf_handle_error( 'netcdf_create_global_atts 18', error_no ) 7031 6513 7032 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%campaign_char ), TRIM( input_file_atts%campaign ) ) 6514 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%campaign_char ), & 6515 TRIM( input_file_atts%campaign ) ) 7033 6516 CALL netcdf_handle_error( 'netcdf_create_global_atts 19', error_no ) 7034 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%location_char ), TRIM( input_file_atts%location ) ) 6517 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%location_char ), & 6518 TRIM( input_file_atts%location ) ) 7035 6519 CALL netcdf_handle_error( 'netcdf_create_global_atts 20', error_no ) 7036 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%site_char ), TRIM( input_file_atts%site ) ) 6520 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%site_char ), & 6521 TRIM( input_file_atts%site ) ) 7037 6522 CALL netcdf_handle_error( 'netcdf_create_global_atts 21', error_no ) 7038 6523 7039 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'source', TRIM( version )//' '//TRIM( revision ) ) 6524 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'source', TRIM( version ) // ' ' // & 6525 TRIM( revision ) ) 7040 6526 CALL netcdf_handle_error( 'netcdf_create_global_atts 22', error_no ) 7041 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%references_char ), TRIM( input_file_atts%references ) ) 6527 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%references_char ), & 6528 TRIM( input_file_atts%references ) ) 7042 6529 CALL netcdf_handle_error( 'netcdf_create_global_atts 23', error_no ) 7043 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%keywords_char ), TRIM( input_file_atts%keywords ) ) 6530 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%keywords_char ), & 6531 TRIM( input_file_atts%keywords ) ) 7044 6532 CALL netcdf_handle_error( 'netcdf_create_global_atts 24', error_no ) 7045 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%licence_char ), TRIM( input_file_atts%licence ) ) 6533 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%licence_char ), & 6534 TRIM( input_file_atts%licence ) ) 7046 6535 CALL netcdf_handle_error( 'netcdf_create_global_atts 25', error_no ) 7047 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%comment_char ), TRIM( input_file_atts%comment ) ) 6536 nc_stat = NF90_PUT_ATT( ncid, NF90_GLOBAL, TRIM( input_file_atts%comment_char ), & 6537 TRIM( input_file_atts%comment ) ) 7048 6538 CALL netcdf_handle_error( 'netcdf_create_global_atts 26', error_no ) 7049 6539 … … 7052 6542 END SUBROUTINE netcdf_create_global_atts 7053 6543 7054 !------------------------------------------------------------------------------ !6544 !--------------------------------------------------------------------------------------------------! 7055 6545 ! Description: 7056 6546 ! ------------ 7057 6547 !> Create a variable holding the coordinate-reference-system information. 7058 !------------------------------------------------------------------------------ !6548 !--------------------------------------------------------------------------------------------------! 7059 6549 SUBROUTINE netcdf_create_crs( ncid, error_no ) 7060 6550 … … 7072 6562 ! 7073 6563 !-- Set attributes 7074 nc_stat = NF90_PUT_ATT( ncid, var_id, 'epsg_code', & 7075 coord_ref_sys%epsg_code ) 6564 nc_stat = NF90_PUT_ATT( ncid, var_id, 'epsg_code', coord_ref_sys%epsg_code ) 7076 6565 CALL netcdf_handle_error( 'netcdf_create_crs', error_no ) 7077 6566 7078 nc_stat = NF90_PUT_ATT( ncid, var_id, 'false_easting', & 7079 coord_ref_sys%false_easting ) 6567 nc_stat = NF90_PUT_ATT( ncid, var_id, 'false_easting', coord_ref_sys%false_easting ) 7080 6568 CALL netcdf_handle_error( 'netcdf_create_crs', error_no ) 7081 6569 7082 nc_stat = NF90_PUT_ATT( ncid, var_id, 'false_northing', & 7083 coord_ref_sys%false_northing ) 6570 nc_stat = NF90_PUT_ATT( ncid, var_id, 'false_northing', coord_ref_sys%false_northing ) 7084 6571 CALL netcdf_handle_error( 'netcdf_create_crs', error_no ) 7085 6572 7086 nc_stat = NF90_PUT_ATT( ncid, var_id, 'grid_mapping_name', & 7087 coord_ref_sys%grid_mapping_name ) 6573 nc_stat = NF90_PUT_ATT( ncid, var_id, 'grid_mapping_name', coord_ref_sys%grid_mapping_name ) 7088 6574 CALL netcdf_handle_error( 'netcdf_create_crs', error_no ) 7089 6575 7090 nc_stat = NF90_PUT_ATT( ncid, var_id, 'inverse_flattening', & 7091 coord_ref_sys%inverse_flattening ) 6576 nc_stat = NF90_PUT_ATT( ncid, var_id, 'inverse_flattening', coord_ref_sys%inverse_flattening ) 7092 6577 CALL netcdf_handle_error( 'netcdf_create_crs', error_no ) 7093 6578 7094 nc_stat = NF90_PUT_ATT( ncid, var_id, 'latitude_of_projection_origin', &6579 nc_stat = NF90_PUT_ATT( ncid, var_id, 'latitude_of_projection_origin', & 7095 6580 coord_ref_sys%latitude_of_projection_origin ) 7096 6581 CALL netcdf_handle_error( 'netcdf_create_crs', error_no ) 7097 6582 7098 nc_stat = NF90_PUT_ATT( ncid, var_id, 'long_name', & 7099 coord_ref_sys%long_name ) 6583 nc_stat = NF90_PUT_ATT( ncid, var_id, 'long_name', coord_ref_sys%long_name ) 7100 6584 CALL netcdf_handle_error( 'netcdf_create_crs', error_no ) 7101 6585 7102 nc_stat = NF90_PUT_ATT( ncid, var_id, 'longitude_of_central_meridian', &6586 nc_stat = NF90_PUT_ATT( ncid, var_id, 'longitude_of_central_meridian', & 7103 6587 coord_ref_sys%longitude_of_central_meridian ) 7104 6588 CALL netcdf_handle_error( 'netcdf_create_crs', error_no ) 7105 6589 7106 nc_stat = NF90_PUT_ATT( ncid, var_id, 'longitude_of_prime_meridian', &6590 nc_stat = NF90_PUT_ATT( ncid, var_id, 'longitude_of_prime_meridian', & 7107 6591 coord_ref_sys%longitude_of_prime_meridian ) 7108 6592 CALL netcdf_handle_error( 'netcdf_create_crs', error_no ) 7109 6593 7110 nc_stat = NF90_PUT_ATT( ncid, var_id, 'scale_factor_at_central_meridian', &6594 nc_stat = NF90_PUT_ATT( ncid, var_id, 'scale_factor_at_central_meridian', & 7111 6595 coord_ref_sys%scale_factor_at_central_meridian ) 7112 6596 CALL netcdf_handle_error( 'netcdf_create_crs', error_no ) 7113 6597 7114 nc_stat = NF90_PUT_ATT( ncid, var_id, 'semi_major_axis', & 7115 coord_ref_sys%semi_major_axis ) 6598 nc_stat = NF90_PUT_ATT( ncid, var_id, 'semi_major_axis', coord_ref_sys%semi_major_axis ) 7116 6599 CALL netcdf_handle_error( 'netcdf_create_crs', error_no ) 7117 6600 7118 nc_stat = NF90_PUT_ATT( ncid, var_id, 'units', & 7119 coord_ref_sys%units ) 6601 nc_stat = NF90_PUT_ATT( ncid, var_id, 'units', coord_ref_sys%units ) 7120 6602 CALL netcdf_handle_error( 'netcdf_create_crs', error_no ) 7121 6603 … … 7124 6606 7125 6607 7126 !------------------------------------------------------------------------------ !6608 !--------------------------------------------------------------------------------------------------! 7127 6609 ! Description: 7128 6610 ! ------------ 7129 6611 !> Define UTM coordinates and longitude and latitude in file. 7130 !------------------------------------------------------------------------------! 7131 SUBROUTINE define_geo_coordinates( id_set, id_dim_x, id_dim_y, id_var_eutm, id_var_nutm, id_var_lat, id_var_lon ) 6612 !--------------------------------------------------------------------------------------------------! 6613 SUBROUTINE define_geo_coordinates( id_set, id_dim_x, id_dim_y, id_var_eutm, id_var_nutm, & 6614 id_var_lat, id_var_lon ) 7132 6615 7133 6616 IMPLICIT NONE … … 7143 6626 INTEGER(iwp), DIMENSION(0:2), INTENT(OUT) :: id_var_lon !< variable id for longitude coordinates 7144 6627 INTEGER(iwp), DIMENSION(0:2), INTENT(OUT) :: id_var_nutm !< variable id for N_UTM coordinates 6628 7145 6629 7146 6630 ! … … 7155 6639 !-- Define UTM coordinates 7156 6640 IF ( rotation_angle == 0.0_wp ) THEN 7157 CALL netcdf_create_var( id_set, (/ id_dim_x(0) /), 'E_UTM', NF90_DOUBLE, id_var_eutm(0), 'm', 'easting', 000, 000, 000 ) 7158 CALL netcdf_create_var( id_set, (/ id_dim_y(0) /), 'N_UTM', NF90_DOUBLE, id_var_nutm(0), 'm', 'northing', 000, 000, 000 ) 7159 CALL netcdf_create_var( id_set, (/ id_dim_x(1) /), 'Eu_UTM', NF90_DOUBLE, id_var_eutm(1), 'm', 'easting', 000, 000, 000 ) 7160 CALL netcdf_create_var( id_set, (/ id_dim_y(0) /), 'Nu_UTM', NF90_DOUBLE, id_var_nutm(1), 'm', 'northing', 000, 000, 000 ) 7161 CALL netcdf_create_var( id_set, (/ id_dim_x(0) /), 'Ev_UTM', NF90_DOUBLE, id_var_eutm(2), 'm', 'easting', 000, 000, 000 ) 7162 CALL netcdf_create_var( id_set, (/ id_dim_y(1) /), 'Nv_UTM', NF90_DOUBLE, id_var_nutm(2), 'm', 'northing', 000, 000, 000 ) 6641 CALL netcdf_create_var( id_set, (/ id_dim_x(0) /), 'E_UTM', NF90_DOUBLE, id_var_eutm(0), & 6642 'm', 'easting', 000, 000, 000 ) 6643 CALL netcdf_create_var( id_set, (/ id_dim_y(0) /), 'N_UTM', NF90_DOUBLE, id_var_nutm(0), & 6644 'm', 'northing', 000, 000, 000 ) 6645 CALL netcdf_create_var( id_set, (/ id_dim_x(1) /), 'Eu_UTM', NF90_DOUBLE, id_var_eutm(1), & 6646 'm', 'easting', 000, 000, 000 ) 6647 CALL netcdf_create_var( id_set, (/ id_dim_y(0) /), 'Nu_UTM', NF90_DOUBLE, id_var_nutm(1), & 6648 'm', 'northing', 000, 000, 000 ) 6649 CALL netcdf_create_var( id_set, (/ id_dim_x(0) /), 'Ev_UTM', NF90_DOUBLE, id_var_eutm(2), & 6650 'm', 'easting', 000, 000, 000 ) 6651 CALL netcdf_create_var( id_set, (/ id_dim_y(1) /), 'Nv_UTM', NF90_DOUBLE, id_var_nutm(2), & 6652 'm', 'northing', 000, 000, 000 ) 7163 6653 ELSE 7164 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /), & 7165 'E_UTM', NF90_DOUBLE, id_var_eutm(0), 'm', 'easting', 000, 000, 000 ) 7166 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /), & 7167 'N_UTM', NF90_DOUBLE, id_var_nutm(0), 'm', 'northing', 000, 000, 000 ) 7168 CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /), & 7169 'Eu_UTM', NF90_DOUBLE, id_var_eutm(1), 'm', 'easting', 000, 000, 000 ) 7170 CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /), & 7171 'Nu_UTM', NF90_DOUBLE, id_var_nutm(1), 'm', 'northing', 000, 000, 000 ) 7172 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /), & 7173 'Ev_UTM', NF90_DOUBLE, id_var_eutm(2), 'm', 'easting', 000, 000, 000 ) 7174 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /), & 7175 'Nv_UTM', NF90_DOUBLE, id_var_nutm(2), 'm', 'northing', 000, 000, 000 ) 6654 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /), & 6655 'E_UTM', NF90_DOUBLE, id_var_eutm(0), 'm', 'easting', & 6656 000, 000, 000 ) 6657 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /), & 6658 'N_UTM', NF90_DOUBLE, id_var_nutm(0), 'm', 'northing', & 6659 000, 000, 000 ) 6660 CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /), & 6661 'Eu_UTM', NF90_DOUBLE, id_var_eutm(1), 'm', 'easting', & 6662 000, 000, 000 ) 6663 CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /), & 6664 'Nu_UTM', NF90_DOUBLE, id_var_nutm(1), 'm', 'northing', & 6665 000, 000, 000 ) 6666 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /), & 6667 'Ev_UTM', NF90_DOUBLE, id_var_eutm(2), 'm', 'easting', & 6668 000, 000, 000 ) 6669 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /), & 6670 'Nv_UTM', NF90_DOUBLE, id_var_nutm(2), 'm', 'northing', & 6671 000, 000, 000 ) 7176 6672 ENDIF 7177 6673 ! 7178 6674 !-- Define geographic coordinates 7179 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /), 'lon', NF90_DOUBLE, id_var_lon(0),&7180 'degrees_east', 'longitude', 000, 000, 000 )7181 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /), 'lat', NF90_DOUBLE, id_var_lat(0),&7182 'degrees_north', 'latitude', 000, 000, 000 )7183 CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /), 'lonu', NF90_DOUBLE, id_var_lon(1),&7184 'degrees_east', 'longitude', 000, 000, 000 )7185 CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /), 'latu', NF90_DOUBLE, id_var_lat(1),&7186 'degrees_north', 'latitude', 000, 000, 000 )7187 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /), 'lonv', NF90_DOUBLE, id_var_lon(2),&7188 'degrees_east', 'longitude', 000, 000, 000 )7189 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /), 'latv', NF90_DOUBLE, id_var_lat(2),&7190 'degrees_north', 'latitude', 000, 000, 000 )6675 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /), 'lon', NF90_DOUBLE, & 6676 id_var_lon(0), 'degrees_east', 'longitude', 000, 000, 000 ) 6677 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(0) /), 'lat', NF90_DOUBLE, & 6678 id_var_lat(0), 'degrees_north', 'latitude', 000, 000, 000 ) 6679 CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /), 'lonu', NF90_DOUBLE, & 6680 id_var_lon(1), 'degrees_east', 'longitude', 000, 000, 000 ) 6681 CALL netcdf_create_var( id_set, (/ id_dim_x(1), id_dim_y(0) /), 'latu', NF90_DOUBLE, & 6682 id_var_lat(1), 'degrees_north', 'latitude', 000, 000, 000 ) 6683 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /), 'lonv', NF90_DOUBLE, & 6684 id_var_lon(2), 'degrees_east', 'longitude', 000, 000, 000 ) 6685 CALL netcdf_create_var( id_set, (/ id_dim_x(0), id_dim_y(1) /), 'latv', NF90_DOUBLE, & 6686 id_var_lat(2), 'degrees_north', 'latitude', 000, 000, 000 ) 7191 6687 7192 6688 DO i = 0, 2 7193 CALL netcdf_create_att( id_set, id_var_eutm(i), 'standard_name', 'projection_x_coordinate', 000) 7194 CALL netcdf_create_att( id_set, id_var_nutm(i), 'standard_name', 'projection_y_coordinate', 000) 7195 7196 CALL netcdf_create_att( id_set, id_var_lat(i), 'standard_name', 'latitude', 000) 7197 CALL netcdf_create_att( id_set, id_var_lon(i), 'standard_name', 'longitude', 000) 6689 CALL netcdf_create_att( id_set, id_var_eutm(i), 'standard_name', 'projection_x_coordinate', & 6690 000 ) 6691 CALL netcdf_create_att( id_set, id_var_nutm(i), 'standard_name', 'projection_y_coordinate', & 6692 000 ) 6693 6694 CALL netcdf_create_att( id_set, id_var_lat(i), 'standard_name', 'latitude', 000 ) 6695 CALL netcdf_create_att( id_set, id_var_lon(i), 'standard_name', 'longitude', 000 ) 7198 6696 ENDDO 7199 6697
Note: See TracChangeset
for help on using the changeset viewer.
