SUBROUTINE check_open( file_id ) !--------------------------------------------------------------------------------! ! This file is part of PALM. ! ! PALM is free software: you can redistribute it and/or modify it under the terms ! of the GNU General Public License as published by the Free Software Foundation, ! either version 3 of the License, or (at your option) any later version. ! ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License along with ! PALM. If not, see . ! ! Copyright 1997-2014 Leibniz Universitaet Hannover !--------------------------------------------------------------------------------! ! ! Current revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: check_open.f90 1310 2014-03-14 08:01:56Z fricke $ ! ! 1106 2013-03-04 05:31:38Z raasch ! array_kind renamed precision_kind ! ! 1092 2013-02-02 11:24:22Z raasch ! unused variables removed ! ! 1036 2012-10-22 13:43:42Z raasch ! code put under GPL (PALM 3.9) ! ! 1031 2012-10-19 14:35:30Z raasch ! netCDF4 without parallel file support implemented, ! opening of netCDF files are done by new routines create_netcdf_file and ! open_write_netcdf_file ! ! 964 2012-07-26 09:14:24Z raasch ! old profil-units (40:49) removed, ! append feature removed from unit 14 ! ! 849 2012-03-15 10:35:09Z raasch ! comment changed ! ! 809 2012-01-30 13:32:58Z maronga ! Bugfix: replaced .AND. and .NOT. with && and ! in the preprocessor directives ! ! 807 2012-01-25 11:53:51Z maronga ! New cpp directive "__check" implemented which is used by check_namelist_files ! ! Bugfix concerning opening of 3D files in restart runs in case of netCDF4 ! ! 667 2010-12-23 12:06:00Z suehring/gryschka ! Output of total array size was adapted to nbgp. ! ! 600 2010-11-24 16:10:51Z raasch ! bugfix in opening of cross section netcdf-files (parallel opening with ! netcdf4 only works for netcdf_data_format > 2) ! ! 564 2010-09-30 13:18:59Z helmke ! start number of mask output files changed to 201, netcdf message identifiers ! of masked output changed ! ! 519 2010-03-19 05:30:02Z raasch ! netCDF4 support for particle data ! ! 493 2010-03-01 08:30:24Z raasch ! netCDF4 support (parallel output) ! ! 410 2009-12-04 17:05:40Z letzel ! masked data output ! ! 277 2009-03-31 09:13:47Z heinze ! Output of netCDF messages with aid of message handling routine. ! Output of messages replaced by message handling routine ! ! 146 2008-01-17 13:08:34Z raasch ! First opening of unit 13 openes file _0000 on all PEs (parallel version) ! because only this file contains the global variables, ! myid_char_14 removed ! ! 120 2007-10-17 11:54:43Z raasch ! Status of 3D-volume netCDF data file only depends on switch netcdf_64bit_3d ! ! 105 2007-08-08 07:12:55Z raasch ! Different filenames are used in case of a coupled simulation, ! coupling_char added to all relevant filenames ! ! 82 2007-04-16 15:40:52Z raasch ! Call of local_getenv removed, preprocessor directives for old systems removed ! ! 46 2007-03-05 06:00:47Z raasch ! +netcdf_64bit_3d to switch on 64bit offset only for 3D files ! ! RCS Log replace by Id keyword, revision history cleaned up ! ! Revision 1.44 2006/08/22 13:48:34 raasch ! xz and yz cross sections now up to nzt+1 ! ! Revision 1.1 1997/08/11 06:10:55 raasch ! Initial revision ! ! ! Description: ! ------------ ! Check if file unit is open. If not, open file and, if necessary, write a ! header or start other initializing actions, respectively. !------------------------------------------------------------------------------! USE arrays_3d USE control_parameters USE grid_variables USE indices USE netcdf_control USE particle_attributes USE pegrid USE precision_kind USE profil_parameter USE statistics IMPLICIT NONE CHARACTER (LEN=2) :: mask_char, suffix CHARACTER (LEN=20) :: xtext = 'time in s' CHARACTER (LEN=30) :: filename CHARACTER (LEN=40) :: avs_coor_file, avs_coor_file_localname, & avs_data_file_localname CHARACTER (LEN=80) :: rtext CHARACTER (LEN=100) :: avs_coor_file_catalog, avs_data_file_catalog, & batch_scp, zeile CHARACTER (LEN=400) :: command INTEGER :: av, anzzeile = 1, cranz, file_id, i, iaddres, iusern, & j, k, legpos = 1, timodex = 1 INTEGER, DIMENSION(10) :: klist LOGICAL :: avs_coor_file_found = .FALSE., avs_data_file_found = .FALSE., & datleg = .TRUE., get_filenames, grid = .TRUE., netcdf_extend, & rand = .TRUE., swap = .TRUE., twoxa = .TRUE., twoya = .TRUE. REAL :: ansx = -999.999, ansy = -999.999, gwid = 0.1, rlegfak = 1.5, & sizex = 250.0, sizey = 40.0, texfac = 1.5 REAL, DIMENSION(:), ALLOCATABLE :: eta, ho, hu REAL(spk), DIMENSION(:), ALLOCATABLE :: xkoor, ykoor, zkoor NAMELIST /RAHMEN/ anzzeile, cranz, datleg, rtext, swap NAMELIST /CROSS/ ansx, ansy, grid, gwid, klist, legpos, & rand, rlegfak, sizex, sizey, texfac, & timodex, twoxa, twoya, xtext ! !-- Immediate return if file already open IF ( openfile(file_id)%opened ) RETURN #if ! defined ( __check ) ! !-- Only certain files are allowed to be re-opened !-- NOTE: some of the other files perhaps also could be re-opened, but it !-- has not been checked so far, if it works! IF ( openfile(file_id)%opened_before ) THEN SELECT CASE ( file_id ) CASE ( 13, 14, 21, 22, 23, 80:85 ) IF ( file_id == 14 .AND. openfile(file_id)%opened_before ) THEN message_string = 're-open of unit ' // & '14 is not verified. Please check results!' CALL message( 'check_open', 'PA0165', 0, 1, 0, 6, 0 ) ENDIF CASE DEFAULT WRITE( message_string, * ) 're-opening of file-id ', file_id, & ' is not allowed' CALL message( 'check_open', 'PA0166', 0, 1, 0, 6, 0 ) RETURN END SELECT ENDIF #endif ! !-- Check if file may be opened on the relevant PE SELECT CASE ( file_id ) CASE ( 15, 16, 17, 18, 19, 50:59, 81:84, 104:105, 107, 109 ) IF ( myid /= 0 ) THEN WRITE( message_string, * ) 'opening file-id ',file_id, & ' not allowed for PE ',myid CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 ) ENDIF CASE ( 101:103, 106, 111:113, 116, 201:200+2*max_masks ) IF ( netcdf_data_format < 5 ) THEN IF ( myid /= 0 ) THEN WRITE( message_string, * ) 'opening file-id ',file_id, & ' not allowed for PE ',myid CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 ) ENDIF ENDIF CASE ( 21, 22, 23 ) IF ( .NOT. data_output_2d_on_each_pe ) THEN IF ( myid /= 0 ) THEN WRITE( message_string, * ) 'opening file-id ',file_id, & ' not allowed for PE ',myid CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 ) END IF ENDIF CASE ( 27, 28, 29, 31, 32, 33, 71:73, 90:99 ) ! !-- File-ids that are used temporarily in other routines WRITE( message_string, * ) 'opening file-id ',file_id, & ' is not allowed since it is used otherwise' CALL message( 'check_open', 'PA0168', 0, 1, 0, 6, 0 ) END SELECT ! !-- Open relevant files SELECT CASE ( file_id ) CASE ( 11 ) #if defined ( __check ) ! !-- In case of a prior parameter file check, the p3d data is stored in !-- PARIN, while the p3df is stored in PARINF. This only applies to !-- check_namelist_files! IF ( check_restart == 2 ) THEN OPEN ( 11, FILE='PARINF'//coupling_char, FORM='FORMATTED', & STATUS='OLD' ) ELSE OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', & STATUS='OLD' ) END IF #else OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', & STATUS='OLD' ) #endif CASE ( 13 ) IF ( myid_char == '' ) THEN OPEN ( 13, FILE='BININ'//coupling_char//myid_char, & FORM='UNFORMATTED', STATUS='OLD' ) ELSE ! !-- First opening of unit 13 openes file _0000 on all PEs because only !-- this file contains the global variables IF ( .NOT. openfile(file_id)%opened_before ) THEN OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/_0000',& FORM='UNFORMATTED', STATUS='OLD' ) ELSE OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/'//myid_char,& FORM='UNFORMATTED', STATUS='OLD' ) ENDIF ENDIF CASE ( 14 ) IF ( myid_char == '' ) THEN OPEN ( 14, FILE='BINOUT'//coupling_char//myid_char, & FORM='UNFORMATTED', POSITION='APPEND' ) ELSE IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN CALL local_system( 'mkdir BINOUT' // coupling_char ) ENDIF #if defined( __parallel ) && ! defined ( __check ) ! !-- Set a barrier in order to allow that all other processors in the !-- directory created by PE0 can open their file CALL MPI_BARRIER( comm2d, ierr ) #endif OPEN ( 14, FILE='BINOUT'//TRIM(coupling_char)//'/'//myid_char, & FORM='UNFORMATTED' ) ENDIF CASE ( 15 ) OPEN ( 15, FILE='RUN_CONTROL'//coupling_char, FORM='FORMATTED' ) CASE ( 16 ) OPEN ( 16, FILE='LIST_PROFIL'//coupling_char, FORM='FORMATTED' ) CASE ( 17 ) OPEN ( 17, FILE='LIST_PROFIL_1D'//coupling_char, FORM='FORMATTED' ) CASE ( 18 ) OPEN ( 18, FILE='CPU_MEASURES'//coupling_char, FORM='FORMATTED' ) CASE ( 19 ) OPEN ( 19, FILE='HEADER'//coupling_char, FORM='FORMATTED' ) CASE ( 20 ) IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN CALL local_system( 'mkdir DATA_LOG' // coupling_char ) ENDIF IF ( myid_char == '' ) THEN OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/_0000', & FORM='UNFORMATTED', POSITION='APPEND' ) ELSE #if defined( __parallel ) && ! defined ( __check ) ! !-- Set a barrier in order to allow that all other processors in the !-- directory created by PE0 can open their file CALL MPI_BARRIER( comm2d, ierr ) #endif OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/'//myid_char,& FORM='UNFORMATTED', POSITION='APPEND' ) ENDIF CASE ( 21 ) IF ( data_output_2d_on_each_pe ) THEN OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char )//myid_char, & FORM='UNFORMATTED', POSITION='APPEND' ) ELSE OPEN ( 21, FILE='PLOT2D_XY'//coupling_char, & FORM='UNFORMATTED', POSITION='APPEND' ) ENDIF IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN ! !-- Output for combine_plot_fields IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN WRITE (21) -nbgp, nx+nbgp, -nbgp, ny+nbgp ! total array size WRITE (21) 0, nx+1, 0, ny+1 ! output part ENDIF ! !-- Determine and write ISO2D coordiante header ALLOCATE( eta(0:ny+1), ho(0:nx+1), hu(0:nx+1) ) hu = 0.0 ho = (ny+1) * dy DO i = 1, ny eta(i) = REAL( i ) / ( ny + 1.0 ) ENDDO eta(0) = 0.0 eta(ny+1) = 1.0 WRITE (21) dx,eta,hu,ho DEALLOCATE( eta, ho, hu ) ! !-- Create output file for local parameters IF ( iso2d_output ) THEN OPEN ( 27, FILE='PLOT2D_XY_LOCAL'//coupling_char, & FORM='FORMATTED', DELIM='APOSTROPHE' ) openfile(27)%opened = .TRUE. ENDIF ENDIF CASE ( 22 ) IF ( data_output_2d_on_each_pe ) THEN OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char )//myid_char, & FORM='UNFORMATTED', POSITION='APPEND' ) ELSE OPEN ( 22, FILE='PLOT2D_XZ'//coupling_char, FORM='UNFORMATTED', & POSITION='APPEND' ) ENDIF IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN ! !-- Output for combine_plot_fields IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN WRITE (22) -nbgp, nx+nbgp, 0, nz+1 ! total array size WRITE (22) 0, nx+1, 0, nz+1 ! output part ENDIF ! !-- Determine and write ISO2D coordiante header ALLOCATE( eta(0:nz+1), ho(0:nx+1), hu(0:nx+1) ) hu = 0.0 ho = zu(nz+1) DO i = 1, nz eta(i) = REAL( zu(i) ) / zu(nz+1) ENDDO eta(0) = 0.0 eta(nz+1) = 1.0 WRITE (22) dx,eta,hu,ho DEALLOCATE( eta, ho, hu ) ! !-- Create output file for local parameters OPEN ( 28, FILE='PLOT2D_XZ_LOCAL'//coupling_char, & FORM='FORMATTED', DELIM='APOSTROPHE' ) openfile(28)%opened = .TRUE. ENDIF CASE ( 23 ) IF ( data_output_2d_on_each_pe ) THEN OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char )//myid_char, & FORM='UNFORMATTED', POSITION='APPEND' ) ELSE OPEN ( 23, FILE='PLOT2D_YZ'//coupling_char, FORM='UNFORMATTED', & POSITION='APPEND' ) ENDIF IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN ! !-- Output for combine_plot_fields IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN WRITE (23) -nbgp, ny+nbgp, 0, nz+1 ! total array size WRITE (23) 0, ny+1, 0, nz+1 ! output part ENDIF ! !-- Determine and write ISO2D coordiante header ALLOCATE( eta(0:nz+1), ho(0:ny+1), hu(0:ny+1) ) hu = 0.0 ho = zu(nz+1) DO i = 1, nz eta(i) = REAL( zu(i) ) / zu(nz+1) ENDDO eta(0) = 0.0 eta(nz+1) = 1.0 WRITE (23) dx,eta,hu,ho DEALLOCATE( eta, ho, hu ) ! !-- Create output file for local parameters OPEN ( 29, FILE='PLOT2D_YZ_LOCAL'//coupling_char, & FORM='FORMATTED', DELIM='APOSTROPHE' ) openfile(29)%opened = .TRUE. ENDIF CASE ( 30 ) OPEN ( 30, FILE='PLOT3D_DATA'//TRIM( coupling_char )//myid_char, & FORM='UNFORMATTED' ) ! !-- Write coordinate file for AVS IF ( myid == 0 ) THEN #if defined( __parallel ) ! !-- Specifications for combine_plot_fields IF ( .NOT. do3d_compress ) THEN WRITE ( 30 ) -nbgp,nx+nbgp,-nbgp,ny+nbgp, 0 ,nz_do3d WRITE ( 30 ) 0,nx+1,0,ny+1,0,nz_do3d ENDIF #endif ! !-- Write coordinate file for AVS: !-- First determine file names (including cyle numbers) of AVS files on !-- target machine (to which the files are to be transferred). !-- Therefore path information has to be obtained first. IF ( avs_output ) THEN iaddres = LEN_TRIM( return_addres ) iusern = LEN_TRIM( return_username ) OPEN ( 3, FILE='OUTPUT_FILE_CONNECTIONS', FORM='FORMATTED' ) DO WHILE ( .NOT. avs_coor_file_found .OR. & .NOT. avs_data_file_found ) READ ( 3, '(A)', END=1 ) zeile SELECT CASE ( zeile(1:11) ) CASE ( 'PLOT3D_COOR' ) READ ( 3, '(A/A)' ) avs_coor_file_catalog, & avs_coor_file_localname avs_coor_file_found = .TRUE. CASE ( 'PLOT3D_DATA' ) READ ( 3, '(A/A)' ) avs_data_file_catalog, & avs_data_file_localname avs_data_file_found = .TRUE. CASE DEFAULT READ ( 3, '(A/A)' ) zeile, zeile END SELECT ENDDO ! !-- Now the cycle numbers on the remote machine must be obtained !-- using batch_scp 1 CLOSE ( 3 ) IF ( .NOT. avs_coor_file_found .OR. & .NOT. avs_data_file_found ) THEN message_string= 'no filename for AVS-data-file ' // & 'found in MRUN-config-file' // & ' &filename in FLD-file set to "unknown"' CALL message( 'check_open', 'PA0169', 0, 1, 0, 6, 0 ) avs_coor_file = 'unknown' avs_data_file = 'unknown' ELSE get_filenames = .TRUE. IF ( TRIM( host ) == 'hpmuk' .OR. & TRIM( host ) == 'lcmuk' ) THEN batch_scp = '/home/raasch/pub/batch_scp' ELSEIF ( TRIM( host ) == 'nech' ) THEN batch_scp = '/ipf/b/b323011/pub/batch_scp' ELSEIF ( TRIM( host ) == 'ibmh' .OR. & TRIM( host ) == 'ibmb' ) THEN batch_scp = '/home/h/niksiraa/pub/batch_scp' ELSEIF ( TRIM( host ) == 't3eb' ) THEN batch_scp = '/home/nhbksira/pub/batch_scp' ELSE message_string= 'no path for batch_scp on host "' // & TRIM( host ) // '"' CALL message( 'check_open', 'PA0170', 0, 1, 0, 6, 0 ) get_filenames = .FALSE. ENDIF IF ( get_filenames ) THEN ! !-- Determine the coordinate file name. !-- /etc/passwd serves as Dummy-Datei, because it is not !-- really transferred. command = TRIM( batch_scp ) // ' -n -u ' // & return_username(1:iusern) // ' ' // & return_addres(1:iaddres) // ' /etc/passwd "' // & TRIM( avs_coor_file_catalog ) // '" ' // & TRIM( avs_coor_file_localname ) // ' > REMOTE_FILENAME' CALL local_system( command ) OPEN ( 3, FILE='REMOTE_FILENAME', FORM='FORMATTED' ) READ ( 3, '(A)' ) avs_coor_file CLOSE ( 3 ) ! !-- Determine the data file name command = TRIM( batch_scp ) // ' -n -u ' // & return_username(1:iusern) // ' ' // & return_addres(1:iaddres) // ' /etc/passwd "' // & TRIM( avs_data_file_catalog ) // '" ' // & TRIM( avs_data_file_localname ) // ' > REMOTE_FILENAME' CALL local_system( command ) OPEN ( 3, FILE='REMOTE_FILENAME', FORM='FORMATTED' ) READ ( 3, '(A)' ) avs_data_file CLOSE ( 3 ) ELSE avs_coor_file = 'unknown' avs_data_file = 'unknown' ENDIF ENDIF ! !-- Output of the coordinate file description for FLD-file OPEN ( 33, FILE='PLOT3D_FLD_COOR', FORM='FORMATTED' ) openfile(33)%opened = .TRUE. WRITE ( 33, 3300 ) TRIM( avs_coor_file ), & TRIM( avs_coor_file ), (nx+2*nbgp)*4, & TRIM( avs_coor_file ), (nx+2*nbgp)*4+(ny+2*nbgp)*4 ALLOCATE( xkoor(0:nx+1), ykoor(0:ny+1), zkoor(0:nz_do3d) ) DO i = 0, nx+1 xkoor(i) = i * dx ENDDO DO j = 0, ny+1 ykoor(j) = j * dy ENDDO DO k = 0, nz_do3d zkoor(k) = zu(k) ENDDO ! !-- Create and write on AVS coordinate file OPEN ( 31, FILE='PLOT3D_COOR', FORM='UNFORMATTED' ) openfile(31)%opened = .TRUE. WRITE (31) xkoor, ykoor, zkoor DEALLOCATE( xkoor, ykoor, zkoor ) ! !-- Create FLD file (being written on in close_file) OPEN ( 32, FILE='PLOT3D_FLD', FORM='FORMATTED' ) openfile(32)%opened = .TRUE. ! !-- Create flag file for compressed 3D output, !-- influences output commands in mrun IF ( do3d_compress ) THEN OPEN ( 3, FILE='PLOT3D_COMPRESSED', FORM='FORMATTED' ) WRITE ( 3, '(1X)' ) CLOSE ( 3 ) ENDIF ENDIF ENDIF ! !-- In case of data compression output of the coordinates of the !-- corresponding partial array of a PE only once at the top of the file IF ( avs_output .AND. do3d_compress ) THEN WRITE ( 30 ) nxlg, nxrg, nysg, nyng, nzb, nz_do3d ENDIF CASE ( 50:59 ) IF ( statistic_regions == 0 .AND. file_id == 50 ) THEN suffix = '' ELSE WRITE ( suffix, '(''_'',I1)' ) file_id - 50 ENDIF OPEN ( file_id, FILE='PLOTTS_DATA'//TRIM( coupling_char )// & TRIM( suffix ), & FORM='FORMATTED', RECL=496 ) ! !-- Write PROFIL parameter file for output of time series !-- NOTE: To be on the safe side, this output is done at the beginning of !-- the model run (in case of collapse) and it is repeated in !-- close_file, then, however, with value ranges for the coordinate !-- systems ! !-- Firstly determine the number of the coordinate systems to be drawn cranz = 0 DO j = 1, 10 IF ( cross_ts_number_count(j) /= 0 ) cranz = cranz+1 ENDDO rtext = '\1.0 ' // TRIM( run_description_header ) // ' ' // & TRIM( region( file_id - 50 ) ) ! !-- Write RAHMEN parameter OPEN ( 90, FILE='PLOTTS_PAR'//TRIM( coupling_char )// & TRIM( suffix ), & FORM='FORMATTED', DELIM='APOSTROPHE' ) WRITE ( 90, RAHMEN ) ! !-- Determine and write CROSS parameters for the individual coordinate !-- systems DO j = 1, 10 k = cross_ts_number_count(j) IF ( k /= 0 ) THEN ! !-- Store curve numbers, colours and line style klist(1:k) = cross_ts_numbers(1:k,j) klist(k+1:10) = 999999 ! !-- Write CROSS parameter WRITE ( 90, CROSS ) ENDIF ENDDO CLOSE ( 90 ) ! !-- Write all labels at the top of the data file, but only during the !-- first run of a sequence of jobs. The following jobs copy the time !-- series data to the bottom of that file. IF ( runnr == 0 ) THEN WRITE ( file_id, 5000 ) TRIM( run_description_header ) // & ' ' // TRIM( region( file_id - 50 ) ) ENDIF CASE ( 80 ) IF ( myid_char == '' ) THEN OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM(coupling_char)//myid_char, & FORM='FORMATTED', POSITION='APPEND' ) ELSE IF ( myid == 0 .AND. .NOT. openfile(80)%opened_before ) THEN CALL local_system( 'mkdir PARTICLE_INFOS' // coupling_char ) ENDIF #if defined( __parallel ) && ! defined ( __check ) ! !-- Set a barrier in order to allow that thereafter all other !-- processors in the directory created by PE0 can open their file. !-- WARNING: The following barrier will lead to hanging jobs, if !-- check_open is first called from routine !-- allocate_prt_memory! IF ( .NOT. openfile(80)%opened_before ) THEN CALL MPI_BARRIER( comm2d, ierr ) ENDIF #endif OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM( coupling_char )//'/'// & myid_char, & FORM='FORMATTED', POSITION='APPEND' ) ENDIF IF ( .NOT. openfile(80)%opened_before ) THEN WRITE ( 80, 8000 ) TRIM( run_description_header ) ENDIF CASE ( 81 ) OPEN ( 81, FILE='PLOTSP_X_PAR'//coupling_char, FORM='FORMATTED', & DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' ) CASE ( 82 ) OPEN ( 82, FILE='PLOTSP_X_DATA'//coupling_char, FORM='FORMATTED', & POSITION = 'APPEND' ) CASE ( 83 ) OPEN ( 83, FILE='PLOTSP_Y_PAR'//coupling_char, FORM='FORMATTED', & DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' ) CASE ( 84 ) OPEN ( 84, FILE='PLOTSP_Y_DATA'//coupling_char, FORM='FORMATTED', & POSITION='APPEND' ) CASE ( 85 ) IF ( myid_char == '' ) THEN OPEN ( 85, FILE='PARTICLE_DATA'//TRIM(coupling_char)//myid_char, & FORM='UNFORMATTED', POSITION='APPEND' ) ELSE IF ( myid == 0 .AND. .NOT. openfile(85)%opened_before ) THEN CALL local_system( 'mkdir PARTICLE_DATA' // coupling_char ) ENDIF #if defined( __parallel ) && ! defined ( __check ) ! !-- Set a barrier in order to allow that thereafter all other !-- processors in the directory created by PE0 can open their file CALL MPI_BARRIER( comm2d, ierr ) #endif OPEN ( 85, FILE='PARTICLE_DATA'//TRIM( coupling_char )//'/'// & myid_char, & FORM='UNFORMATTED', POSITION='APPEND' ) ENDIF IF ( .NOT. openfile(85)%opened_before ) THEN WRITE ( 85 ) run_description_header ! !-- Attention: change version number whenever the output format on !-- unit 85 is changed (see also in routine !-- lpm_data_output_particles) rtext = 'data format version 3.0' WRITE ( 85 ) rtext WRITE ( 85 ) number_of_particle_groups, & max_number_of_particle_groups WRITE ( 85 ) particle_groups ENDIF #if defined( __netcdf ) CASE ( 101, 111 ) ! !-- Set filename depending on unit number IF ( file_id == 101 ) THEN filename = 'DATA_2D_XY_NETCDF' // coupling_char av = 0 ELSE filename = 'DATA_2D_XY_AV_NETCDF' // coupling_char av = 1 ENDIF ! !-- Inquire, if there is a netCDF file from a previuos run. This should !-- be opened for extension, if its dimensions and variables match the !-- actual run. INQUIRE( FILE=filename, EXIST=netcdf_extend ) IF ( netcdf_extend ) THEN ! !-- Open an existing netCDF file for output CALL open_write_netcdf_file( filename, id_set_xy(av), .TRUE., 20 ) ! !-- Read header information and set all ids. If there is a mismatch !-- between the previuos and the actual run, netcdf_extend is returned !-- as .FALSE. CALL define_netcdf_header( 'xy', netcdf_extend, av ) ! !-- Remove the local file, if it can not be extended IF ( .NOT. netcdf_extend ) THEN nc_stat = NF90_CLOSE( id_set_xy(av) ) CALL handle_netcdf_error( 'check_open', 21 ) IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) ) ENDIF ENDIF IF ( .NOT. netcdf_extend ) THEN ! !-- Create a new netCDF output file with requested netCDF format CALL create_netcdf_file( filename, id_set_xy(av), .TRUE., 22 ) ! !-- Define the header CALL define_netcdf_header( 'xy', netcdf_extend, av ) ! !-- In case of parallel netCDF output, create flag file which tells !-- combine_plot_fields that nothing is to do. IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XY' ) WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary' CLOSE( 99 ) ENDIF ENDIF CASE ( 102, 112 ) ! !-- Set filename depending on unit number IF ( file_id == 102 ) THEN filename = 'DATA_2D_XZ_NETCDF' // coupling_char av = 0 ELSE filename = 'DATA_2D_XZ_AV_NETCDF' // coupling_char av = 1 ENDIF ! !-- Inquire, if there is a netCDF file from a previuos run. This should !-- be opened for extension, if its dimensions and variables match the !-- actual run. INQUIRE( FILE=filename, EXIST=netcdf_extend ) IF ( netcdf_extend ) THEN ! !-- Open an existing netCDF file for output CALL open_write_netcdf_file( filename, id_set_xz(av), .TRUE., 23 ) ! !-- Read header information and set all ids. If there is a mismatch !-- between the previuos and the actual run, netcdf_extend is returned !-- as .FALSE. CALL define_netcdf_header( 'xz', netcdf_extend, av ) ! !-- Remove the local file, if it can not be extended IF ( .NOT. netcdf_extend ) THEN nc_stat = NF90_CLOSE( id_set_xz(av) ) CALL handle_netcdf_error( 'check_open', 24 ) IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) ) ENDIF ENDIF IF ( .NOT. netcdf_extend ) THEN ! !-- Create a new netCDF output file with requested netCDF format CALL create_netcdf_file( filename, id_set_xz(av), .TRUE., 25 ) ! !-- Define the header CALL define_netcdf_header( 'xz', netcdf_extend, av ) ! !-- In case of parallel netCDF output, create flag file which tells !-- combine_plot_fields that nothing is to do. IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XZ' ) WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary' CLOSE( 99 ) ENDIF ENDIF CASE ( 103, 113 ) ! !-- Set filename depending on unit number IF ( file_id == 103 ) THEN filename = 'DATA_2D_YZ_NETCDF' // coupling_char av = 0 ELSE filename = 'DATA_2D_YZ_AV_NETCDF' // coupling_char av = 1 ENDIF ! !-- Inquire, if there is a netCDF file from a previuos run. This should !-- be opened for extension, if its dimensions and variables match the !-- actual run. INQUIRE( FILE=filename, EXIST=netcdf_extend ) IF ( netcdf_extend ) THEN ! !-- Open an existing netCDF file for output CALL open_write_netcdf_file( filename, id_set_yz(av), .TRUE., 26 ) ! !-- Read header information and set all ids. If there is a mismatch !-- between the previuos and the actual run, netcdf_extend is returned !-- as .FALSE. CALL define_netcdf_header( 'yz', netcdf_extend, av ) ! !-- Remove the local file, if it can not be extended IF ( .NOT. netcdf_extend ) THEN nc_stat = NF90_CLOSE( id_set_yz(av) ) CALL handle_netcdf_error( 'check_open', 27 ) IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) ) ENDIF ENDIF IF ( .NOT. netcdf_extend ) THEN ! !-- Create a new netCDF output file with requested netCDF format CALL create_netcdf_file( filename, id_set_yz(av), .TRUE., 28 ) ! !-- Define the header CALL define_netcdf_header( 'yz', netcdf_extend, av ) ! !-- In case of parallel netCDF output, create flag file which tells !-- combine_plot_fields that nothing is to do. IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_YZ' ) WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary' CLOSE( 99 ) ENDIF ENDIF CASE ( 104 ) ! !-- Set filename filename = 'DATA_1D_PR_NETCDF' // coupling_char ! !-- Inquire, if there is a netCDF file from a previuos run. This should !-- be opened for extension, if its variables match the actual run. INQUIRE( FILE=filename, EXIST=netcdf_extend ) IF ( netcdf_extend ) THEN ! !-- Open an existing netCDF file for output CALL open_write_netcdf_file( filename, id_set_pr, .FALSE., 29 ) ! !-- Read header information and set all ids. If there is a mismatch !-- between the previuos and the actual run, netcdf_extend is returned !-- as .FALSE. CALL define_netcdf_header( 'pr', netcdf_extend, 0 ) ! !-- Remove the local file, if it can not be extended IF ( .NOT. netcdf_extend ) THEN nc_stat = NF90_CLOSE( id_set_pr ) CALL handle_netcdf_error( 'check_open', 30 ) CALL local_system( 'rm ' // TRIM( filename ) ) ENDIF ENDIF IF ( .NOT. netcdf_extend ) THEN ! !-- Create a new netCDF output file with requested netCDF format CALL create_netcdf_file( filename, id_set_pr, .FALSE., 31 ) ! !-- Define the header CALL define_netcdf_header( 'pr', netcdf_extend, 0 ) ENDIF CASE ( 105 ) ! !-- Set filename filename = 'DATA_1D_TS_NETCDF' // coupling_char ! !-- Inquire, if there is a netCDF file from a previuos run. This should !-- be opened for extension, if its variables match the actual run. INQUIRE( FILE=filename, EXIST=netcdf_extend ) IF ( netcdf_extend ) THEN ! !-- Open an existing netCDF file for output CALL open_write_netcdf_file( filename, id_set_ts, .FALSE., 32 ) ! !-- Read header information and set all ids. If there is a mismatch !-- between the previuos and the actual run, netcdf_extend is returned !-- as .FALSE. CALL define_netcdf_header( 'ts', netcdf_extend, 0 ) ! !-- Remove the local file, if it can not be extended IF ( .NOT. netcdf_extend ) THEN nc_stat = NF90_CLOSE( id_set_ts ) CALL handle_netcdf_error( 'check_open', 33 ) CALL local_system( 'rm ' // TRIM( filename ) ) ENDIF ENDIF IF ( .NOT. netcdf_extend ) THEN ! !-- Create a new netCDF output file with requested netCDF format CALL create_netcdf_file( filename, id_set_ts, .FALSE., 34 ) ! !-- Define the header CALL define_netcdf_header( 'ts', netcdf_extend, 0 ) ENDIF CASE ( 106, 116 ) ! !-- Set filename depending on unit number IF ( file_id == 106 ) THEN filename = 'DATA_3D_NETCDF' // coupling_char av = 0 ELSE filename = 'DATA_3D_AV_NETCDF' // coupling_char av = 1 ENDIF ! !-- Inquire, if there is a netCDF file from a previous run. This should !-- be opened for extension, if its dimensions and variables match the !-- actual run. INQUIRE( FILE=filename, EXIST=netcdf_extend ) IF ( netcdf_extend ) THEN ! !-- Open an existing netCDF file for output CALL open_write_netcdf_file( filename, id_set_3d(av), .TRUE., 35 ) ! !-- Read header information and set all ids. If there is a mismatch !-- between the previuos and the actual run, netcdf_extend is returned !-- as .FALSE. CALL define_netcdf_header( '3d', netcdf_extend, av ) ! !-- Remove the local file, if it can not be extended IF ( .NOT. netcdf_extend ) THEN nc_stat = NF90_CLOSE( id_set_3d(av) ) CALL handle_netcdf_error( 'check_open', 36 ) CALL local_system('rm ' // TRIM( filename ) ) ENDIF ENDIF IF ( .NOT. netcdf_extend ) THEN ! !-- Create a new netCDF output file with requested netCDF format CALL create_netcdf_file( filename, id_set_3d(av), .TRUE., 37 ) ! !-- Define the header CALL define_netcdf_header( '3d', netcdf_extend, av ) ! !-- In case of parallel netCDF output, create flag file which tells !-- combine_plot_fields that nothing is to do. IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_3D' ) WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary' CLOSE( 99 ) ENDIF ENDIF CASE ( 107 ) ! !-- Set filename filename = 'DATA_1D_SP_NETCDF' // coupling_char ! !-- Inquire, if there is a netCDF file from a previuos run. This should !-- be opened for extension, if its variables match the actual run. INQUIRE( FILE=filename, EXIST=netcdf_extend ) IF ( netcdf_extend ) THEN ! !-- Open an existing netCDF file for output CALL open_write_netcdf_file( filename, id_set_sp, .FALSE., 38 ) ! !-- Read header information and set all ids. If there is a mismatch !-- between the previuos and the actual run, netcdf_extend is returned !-- as .FALSE. CALL define_netcdf_header( 'sp', netcdf_extend, 0 ) ! !-- Remove the local file, if it can not be extended IF ( .NOT. netcdf_extend ) THEN nc_stat = NF90_CLOSE( id_set_sp ) CALL handle_netcdf_error( 'check_open', 39 ) CALL local_system( 'rm ' // TRIM( filename ) ) ENDIF ENDIF IF ( .NOT. netcdf_extend ) THEN ! !-- Create a new netCDF output file with requested netCDF format CALL create_netcdf_file( filename, id_set_sp, .FALSE., 40 ) ! !-- Define the header CALL define_netcdf_header( 'sp', netcdf_extend, 0 ) ENDIF CASE ( 108 ) IF ( myid_char == '' ) THEN filename = 'DATA_PRT_NETCDF' // coupling_char ELSE filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char ) // '/' // & myid_char ENDIF ! !-- Inquire, if there is a netCDF file from a previuos run. This should !-- be opened for extension, if its variables match the actual run. INQUIRE( FILE=filename, EXIST=netcdf_extend ) IF ( netcdf_extend ) THEN ! !-- Open an existing netCDF file for output CALL open_write_netcdf_file( filename, id_set_prt, .FALSE., 41 ) ! !-- Read header information and set all ids. If there is a mismatch !-- between the previuos and the actual run, netcdf_extend is returned !-- as .FALSE. CALL define_netcdf_header( 'pt', netcdf_extend, 0 ) ! !-- Remove the local file, if it can not be extended IF ( .NOT. netcdf_extend ) THEN nc_stat = NF90_CLOSE( id_set_prt ) CALL handle_netcdf_error( 'check_open', 42 ) CALL local_system( 'rm ' // filename ) ENDIF ENDIF IF ( .NOT. netcdf_extend ) THEN ! !-- For runs on multiple processors create the subdirectory IF ( myid_char /= '' ) THEN IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) & THEN ! needs modification in case of non-extendable sets CALL local_system( 'mkdir DATA_PRT_NETCDF' // & TRIM( coupling_char ) // '/' ) ENDIF #if defined( __parallel ) && ! defined ( __check ) ! !-- Set a barrier in order to allow that all other processors in the !-- directory created by PE0 can open their file CALL MPI_BARRIER( comm2d, ierr ) #endif ENDIF ! !-- Create a new netCDF output file with requested netCDF format CALL create_netcdf_file( filename, id_set_prt, .FALSE., 43 ) ! !-- Define the header CALL define_netcdf_header( 'pt', netcdf_extend, 0 ) ENDIF CASE ( 109 ) ! !-- Set filename filename = 'DATA_1D_PTS_NETCDF' // coupling_char ! !-- Inquire, if there is a netCDF file from a previuos run. This should !-- be opened for extension, if its variables match the actual run. INQUIRE( FILE=filename, EXIST=netcdf_extend ) IF ( netcdf_extend ) THEN ! !-- Open an existing netCDF file for output CALL open_write_netcdf_file( filename, id_set_pts, .FALSE., 393 ) ! !-- Read header information and set all ids. If there is a mismatch !-- between the previuos and the actual run, netcdf_extend is returned !-- as .FALSE. CALL define_netcdf_header( 'ps', netcdf_extend, 0 ) ! !-- Remove the local file, if it can not be extended IF ( .NOT. netcdf_extend ) THEN nc_stat = NF90_CLOSE( id_set_pts ) CALL handle_netcdf_error( 'check_open', 394 ) CALL local_system( 'rm ' // TRIM( filename ) ) ENDIF ENDIF IF ( .NOT. netcdf_extend ) THEN ! !-- Create a new netCDF output file with requested netCDF format CALL create_netcdf_file( filename, id_set_pts, .FALSE., 395 ) ! !-- Define the header CALL define_netcdf_header( 'ps', netcdf_extend, 0 ) ENDIF CASE ( 201:200+2*max_masks ) ! !-- Set filename depending on unit number IF ( file_id <= 200+max_masks ) THEN mid = file_id - 200 WRITE ( mask_char,'(I2.2)') mid filename = 'DATA_MASK_' // mask_char // '_NETCDF' // coupling_char av = 0 ELSE mid = file_id - (200+max_masks) WRITE ( mask_char,'(I2.2)') mid filename = 'DATA_MASK_' // mask_char // '_AV_NETCDF' // & coupling_char av = 1 ENDIF ! !-- Inquire, if there is a netCDF file from a previuos run. This should !-- be opened for extension, if its dimensions and variables match the !-- actual run. INQUIRE( FILE=filename, EXIST=netcdf_extend ) IF ( netcdf_extend ) THEN ! !-- Open an existing netCDF file for output CALL open_write_netcdf_file( filename, id_set_mask(mid,av), & .TRUE., 456 ) ! !-- Read header information and set all ids. If there is a mismatch !-- between the previuos and the actual run, netcdf_extend is returned !-- as .FALSE. CALL define_netcdf_header( 'ma', netcdf_extend, file_id ) ! !-- Remove the local file, if it can not be extended IF ( .NOT. netcdf_extend ) THEN nc_stat = NF90_CLOSE( id_set_mask(mid,av) ) CALL handle_netcdf_error( 'check_open', 457 ) CALL local_system('rm ' // TRIM( filename ) ) ENDIF ENDIF IF ( .NOT. netcdf_extend ) THEN ! !-- Create a new netCDF output file with requested netCDF format CALL create_netcdf_file( filename, id_set_mask(mid,av), .TRUE., 458 ) ! !-- Define the header CALL define_netcdf_header( 'ma', netcdf_extend, file_id ) ENDIF #else CASE ( 101:109, 111:113, 116, 201:200+2*max_masks ) ! !-- Nothing is done in case of missing netcdf support RETURN #endif CASE DEFAULT WRITE( message_string, * ) 'no OPEN-statement for file-id ',file_id CALL message( 'check_open', 'PA0172', 2, 2, -1, 6, 1 ) END SELECT ! !-- Set open flag openfile(file_id)%opened = .TRUE. ! !-- Formats 3300 FORMAT ('#'/ & 'coord 1 file=',A,' filetype=unformatted'/ & 'coord 2 file=',A,' filetype=unformatted skip=',I6/ & 'coord 3 file=',A,' filetype=unformatted skip=',I6/ & '#') 4000 FORMAT ('# ',A) 5000 FORMAT ('# ',A/ & '#1 E'/'#2 E*'/'#3 dt'/'#4 u*'/'#5 th*'/'#6 umax'/'#7 vmax'/ & '#8 wmax'/'#9 div_new'/'#10 div_old'/'#11 z_i_wpt'/'#12 z_i_pt'/ & '#13 w*'/'#14 w''pt''0'/'#15 w''pt'''/'#16 wpt'/'#17 pt(0)'/ & '#18 pt(zp)'/'#19 splptx'/'#20 splpty'/'#21 splptz') 8000 FORMAT (A/ & ' step time # of parts lPE sent/recv rPE sent/recv ',& 'sPE sent/recv nPE sent/recv max # of parts'/ & 103('-')) END SUBROUTINE check_open