Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Changeset 4546 for palm


Ignore:
Timestamp:
May 24, 2020 12:16:41 PM (4 years ago)
Author:
raasch
Message:

Variables iran and iran_part completely removed, added I/O of parallel random numbers to restart file, file re-formatted to follow the PALM coding standard

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/check_open.f90

    r4444 r4546  
    11!> @file check_open.f90
    2 !------------------------------------------------------------------------------!
     2!--------------------------------------------------------------------------------------------------!
    33! This file is part of the PALM model system.
    44!
    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/>.
     15!
    1616!
    1717! Copyright 1997-2020 Leibniz Universitaet Hannover
    18 !------------------------------------------------------------------------------!
     18!--------------------------------------------------------------------------------------------------!
    1919!
    2020! Current revisions:
    … …  
    2525! -----------------
    2626! $Id$
     27! file re-formatted to follow the PALM coding standard
     28!
     29! 4444 2020-03-05 15:59:50Z raasch
    2730! bugfix: cpp-directives for serial mode added
    28 ! 
     31!
    2932! 4400 2020-02-10 20:32:41Z suehring
    3033! Remove binary output for virtual measurements
    31 ! 
     34!
    3235! 4360 2020-01-07 11:25:50Z suehring
    3336! Corrected "Former revisions" section
    34 ! 
     37!
    3538! 4128 2019-07-30 16:28:58Z gronemeier
    3639! Bugfix for opening the parameter file (unit 11): return error message if file
    3740! was not found.
    38 ! 
     41!
    3942! 4099 2019-07-15 15:29:37Z suehring
    4043! Bugfix in opening the parameter file (unit 11) in case of ocean precursor
    41 ! runs. 
    42 ! 
     44! runs.
     45!
    4346! 4069 2019-07-01 14:05:51Z Giersch
    44 ! Masked output running index mid has been introduced as a local variable to 
     47! Masked output running index mid has been introduced as a local variable to
    4548! avoid runtime error (Loop variable has been modified) in time_integration
    46 ! 
     49!
    4750! 3967 2019-05-09 16:04:34Z gronemeier
    4851! Save binary data of virtual measurements within separate folder
    49 ! 
     52!
    5053! 3812 2019-03-25 07:10:12Z gronemeier
    5154! Open binary surface output data within separate folder
    52 ! 
     55!
    5356! 3705 2019-01-29 19:56:39Z suehring
    5457! Open binary files for virtual measurements
    55 ! 
     58!
    5659! 3704 2019-01-29 19:51:41Z suehring
    5760! Open files for surface data
    … …  
    6568!> Check if file unit is open. If not, open file and, if necessary, write a
    6669!> header or start other initializing actions, respectively.
    67 !------------------------------------------------------------------------------!
     70!--------------------------------------------------------------------------------------------------!
    6871SUBROUTINE check_open( file_id )
    69  
     72
    7073
    7174    USE control_parameters,                                                                        &
    … …  
    7477
    7578#if defined( __parallel )
    76     USE control_parameters,                                                    &
     79    USE control_parameters,                                                                        &
    7780        ONLY:  nz_do3d
    7881#endif
    7982
    80     USE indices,                                                               &
     83    USE indices,                                                                                   &
    8184        ONLY:  nbgp, nx, nxl, nxr, ny, nyn, nys, nz, nzb, nzt
    8285
    … …  
    8790#endif
    8891
    89     USE netcdf_interface,                                                      &
    90         ONLY:  id_set_agt, id_set_fl, id_set_mask, id_set_pr,                  &
    91                id_set_pts, id_set_sp, id_set_ts, id_set_xy, id_set_xz,         &
    92                id_set_yz, id_set_3d, nc_stat, netcdf_create_file,              &
    93                netcdf_data_format, netcdf_define_header, netcdf_handle_error,  &
     92    USE netcdf_interface,                                                                          &
     93        ONLY:  id_set_agt, id_set_fl, id_set_mask, id_set_pr,                                      &
     94               id_set_pts, id_set_sp, id_set_ts, id_set_xy, id_set_xz,                             &
     95               id_set_yz, id_set_3d, nc_stat, netcdf_create_file,                                  &
     96               netcdf_data_format, netcdf_define_header, netcdf_handle_error,                      &
    9497               netcdf_open_write_file
    9598
    96     USE particle_attributes,                                                   &
    97         ONLY:  max_number_of_particle_groups, number_of_particle_groups,       &
    98                particle_groups
     99    USE particle_attributes,                                                                       &
     100        ONLY:  max_number_of_particle_groups, number_of_particle_groups, particle_groups
    99101
    100102    USE pegrid
    101103
    102     USE posix_calls_from_fortran,                                              &
     104    USE posix_calls_from_fortran,                                                                  &
    103105        ONLY:  fortran_sleep
    104106
    … …  
    106108    IMPLICIT NONE
    107109
     110    CHARACTER (LEN=30)  ::  filename                !<
    108111    CHARACTER (LEN=4)   ::  mask_char               !<
    109     CHARACTER (LEN=30)  ::  filename                !<
    110112    CHARACTER (LEN=80)  ::  rtext                   !<
    111113
    … …  
    114116    INTEGER(iwp) ::  ioerr       !< IOSTAT flag for IO-commands ( 0 = no error )
    115117    INTEGER(iwp) ::  mid         !< masked output running index
    116    
     118
    117119    LOGICAL ::  file_exist       !< file check
    118120    LOGICAL ::  netcdf_extend    !<
    … …  
    124126!
    125127!-- Only certain files are allowed to be re-opened
    126 !-- NOTE: some of the other files perhaps also could be re-opened, but it
    127 !--       has not been checked so far, if it works!
     128!-- NOTE: some of the other files perhaps also could be re-opened, but it has not been checked so
     129!-- far, if it works!
    128130    IF ( openfile(file_id)%opened_before )  THEN
    129131       SELECT CASE ( file_id )
    130132          CASE ( 13, 14, 21, 22, 23, 80, 85, 117 )
    131              IF ( file_id == 14 .AND. openfile(file_id)%opened_before )  THEN
    132                 message_string = 're-open of unit ' //                         &
    133                                  '14 is not verified. Please check results!'
    134                 CALL message( 'check_open', 'PA0165', 0, 1, 0, 6, 0 )       
     133             IF ( file_id == 14  .AND.  openfile(file_id)%opened_before )  THEN
     134                message_string = 're-open of unit ' // '14 is not verified. Please check results!'
     135                CALL message( 'check_open', 'PA0165', 0, 1, 0, 6, 0 )
    135136             ENDIF
    136137
    137138          CASE DEFAULT
    138              WRITE( message_string, * ) 're-opening of file-id ', file_id,     &
    139                                         ' is not allowed'
    140              CALL message( 'check_open', 'PA0166', 0, 1, 0, 6, 0 )   
    141                
     139             WRITE( message_string, * ) 're-opening of file-id ', file_id, ' is not allowed'
     140             CALL message( 'check_open', 'PA0166', 0, 1, 0, 6, 0 )
     141
    142142             RETURN
    143143
    … …  
    150150
    151151       CASE ( 15, 16, 17, 18, 19, 50:59, 104:105, 107, 109, 117 )
    152      
     152
    153153          IF ( myid /= 0 )  THEN
    154              WRITE( message_string, * ) 'opening file-id ',file_id,            &
    155                                         ' not allowed for PE ',myid
     154             WRITE( message_string, * ) 'opening file-id ', file_id, ' not allowed for PE ', myid
    156155             CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
    157156          ENDIF
    … …  
    160159
    161160          IF ( netcdf_data_format < 5 )  THEN
    162          
     161
    163162             IF ( myid /= 0 )  THEN
    164                 WRITE( message_string, * ) 'opening file-id ',file_id,         &
    165                                            ' not allowed for PE ',myid
     163                WRITE( message_string, * ) 'opening file-id ', file_id, ' not allowed for PE ', myid
    166164                CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
    167165             ENDIF
    168      
     166
    169167          ENDIF
    170168
    171169       CASE ( 21, 22, 23 )
    172170
    173           IF ( .NOT.  data_output_2d_on_each_pe )  THEN
     171          IF ( .NOT. data_output_2d_on_each_pe )  THEN
    174172             IF ( myid /= 0 )  THEN
    175                 WRITE( message_string, * ) 'opening file-id ',file_id,         &
    176                                            ' not allowed for PE ',myid
     173                WRITE( message_string, * ) 'opening file-id ', file_id, ' not allowed for PE ', myid
    177174                CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
    178175             END IF
    … …  
    183180!
    184181!--       File-ids that are used temporarily in other routines
    185           WRITE( message_string, * ) 'opening file-id ',file_id,               &
    186                                     ' is not allowed since it is used otherwise'
    187           CALL message( 'check_open', 'PA0168', 0, 1, 0, 6, 0 ) 
    188          
     182          WRITE( message_string, * ) 'opening file-id ', file_id,                                  &
     183                                     ' is not allowed since it is used otherwise'
     184          CALL message( 'check_open', 'PA0168', 0, 1, 0, 6, 0 )
     185
    189186    END SELECT
    190187
    … …  
    195192       CASE ( 11 )
    196193!
    197 !--       Read the parameter file. Therefore, inquire whether the file exist or
    198 !--       not. This is required for the ocean-atmoshere coupling. For an ocean
    199 !--       precursor run palmrun provides a PARIN_O file instead of a PARIN
    200 !--       file. Actually this should be considered in coupling_char, however,
    201 !--       in pmc_init the parameter file is already opened to read the
    202 !--       nesting parameters and decide whether it is a nested run or not,
    203 !--       but coupling_char is still not set at that moment (must be set after
    204 !-        the nesting setup is read).
    205 !--       This, however, leads to the situation that for ocean
    206 !--       precursor runs PARIN is not available and the run crashes. Thus,
    207 !--       if the file is not there, PARIN_O will be read. An ocean precursor
    208 !--       run will be the only situation where this can happen.
    209           INQUIRE( FILE = 'PARIN' // TRIM( coupling_char ),                    &
    210                    EXIST = file_exist )
    211                    
     194!--       Read the parameter file. Therefore, inquire whether the file exist or not. This is
     195!--       required for the ocean-atmoshere coupling. For an ocean precursor run palmrun provides a
     196!--       PARIN_O file instead of a PARIN file. Actually this should be considered in coupling_char,
     197!--       however, in pmc_init the parameter file is already opened to read the nesting parameters
     198!--       and decide whether it is a nested run or not, but coupling_char is still not set at that
     199!--       moment (must be set after the nesting setup is read).
     200!--       This, however, leads to the situation that for ocean precursor runs PARIN is not available
     201!--       and the run crashes. Thus, if the file is not there, PARIN_O will be read. An ocean
     202!--       precursor run will be the only situation where this can happen.
     203          INQUIRE( FILE = 'PARIN' // TRIM( coupling_char ), EXIST = file_exist )
     204
    212205          IF ( file_exist )  THEN
    213206             filename = 'PARIN' // TRIM( coupling_char )
    … …  
    216209          ENDIF
    217210
    218           OPEN ( 11, FILE= TRIM( filename ), FORM='FORMATTED', STATUS='OLD', IOSTAT=ioerr )
     211          OPEN ( 11, FILE= TRIM( filename ), FORM = 'FORMATTED', STATUS = 'OLD', IOSTAT = ioerr )
    219212
    220213          IF ( ioerr /= 0 )  THEN
    221              message_string = 'namelist file "PARIN' // TRIM( coupling_char ) //         &
    222                               '"  or "PARIN_O" not found!' //                            &
    223                               '&Please have a look at the online description of the ' // &
     214             message_string = 'namelist file "PARIN' // TRIM( coupling_char ) //                   &
     215                              '"  or "PARIN_O" not found!' //                                      &
     216                              '&Please have a look at the online description of the ' //           &
    224217                              'error message for further hints.'
    225218             CALL message( 'check_open', 'PA0661', 3, 2, 0, 6, 1 )
    … …  
    229222
    230223          IF ( myid_char == '' )  THEN
    231              OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//myid_char,        &
    232                         FORM='UNFORMATTED', STATUS='OLD' )
    233           ELSE
    234 !
    235 !--          First opening of unit 13 openes file _000000 on all PEs because
    236 !--          only this file contains the global variables
     224             OPEN ( 13, FILE = 'BININ' // TRIM( coupling_char ) // myid_char, FORM = 'UNFORMATTED',&
     225                        STATUS = 'OLD' )
     226          ELSE
     227!
     228!--          First opening of unit 13 openes file _000000 on all PEs because only this file contains
     229!--          the global variables.
    237230             IF ( .NOT. openfile(file_id)%opened_before )  THEN
    238                 OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/_000000',    &
    239                            FORM='UNFORMATTED', STATUS='OLD' )
     231                OPEN ( 13, FILE = 'BININ' // TRIM( coupling_char ) // '/_000000',                  &
     232                           FORM = 'UNFORMATTED', STATUS = 'OLD' )
    240233             ELSE
    241                 OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/'//          &
    242                            myid_char, FORM='UNFORMATTED', STATUS='OLD' )
     234                OPEN ( 13, FILE = 'BININ' // TRIM( coupling_char ) // '/' // myid_char,            &
     235                           FORM = 'UNFORMATTED', STATUS = 'OLD' )
    243236             ENDIF
    244237          ENDIF
    … …  
    247240
    248241          IF ( myid_char == '' )  THEN
    249              OPEN ( 14, FILE='BINOUT'//TRIM( coupling_char )//myid_char,       &
    250                         FORM='UNFORMATTED', POSITION='APPEND' )
     242             OPEN ( 14, FILE = 'BINOUT' // TRIM( coupling_char ) // myid_char,                     &
     243                        FORM = 'UNFORMATTED', POSITION = 'APPEND' )
    251244          ELSE
    252245             IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  THEN
    … …  
    255248#if defined( __parallel )
    256249!
    257 !--          Set a barrier in order to allow that all other processors in the
    258 !--          directory created by PE0 can open their file
     250!--          Set a barrier in order to allow that all other processors in the directory created by
     251!--          PE0 can open their file
    259252             CALL MPI_BARRIER( comm2d, ierr )
    260253#endif
    261254             ioerr = 1
    262255             DO WHILE ( ioerr /= 0 )
    263                 OPEN ( 14, FILE='BINOUT'//TRIM(coupling_char)//'/'//myid_char, &
    264                            FORM='UNFORMATTED', IOSTAT=ioerr )
     256                OPEN ( 14, FILE = 'BINOUT' // TRIM(coupling_char)// '/' // myid_char,              &
     257                           FORM = 'UNFORMATTED', IOSTAT = ioerr )
    265258                IF ( ioerr /= 0 )  THEN
    266                    WRITE( 9, * )  '*** could not open "BINOUT'//         &
    267                                   TRIM(coupling_char)//'/'//myid_char//  &
     259                   WRITE( 9, * )  '*** could not open "BINOUT' //                                  &
     260                                  TRIM(coupling_char) // '/' // myid_char //                       &
    268261                                  '"! Trying again in 1 sec.'
    269262                   CALL fortran_sleep( 1 )
    … …  
    275268       CASE ( 15 )
    276269
    277           OPEN ( 15, FILE='RUN_CONTROL'//TRIM( coupling_char ),                &
    278                      FORM='FORMATTED' )
     270          OPEN ( 15, FILE = 'RUN_CONTROL' // TRIM( coupling_char ), FORM = 'FORMATTED' )
    279271
    280272       CASE ( 16 )
    281273
    282           OPEN ( 16, FILE='LIST_PROFIL'//TRIM( coupling_char ),                &
    283                      FORM='FORMATTED' )
     274          OPEN ( 16, FILE = 'LIST_PROFIL' // TRIM( coupling_char ), FORM = 'FORMATTED' )
    284275
    285276       CASE ( 17 )
    286277
    287           OPEN ( 17, FILE='LIST_PROFIL_1D'//TRIM( coupling_char ),             &
    288                      FORM='FORMATTED' )
     278          OPEN ( 17, FILE = 'LIST_PROFIL_1D' // TRIM( coupling_char ), FORM = 'FORMATTED' )
    289279
    290280       CASE ( 18 )
    291281
    292           OPEN ( 18, FILE='CPU_MEASURES'//TRIM( coupling_char ),               &
    293                      FORM='FORMATTED' )
     282          OPEN ( 18, FILE = 'CPU_MEASURES' // TRIM( coupling_char ), FORM = 'FORMATTED' )
    294283
    295284       CASE ( 19 )
    296285
    297           OPEN ( 19, FILE='HEADER'//TRIM( coupling_char ), FORM='FORMATTED' )
     286          OPEN ( 19, FILE = 'HEADER' // TRIM( coupling_char ), FORM = 'FORMATTED' )
    298287
    299288       CASE ( 20 )
    … …  
    303292          ENDIF
    304293          IF ( myid_char == '' )  THEN
    305              OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/_000000',    &
    306                         FORM='UNFORMATTED', POSITION='APPEND' )
    307           ELSE
    308 #if defined( __parallel )
    309 !
    310 !--          Set a barrier in order to allow that all other processors in the
    311 !--          directory created by PE0 can open their file
     294             OPEN ( 20, FILE = 'DATA_LOG' // TRIM( coupling_char ) // '/_000000',                  &
     295                        FORM = 'UNFORMATTED', POSITION = 'APPEND' )
     296          ELSE
     297#if defined( __parallel )
     298!
     299!--          Set a barrier in order to allow that all other processors in the directory created by
     300!--          PE0 can open their file
    312301             CALL MPI_BARRIER( comm2d, ierr )
    313302#endif
    314303             ioerr = 1
    315304             DO WHILE ( ioerr /= 0 )
    316                 OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/'//       &
    317                            myid_char, FORM='UNFORMATTED', POSITION='APPEND',   &
    318                            IOSTAT=ioerr )
     305                OPEN ( 20, FILE = 'DATA_LOG' // TRIM( coupling_char ) // '/' // myid_char,         &
     306                           FORM = 'UNFORMATTED', POSITION = 'APPEND', IOSTAT = ioerr )
    319307                IF ( ioerr /= 0 )  THEN
    320                    WRITE( 9, * )  '*** could not open "DATA_LOG'//         &
    321                                   TRIM( coupling_char )//'/'//myid_char//  &
    322                                   '"! Trying again in 1 sec.'
     308                   WRITE( 9, * )  '*** could not open "DATA_LOG' // TRIM( coupling_char ) // '/' //&
     309                                   myid_char // '"! Trying again in 1 sec.'
    323310                   CALL fortran_sleep( 1 )
    324311                ENDIF
    … …  
    330317
    331318          IF ( data_output_2d_on_each_pe )  THEN
    332              OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char )//myid_char,    &
    333                         FORM='UNFORMATTED', POSITION='APPEND' )
    334           ELSE
    335              OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char ),                       &
    336                         FORM='UNFORMATTED', POSITION='APPEND' )
     319             OPEN ( 21, FILE = 'PLOT2D_XY' // TRIM( coupling_char ) // myid_char,                  &
     320                        FORM = 'UNFORMATTED', POSITION = 'APPEND' )
     321          ELSE
     322             OPEN ( 21, FILE = 'PLOT2D_XY' // TRIM( coupling_char ),                               &
     323                        FORM ='UNFORMATTED', POSITION = 'APPEND' )
    337324          ENDIF
    338325
    … …  
    349336
    350337          IF ( data_output_2d_on_each_pe )  THEN
    351              OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char )//myid_char,    &
    352                         FORM='UNFORMATTED', POSITION='APPEND' )
    353           ELSE
    354              OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char ),               &
    355                         FORM='UNFORMATTED', POSITION='APPEND' )
     338             OPEN ( 22, FILE = 'PLOT2D_XZ' // TRIM( coupling_char ) // myid_char,                  &
     339                        FORM = 'UNFORMATTED', POSITION = 'APPEND' )
     340          ELSE
     341             OPEN ( 22, FILE = 'PLOT2D_XZ' // TRIM( coupling_char ), FORM = 'UNFORMATTED',         &
     342                        POSITION = 'APPEND' )
    356343          ENDIF
    357344
    … …  
    368355
    369356          IF ( data_output_2d_on_each_pe )  THEN
    370              OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char )//myid_char,    &
    371                         FORM='UNFORMATTED', POSITION='APPEND' )
    372           ELSE
    373              OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char ),               &
    374                         FORM='UNFORMATTED', POSITION='APPEND' )
     357             OPEN ( 23, FILE = 'PLOT2D_YZ' // TRIM( coupling_char ) // myid_char,                  &
     358                        FORM = 'UNFORMATTED', POSITION='APPEND' )
     359          ELSE
     360             OPEN ( 23, FILE = 'PLOT2D_YZ' // TRIM( coupling_char ), FORM = 'UNFORMATTED',         &
     361                        POSITION = 'APPEND' )
    375362          ENDIF
    376363
    … …  
    383370
    384371          ENDIF
    385          
     372
    386373       CASE ( 25 )
    387374!
    388375!--       Binary files for surface data
    389           ! OPEN ( 25, FILE='SURFACE_DATA_BIN'//TRIM( coupling_char )//          &
    390           !                 myid_char, FORM='UNFORMATTED', POSITION='APPEND' )
     376          ! OPEN ( 25, FILE = 'SURFACE_DATA_BIN' // TRIM( coupling_char ) // myid_char,            &
     377          !            FORM = 'UNFORMATTED', POSITION = 'APPEND' )
    391378
    392379          IF ( myid_char == '' )  THEN
    393              OPEN ( 25, FILE='SURFACE_DATA_BIN'//TRIM( coupling_char )//       &
    394                              myid_char, FORM='UNFORMATTED', POSITION='APPEND' )
     380             OPEN ( 25, FILE = 'SURFACE_DATA_BIN' // TRIM( coupling_char ) // myid_char,           &
     381                        FORM = 'UNFORMATTED', POSITION = 'APPEND' )
    395382          ELSE
    396383             IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  THEN
    397                 CALL local_system( 'mkdir  SURFACE_DATA_BIN' //                &
    398                                    TRIM( coupling_char ) )
    399              ENDIF
    400 #if defined( __parallel )
    401 !
    402 !--          Set a barrier in order to allow that all other processors in the
    403 !--          directory created by PE0 can open their file
     384                CALL local_system( 'mkdir  SURFACE_DATA_BIN' // TRIM( coupling_char ) )
     385             ENDIF
     386#if defined( __parallel )
     387!
     388!--          Set a barrier in order to allow that all other processors in the directory created by
     389!--          PE0 can open their file
    404390             CALL MPI_BARRIER( comm2d, ierr )
    405391#endif
    406392             ioerr = 1
    407393             DO WHILE ( ioerr /= 0 )
    408                 OPEN ( 25, FILE='SURFACE_DATA_BIN'//TRIM(coupling_char)//      &
    409                                 '/'//myid_char,                                &
    410                            FORM='UNFORMATTED', IOSTAT=ioerr )
     394                OPEN ( 25, FILE = 'SURFACE_DATA_BIN' // TRIM(coupling_char) //  '/' // myid_char,  &
     395                           FORM = 'UNFORMATTED', IOSTAT = ioerr )
    411396                IF ( ioerr /= 0 )  THEN
    412                    WRITE( 9, * )  '*** could not open "SURFACE_DATA_BIN'//     &
    413                                   TRIM(coupling_char)//'/'//myid_char//        &
    414                                   '"! Trying again in 1 sec.'
     397                   WRITE( 9, * )  '*** could not open "SURFACE_DATA_BIN'// TRIM(coupling_char) //  &
     398                                  '/' // myid_char // '"! Trying again in 1 sec.'
    415399                   CALL fortran_sleep( 1 )
    416400                ENDIF
    … …  
    422406!
    423407!--       Binary files for averaged surface data
    424           ! OPEN ( 26, FILE='SURFACE_DATA_AV_BIN'//TRIM( coupling_char )//myid_char,  &
    425           !        FORM='UNFORMATTED', POSITION='APPEND' )
     408          ! OPEN ( 26, FILE = 'SURFACE_DATA_AV_BIN' // TRIM( coupling_char ) // myid_char,         &
     409          !        FORM = 'UNFORMATTED', POSITION = 'APPEND' )
    426410
    427411          IF ( myid_char == '' )  THEN
    428              OPEN ( 26, FILE='SURFACE_DATA_AV_BIN'//TRIM( coupling_char )//    &
    429                              myid_char, FORM='UNFORMATTED', POSITION='APPEND' )
     412             OPEN ( 26, FILE = 'SURFACE_DATA_AV_BIN' // TRIM( coupling_char ) // myid_char,        &
     413                        FORM = 'UNFORMATTED', POSITION = 'APPEND' )
    430414          ELSE
    431415             IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  THEN
    432                 CALL local_system( 'mkdir  SURFACE_DATA_AV_BIN' //             &
    433                                    TRIM( coupling_char ) )
    434              ENDIF
    435 #if defined( __parallel )
    436 !
    437 !--          Set a barrier in order to allow that all other processors in the
    438 !--          directory created by PE0 can open their file
     416                CALL local_system( 'mkdir  SURFACE_DATA_AV_BIN' // TRIM( coupling_char ) )
     417             ENDIF
     418#if defined( __parallel )
     419!
     420!--          Set a barrier in order to allow that all other processors in the directory created by
     421!--          PE0 can open their file
    439422             CALL MPI_BARRIER( comm2d, ierr )
    440423#endif
    441424             ioerr = 1
    442425             DO WHILE ( ioerr /= 0 )
    443                 OPEN ( 26, FILE='SURFACE_DATA_AV_BIN'//TRIM(coupling_char)//   &
    444                                 '/'//myid_char,                                &
    445                            FORM='UNFORMATTED', IOSTAT=ioerr )
     426                OPEN ( 26, FILE = 'SURFACE_DATA_AV_BIN' // TRIM(coupling_char) // '/' // myid_char,&
     427                           FORM = 'UNFORMATTED', IOSTAT = ioerr )
    446428                IF ( ioerr /= 0 )  THEN
    447                    WRITE( 9, * )  '*** could not open "SURFACE_DATA_AV_BIN'//  &
    448                                   TRIM(coupling_char)//'/'//myid_char//        &
    449                                   '"! Trying again in 1 sec.'
     429                   WRITE( 9, * )  '*** could not open "SURFACE_DATA_AV_BIN' // TRIM(coupling_char) &
     430                                  // '/' // myid_char // '"! Trying again in 1 sec.'
    450431                   CALL fortran_sleep( 1 )
    451432                ENDIF
    … …  
    456437       CASE ( 30 )
    457438
    458           OPEN ( 30, FILE='PLOT3D_DATA'//TRIM( coupling_char )//myid_char,     &
    459                      FORM='UNFORMATTED' )
     439          OPEN ( 30, FILE = 'PLOT3D_DATA' // TRIM( coupling_char ) // myid_char,                   &
     440                     FORM = 'UNFORMATTED' )
    460441!
    461442!--       Specifications for combine_plot_fields
    … …  
    469450
    470451          IF ( myid_char == '' )  THEN
    471              OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM(coupling_char)//myid_char, &
    472                         FORM='FORMATTED', POSITION='APPEND' )
     452             OPEN ( 80, FILE = 'PARTICLE_INFOS'//TRIM(coupling_char)//myid_char, &
     453                        FORM = 'FORMATTED', POSITION='APPEND' )
    473454          ELSE
    474455             IF ( myid == 0  .AND.  .NOT. openfile(80)%opened_before )  THEN
    475                 CALL local_system( 'mkdir  PARTICLE_INFOS' //                  &
    476                                    TRIM( coupling_char ) )
    477              ENDIF
    478 #if defined( __parallel )
    479 !
    480 !--          Set a barrier in order to allow that thereafter all other
    481 !--          processors in the directory created by PE0 can open their file.
    482 !--          WARNING: The following barrier will lead to hanging jobs, if
    483 !--                   check_open is first called from routine
    484 !--                   allocate_prt_memory!
     456                CALL local_system( 'mkdir  PARTICLE_INFOS' // TRIM( coupling_char ) )
     457             ENDIF
     458#if defined( __parallel )
     459!
     460!--          Set a barrier in order to allow that thereafter all other processors in the directory
     461!--          created by PE0 can open their file.
     462!--          WARNING: The following barrier will lead to hanging jobs, if check_open is first called
     463!--                   from routine allocate_prt_memory!
    485464             IF ( .NOT. openfile(80)%opened_before )  THEN
    486465                CALL MPI_BARRIER( comm2d, ierr )
    487466             ENDIF
    488467#endif
    489              OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM( coupling_char )//'/'//    &
    490                              myid_char,                                        &
    491                         FORM='FORMATTED', POSITION='APPEND' )
     468             OPEN ( 80, FILE = 'PARTICLE_INFOS' // TRIM( coupling_char ) // '/' // myid_char,      &
     469                        FORM = 'FORMATTED', POSITION = 'APPEND' )
    492470          ENDIF
    493471
    … …  
    499477
    500478          IF ( myid_char == '' )  THEN
    501              OPEN ( 85, FILE='PARTICLE_DATA'//TRIM(coupling_char)//myid_char,  &
    502                         FORM='UNFORMATTED', POSITION='APPEND' )
     479             OPEN ( 85, FILE = 'PARTICLE_DATA' // TRIM(coupling_char) // myid_char,                &
     480                        FORM = 'UNFORMATTED', POSITION = 'APPEND' )
    503481          ELSE
    504482             IF ( myid == 0  .AND.  .NOT. openfile(85)%opened_before )  THEN
    505                 CALL local_system( 'mkdir  PARTICLE_DATA' //                   &
    506                                    TRIM( coupling_char ) )
    507              ENDIF
    508 #if defined( __parallel )
    509 !
    510 !--          Set a barrier in order to allow that thereafter all other
    511 !--          processors in the directory created by PE0 can open their file
     483                CALL local_system( 'mkdir  PARTICLE_DATA' // TRIM( coupling_char ) )
     484             ENDIF
     485#if defined( __parallel )
     486!
     487!--          Set a barrier in order to allow that thereafter all other processors in the directory
     488!--          created by PE0 can open their file
    512489             CALL MPI_BARRIER( comm2d, ierr )
    513490#endif
    514491             ioerr = 1
    515492             DO WHILE ( ioerr /= 0 )
    516                 OPEN ( 85, FILE='PARTICLE_DATA'//TRIM( coupling_char )//'/'//  &
    517                            myid_char,                                          &
    518                            FORM='UNFORMATTED', POSITION='APPEND', IOSTAT=ioerr )
     493                OPEN ( 85, FILE = 'PARTICLE_DATA' // TRIM( coupling_char ) // '/' // myid_char,    &
     494                           FORM = 'UNFORMATTED', POSITION = 'APPEND', IOSTAT = ioerr )
    519495                IF ( ioerr /= 0 )  THEN
    520                    WRITE( 9, * )  '*** could not open "PARTICLE_DATA'//        &
    521                                   TRIM( coupling_char )//'/'//myid_char//      &
    522                                   '"! Trying again in 1 sec.'
     496                   WRITE( 9, * )  '*** could not open "PARTICLE_DATA' // TRIM( coupling_char ) //  &
     497                                  '/' // myid_char // '"! Trying again in 1 sec.'
    523498                   CALL fortran_sleep( 1 )
    524499                ENDIF
    … …  
    530505             WRITE ( 85 )  run_description_header
    531506!
    532 !--          Attention: change version number whenever the output format on
    533 !--                     unit 85 is changed (see also in routine
    534 !--                     lpm_data_output_particles)
     507!--          Attention: change version number whenever the output format on unit 85 is changed (see
     508!--                     also in routine lpm_data_output_particles)
    535509             rtext = 'data format version 3.1'
    536510             WRITE ( 85 )  rtext
    537              WRITE ( 85 )  number_of_particle_groups,                          &
    538                            max_number_of_particle_groups
     511             WRITE ( 85 )  number_of_particle_groups, max_number_of_particle_groups
    539512             WRITE ( 85 )  particle_groups
    540513             WRITE ( 85 )  nxl, nxr, nys, nyn, nzb, nzt, nbgp
    … …  
    542515
    543516!
    544 !--    File where sky-view factors and further required data is stored will be
    545 !--    read
     517!--    File where sky-view factors and further required data is stored will be read
    546518       CASE ( 88 )
    547519
    548520          IF ( myid_char == '' )  THEN
    549              OPEN ( 88, FILE='SVFIN'//TRIM( coupling_char )//myid_char,        &
    550                         FORM='UNFORMATTED', STATUS='OLD', IOSTAT=ioerr )
    551           ELSE
    552 
    553              OPEN ( 88, FILE='SVFIN'//TRIM( coupling_char )//'/'//myid_char,   &
    554                         FORM='UNFORMATTED', STATUS='OLD', IOSTAT=ioerr )
    555           ENDIF
    556 
    557 !
    558 !--    File where sky-view factors and further required data is stored will be
    559 !--    created
     521             OPEN ( 88, FILE = 'SVFIN' // TRIM( coupling_char ) // myid_char, FORM = 'UNFORMATTED',&
     522                        STATUS = 'OLD', IOSTAT = ioerr )
     523          ELSE
     524
     525             OPEN ( 88, FILE = 'SVFIN' // TRIM( coupling_char ) // '/' // myid_char,               &
     526                        FORM = 'UNFORMATTED', STATUS = 'OLD', IOSTAT = ioerr )
     527          ENDIF
     528
     529!
     530!--    File where sky-view factors and further required data is stored will be created
    560531       CASE ( 89 )
    561532
    562533          IF ( myid_char == '' )  THEN
    563              OPEN ( 89, FILE='SVFOUT'//TRIM( coupling_char )//myid_char,       &
    564                         FORM='UNFORMATTED', STATUS='NEW' )
    565           ELSE
    566              IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  THEN
     534             OPEN ( 89, FILE = 'SVFOUT' // TRIM( coupling_char ) // myid_char,                     &
     535                        FORM = 'UNFORMATTED', STATUS = 'NEW' )
     536          ELSE
     537             IF ( myid == 0  .AND.  .NOT. openfile(file_id)%opened_before )  THEN
    567538                CALL local_system( 'mkdir  SVFOUT' // TRIM( coupling_char ) )
    568539             ENDIF
    569540#if defined( __parallel )
    570541!
    571 !--          Set a barrier in order to allow that all other processors in the
    572 !--          directory created by PE0 can open their file
     542!--          Set a barrier in order to allow that all other processors in the directory created by
     543!--          PE0 can open their file
    573544             CALL MPI_BARRIER( comm2d, ierr )
    574545#endif
    575546             ioerr = 1
    576547             DO WHILE ( ioerr /= 0 )
    577                 OPEN ( 89, FILE='SVFOUT'//TRIM(coupling_char)//'/'//myid_char, &
    578                            FORM='UNFORMATTED', STATUS='NEW', IOSTAT=ioerr )
     548                OPEN ( 89, FILE = 'SVFOUT' // TRIM(coupling_char) // '/' // myid_char,            &
     549                           FORM = 'UNFORMATTED', STATUS = 'NEW', IOSTAT = ioerr )
    579550                IF ( ioerr /= 0 )  THEN
    580                    WRITE( 9, * )  '*** could not open "SVFOUT'//               &
    581                                   TRIM(coupling_char)//'/'//myid_char//        &
    582                                   '"! Trying again in 1 sec.'
     551                   WRITE( 9, * )  '*** could not open "SVFOUT' // TRIM(coupling_char) // '/' //    &
     552                                  myid_char // '"! Trying again in 1 sec.'
    583553                   CALL fortran_sleep( 1 )
    584554                ENDIF
    … …  
    591561       CASE ( 117 )
    592562
    593           OPEN ( 117, FILE='PROGRESS'//TRIM( coupling_char ),                  &
    594                       STATUS='REPLACE', FORM='FORMATTED' )
     563          OPEN ( 117, FILE = 'PROGRESS' // TRIM( coupling_char ), STATUS = 'REPLACE',              &
     564                      FORM = 'FORMATTED' )
    595565
    596566#if defined( __netcdf )
    … …  
    606576          ENDIF
    607577!
    608 !--       Inquire, if there is a netCDF file from a previuos run. This should
    609 !--       be opened for extension, if its dimensions and variables match the
    610 !--       actual run.
    611           INQUIRE( FILE=filename, EXIST=netcdf_extend )
     578!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
     579!--       extension, if its dimensions and variables match the actual run.
     580          INQUIRE( FILE = filename, EXIST = netcdf_extend )
    612581          IF ( netcdf_extend )  THEN
    613582!
    … …  
    615584             CALL netcdf_open_write_file( filename, id_set_xy(av), .TRUE., 20 )
    616585!
    617 !--          Read header information and set all ids. If there is a mismatch
    618 !--          between the previuos and the actual run, netcdf_extend is returned
    619 !--          as .FALSE.
     586!--          Read header information and set all ids. If there is a mismatch between the previous
     587!--          and the actual run, netcdf_extend is returned as .FALSE.
    620588             CALL netcdf_define_header( 'xy', netcdf_extend, av )
    621589
    … …  
    628596#if defined( __parallel )
    629597!
    630 !--             Set a barrier in order to assure that PE0 deleted the old file
    631 !--             before any other processor tries to open a new file.
     598!--             Set a barrier in order to assure that PE0 deleted the old file before any other
     599!--             processor tries to open a new file.
    632600!--             Barrier is only needed in case of parallel I/O
    633601                IF ( netcdf_data_format > 4 )  CALL MPI_BARRIER( comm2d, ierr )
    … …  
    647615
    648616!
    649 !--          In case of parallel netCDF output, create flag file which tells
    650 !--          combine_plot_fields that nothing is to do.
     617!--          In case of parallel netCDF output, create flag file which tells combine_plot_fields
     618!--          that nothing is to do.
    651619             IF ( myid == 0  .AND.  netcdf_data_format > 4 )  THEN
    652                 OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XY' )
     620                OPEN( 99, FILE = 'NO_COMBINE_PLOT_FIELDS_XY' )
    653621                WRITE ( 99, '(A)' )  'no combine_plot_fields.x neccessary'
    654622                CLOSE( 99 )
    … …  
    668636          ENDIF
    669637!
    670 !--       Inquire, if there is a netCDF file from a previuos run. This should
    671 !--       be opened for extension, if its dimensions and variables match the
    672 !--       actual run.
    673           INQUIRE( FILE=filename, EXIST=netcdf_extend )
     638!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
     639!--       extension, if its dimensions and variables match the actual run.
     640          INQUIRE( FILE = filename, EXIST = netcdf_extend )
    674641
    675642          IF ( netcdf_extend )  THEN
    … …  
    678645             CALL netcdf_open_write_file( filename, id_set_xz(av), .TRUE., 23 )
    679646!
    680 !--          Read header information and set all ids. If there is a mismatch
    681 !--          between the previuos and the actual run, netcdf_extend is returned
    682 !--          as .FALSE.
     647!--          Read header information and set all ids. If there is a mismatch between the previous
     648!--          and the actual run, netcdf_extend is returned as .FALSE.
    683649             CALL netcdf_define_header( 'xz', netcdf_extend, av )
    684650
    … …  
    691657#if defined( __parallel )
    692658!
    693 !--             Set a barrier in order to assure that PE0 deleted the old file
    694 !--             before any other processor tries to open a new file
     659!--             Set a barrier in order to assure that PE0 deleted the old file before any other
     660!--             processor tries to open a new file.
    695661!--             Barrier is only needed in case of parallel I/O
    696662                IF ( netcdf_data_format > 4 )  CALL MPI_BARRIER( comm2d, ierr )
    … …  
    710676
    711677!
    712 !--          In case of parallel netCDF output, create flag file which tells
    713 !--          combine_plot_fields that nothing is to do.
     678!--          In case of parallel netCDF output, create flag file which tells combine_plot_fields
     679!--          that nothing is to do.
    714680             IF ( myid == 0  .AND.  netcdf_data_format > 4 )  THEN
    715                 OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XZ' )
     681                OPEN( 99, FILE = 'NO_COMBINE_PLOT_FIELDS_XZ' )
    716682                WRITE ( 99, '(A)' )  'no combine_plot_fields.x neccessary'
    717683                CLOSE( 99 )
    … …  
    731697          ENDIF
    732698!
    733 !--       Inquire, if there is a netCDF file from a previuos run. This should
    734 !--       be opened for extension, if its dimensions and variables match the
    735 !--       actual run.
    736           INQUIRE( FILE=filename, EXIST=netcdf_extend )
     699!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
     700!--       extension, if its dimensions and variables match the actual run.
     701          INQUIRE( FILE = filename, EXIST=netcdf_extend )
    737702
    738703          IF ( netcdf_extend )  THEN
    … …  
    741706             CALL netcdf_open_write_file( filename, id_set_yz(av), .TRUE., 26 )
    742707!
    743 !--          Read header information and set all ids. If there is a mismatch
    744 !--          between the previuos and the actual run, netcdf_extend is returned
    745 !--          as .FALSE.
     708!--          Read header information and set all ids. If there is a mismatch between the previous
     709!--          and the actual run, netcdf_extend is returned as .FALSE.
    746710             CALL netcdf_define_header( 'yz', netcdf_extend, av )
    747711
    … …  
    754718#if defined( __parallel )
    755719!
    756 !--             Set a barrier in order to assure that PE0 deleted the old file
    757 !--             before any other processor tries to open a new file
     720!--             Set a barrier in order to assure that PE0 deleted the old file before any other
     721!--             processor tries to open a new file.
    758722!--             Barrier is only needed in case of parallel I/O
    759723                IF ( netcdf_data_format > 4 )  CALL MPI_BARRIER( comm2d, ierr )
    … …  
    773737
    774738!
    775 !--          In case of parallel netCDF output, create flag file which tells
    776 !--          combine_plot_fields that nothing is to do.
     739!--          In case of parallel netCDF output, create flag file which tells combine_plot_fields
     740!--          that nothing is to do.
    777741             IF ( myid == 0  .AND.  netcdf_data_format > 4 )  THEN
    778                 OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_YZ' )
     742                OPEN( 99, FILE = 'NO_COMBINE_PLOT_FIELDS_YZ' )
    779743                WRITE ( 99, '(A)' )  'no combine_plot_fields.x neccessary'
    780744                CLOSE( 99 )
    … …  
    789753
    790754!
    791 !--       Inquire, if there is a netCDF file from a previuos run. This should
    792 !--       be opened for extension, if its variables match the actual run.
    793           INQUIRE( FILE=filename, EXIST=netcdf_extend )
     755!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
     756!--       extension, if its variables match the actual run.
     757          INQUIRE( FILE = filename, EXIST = netcdf_extend )
    794758
    795759          IF ( netcdf_extend )  THEN
    … …  
    798762             CALL netcdf_open_write_file( filename, id_set_pr, .FALSE., 29 )
    799763!
    800 !--          Read header information and set all ids. If there is a mismatch
    801 !--          between the previuos and the actual run, netcdf_extend is returned
    802 !--          as .FALSE.
     764!--          Read header information and set all ids. If there is a mismatch between the previous
     765!--          and the actual run, netcdf_extend is returned as .FALSE.
    803766             CALL netcdf_define_header( 'pr', netcdf_extend, 0 )
    804767
    … …  
    811774             ENDIF
    812775
    813           ENDIF         
     776          ENDIF
    814777
    815778          IF ( .NOT. netcdf_extend )  THEN
    … …  
    829792
    830793!
    831 !--       Inquire, if there is a netCDF file from a previuos run. This should
    832 !--       be opened for extension, if its variables match the actual run.
    833           INQUIRE( FILE=filename, EXIST=netcdf_extend )
     794!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
     795!--       extension, if its variables match the actual run.
     796          INQUIRE( FILE = filename, EXIST = netcdf_extend )
    834797
    835798          IF ( netcdf_extend )  THEN
    … …  
    838801             CALL netcdf_open_write_file( filename, id_set_ts, .FALSE., 32 )
    839802!
    840 !--          Read header information and set all ids. If there is a mismatch
    841 !--          between the previuos and the actual run, netcdf_extend is returned
    842 !--          as .FALSE.
     803!--          Read header information and set all ids. If there is a mismatch between the previous
     804!--          and the actual run, netcdf_extend is returned as .FALSE.
    843805             CALL netcdf_define_header( 'ts', netcdf_extend, 0 )
    844806
    … …  
    851813             ENDIF
    852814
    853           ENDIF         
     815          ENDIF
    854816
    855817          IF ( .NOT. netcdf_extend )  THEN
    … …  
    875837          ENDIF
    876838!
    877 !--       Inquire, if there is a netCDF file from a previous run. This should
    878 !--       be opened for extension, if its dimensions and variables match the
    879 !--       actual run.
    880           INQUIRE( FILE=filename, EXIST=netcdf_extend )
     839!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
     840!--       extension, if its dimensions and variables match the actual run.
     841          INQUIRE( FILE = filename, EXIST = netcdf_extend )
    881842          IF ( netcdf_extend )  THEN
    882843!
    … …  
    884845             CALL netcdf_open_write_file( filename, id_set_3d(av), .TRUE., 35 )
    885846!
    886 !--          Read header information and set all ids. If there is a mismatch
    887 !--          between the previuos and the actual run, netcdf_extend is returned
    888 !--          as .FALSE.
     847!--          Read header information and set all ids. If there is a mismatch between the previous
     848!--          and the actual run, netcdf_extend is returned as .FALSE.
    889849             CALL netcdf_define_header( '3d', netcdf_extend, av )
    890850
    … …  
    897857#if defined( __parallel )
    898858!
    899 !--             Set a barrier in order to assure that PE0 deleted the old file
    900 !--             before any other processor tries to open a new file
     859!--             Set a barrier in order to assure that PE0 deleted the old file before any other
     860!--             processor tries to open a new file.
    901861!--             Barrier is only needed in case of parallel I/O
    902862                IF ( netcdf_data_format > 4 )  CALL MPI_BARRIER( comm2d, ierr )
    … …  
    916876
    917877!
    918 !--          In case of parallel netCDF output, create flag file which tells
    919 !--          combine_plot_fields that nothing is to do.
     878!--          In case of parallel netCDF output, create flag file which tells combine_plot_fields
     879!--          that nothing is to do.
    920880             IF ( myid == 0  .AND.  netcdf_data_format > 4 )  THEN
    921881                OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_3D' )
    … …  
    933893
    934894!
    935 !--       Inquire, if there is a netCDF file from a previuos run. This should
    936 !--       be opened for extension, if its variables match the actual run.
     895!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
     896!--       extension, if its variables match the actual run.
    937897          INQUIRE( FILE=filename, EXIST=netcdf_extend )
    938898
    … …  
    943903
    944904!
    945 !--          Read header information and set all ids. If there is a mismatch
    946 !--          between the previuos and the actual run, netcdf_extend is returned
    947 !--          as .FALSE.
     905!--          Read header information and set all ids. If there is a mismatch between the previous
     906!--          and the actual run, netcdf_extend is returned as .FALSE.
    948907             CALL netcdf_define_header( 'sp', netcdf_extend, 0 )
    949908
    … …  
    956915             ENDIF
    957916
    958           ENDIF         
     917          ENDIF
    959918
    960919          IF ( .NOT. netcdf_extend )  THEN
    … …  
    979938!          ENDIF
    980939!
    981 !--       Inquire, if there is a netCDF file from a previuos run. This should
     940!--       Inquire, if there is a netCDF file from a previous run. This should
    982941!--       be opened for extension, if its variables match the actual run.
    983942!          INQUIRE( FILE=filename, EXIST=netcdf_extend )
    … …  
    989948!
    990949!--          Read header information and set all ids. If there is a mismatch
    991 !--          between the previuos and the actual run, netcdf_extend is returned
     950!--          between the previous and the actual run, netcdf_extend is returned
    992951!--          as .FALSE.
    993952!             CALL netcdf_define_header( 'pt', netcdf_extend, 0 )
    … …  
    1001960!             ENDIF
    1002961
    1003 !          ENDIF         
     962!          ENDIF
    1004963
    1005964!          IF ( .NOT. netcdf_extend )  THEN
    … …  
    1014973!                ENDIF
    1015974#if defined( __parallel )
    1016 ! 
     975!
    1017976!--             Set a barrier in order to allow that all other processors in the
    1018977!--             directory created by PE0 can open their file
    … …  
    1037996
    1038997!
    1039 !--       Inquire, if there is a netCDF file from a previuos run. This should
    1040 !--       be opened for extension, if its variables match the actual run.
    1041           INQUIRE( FILE=filename, EXIST=netcdf_extend )
     998!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
     999!--       extension, if its variables match the actual run.
     1000          INQUIRE( FILE = filename, EXIST = netcdf_extend )
    10421001
    10431002          IF ( netcdf_extend )  THEN
    … …  
    10461005             CALL netcdf_open_write_file( filename, id_set_pts, .FALSE., 393 )
    10471006!
    1048 !--          Read header information and set all ids. If there is a mismatch
    1049 !--          between the previuos and the actual run, netcdf_extend is returned
    1050 !--          as .FALSE.
     1007!--          Read header information and set all ids. If there is a mismatch between the previous
     1008!--          and the actual run, netcdf_extend is returned as .FALSE.
    10511009             CALL netcdf_define_header( 'ps', netcdf_extend, 0 )
    10521010
    … …  
    10591017             ENDIF
    10601018
    1061           ENDIF         
     1019          ENDIF
    10621020
    10631021          IF ( .NOT. netcdf_extend )  THEN
    … …  
    10761034             filename = 'DATA_AGT_NETCDF'
    10771035!
    1078 !--       Inquire, if there is a netCDF file from a previuos run. This should
    1079 !--       be opened for extension, if its variables match the actual run.
     1036!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
     1037!--       extension, if its variables match the actual run.
    10801038          INQUIRE( FILE=filename, EXIST=netcdf_extend )
    10811039
    … …  
    10951053! !
    10961054! !--          Read header information and set all ids. If there is a mismatch
    1097 ! !--          between the previuos and the actual run, netcdf_extend is returned
     1055! !--          between the previous and the actual run, netcdf_extend is returned
    10981056! !--          as .FALSE.
    10991057!              CALL netcdf_define_header( 'ag', netcdf_extend, 0 )
    1100 ! 
     1058!
    11011059! !
    11021060! !--          Remove the local file, if it can not be extended
    … …  
    11061064!                 CALL local_system( 'rm ' // TRIM( filename ) )
    11071065!              ENDIF
    1108 ! 
     1066!
    11091067!           ENDIF
    11101068
    … …  
    11201078!                 ENDIF
    11211079! #if defined( __parallel )
    1122 ! ! 
     1080! !
    11231081! !--             Set a barrier in order to allow that all other processors in the
    11241082! !--             directory created by PE0 can open their file
    … …  
    11381096
    11391097!
    1140 !--       Inquire, if there is a netCDF file from a previuos run. This should
    1141 !--       be opened for extension, if its variables match the actual run.
    1142           INQUIRE( FILE=filename, EXIST=netcdf_extend )
     1098!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
     1099!--       extension, if its variables match the actual run.
     1100          INQUIRE( FILE = filename, EXIST = netcdf_extend )
    11431101
    11441102          IF ( netcdf_extend )  THEN
    … …  
    11471105             CALL netcdf_open_write_file( filename, id_set_fl, .FALSE., 532 )
    11481106!
    1149 !--          Read header information and set all ids. If there is a mismatch
    1150 !--          between the previuos and the actual run, netcdf_extend is returned
    1151 !--          as .FALSE.
     1107!--          Read header information and set all ids. If there is a mismatch between the previous
     1108!--          and the actual run, netcdf_extend is returned as .FALSE.
    11521109             CALL netcdf_define_header( 'fl', netcdf_extend, 0 )
    11531110
    … …  
    11601117             ENDIF
    11611118
    1162           ENDIF         
     1119          ENDIF
    11631120
    11641121          IF ( .NOT. netcdf_extend )  THEN
    … …  
    11791136             mid = file_id - 200
    11801137             WRITE ( mask_char,'(A2,I2.2)')  '_M', mid
    1181              filename = 'DATA_MASK_NETCDF' // TRIM( coupling_char ) //         &
    1182                         mask_char
     1138             filename = 'DATA_MASK_NETCDF' // TRIM( coupling_char ) // mask_char
    11831139             av = 0
    11841140          ELSE
    11851141             mid = file_id - (200+max_masks)
    11861142             WRITE ( mask_char,'(A2,I2.2)')  '_M', mid
    1187              filename = 'DATA_MASK_AV_NETCDF' // TRIM( coupling_char ) //      &
    1188                         mask_char
     1143             filename = 'DATA_MASK_AV_NETCDF' // TRIM( coupling_char ) // mask_char
    11891144             av = 1
    11901145          ENDIF
    11911146!
    1192 !--       Inquire, if there is a netCDF file from a previuos run. This should
    1193 !--       be opened for extension, if its dimensions and variables match the
    1194 !--       actual run.
     1147!--       Inquire, if there is a netCDF file from a previous run. This should be opened for
     1148!--       extension, if its dimensions and variables match the actual run.
    11951149          INQUIRE( FILE=filename, EXIST=netcdf_extend )
    11961150
    … …  
    11981152!
    11991153!--          Open an existing netCDF file for output
    1200              CALL netcdf_open_write_file( filename, id_set_mask(mid,av),       &
    1201                                           .TRUE., 456 )
    1202 !
    1203 !--          Read header information and set all ids. If there is a mismatch
    1204 !--          between the previuos and the actual run, netcdf_extend is returned
    1205 !--          as .FALSE.
     1154             CALL netcdf_open_write_file( filename, id_set_mask(mid,av), .TRUE., 456 )
     1155!
     1156!--          Read header information and set all ids. If there is a mismatch between the previous
     1157!--          and the actual run, netcdf_extend is returned as .FALSE.
    12061158             CALL netcdf_define_header( 'ma', netcdf_extend, file_id )
    12071159
    … …  
    12141166             ENDIF
    12151167
    1216           ENDIF         
     1168          ENDIF
    12171169
    12181170          IF ( .NOT. netcdf_extend )  THEN
    12191171!
    12201172!--          Create a new netCDF output file with requested netCDF format
    1221              CALL netcdf_create_file( filename, id_set_mask(mid,av), .TRUE., 458 )
     1173             CALL netcdf_create_file( filename, id_set_mask(mid,av), .TRUE. , 458 )
    12221174!
    12231175!--          Define the header
    … …  
    12391191       CASE DEFAULT
    12401192
    1241           WRITE( message_string, * ) 'no OPEN-statement for file-id ',file_id
     1193          WRITE( message_string, * ) 'no OPEN-statement for file-id ', file_id
    12421194          CALL message( 'check_open', 'PA0172', 2, 2, -1, 6, 1 )
    12431195
    … …  
    12501202!
    12511203!-- Formats
    1252 8000 FORMAT (A/                                                                &
    1253              '  step    time    # of parts     lPE sent/recv  rPE sent/recv  ',&
    1254              'sPE sent/recv  nPE sent/recv    max # of parts  '/               &
     12048000 FORMAT (A/                                                                                    &
     1205             '  step    time    # of parts     lPE sent/recv  rPE sent/recv  ',                    &
     1206             'sPE sent/recv  nPE sent/recv    max # of parts  '/                                   &
    12551207             109('-'))
    12561208

  • palm/trunk/SOURCE/lagrangian_particle_model_mod.f90

    r4545 r4546  
    2525! -----------------
    2626! $Id$
     27! Variables iran and iran_part completely removed, added I/O of parallel random numbers to restart
     28! file
     29!
     30! 4545 2020-05-22 13:17:57Z schwenkel
    2731! Using parallel random generator, thus preventing dependency of PE number
    2832!
    … …  
    176180               intermediate_timestep_count, intermediate_timestep_count_max,   &
    177181               message_string, molecular_viscosity, ocean_mode,                &
    178                particle_maximum_age, iran, restart_data_format_output,         &
     182               particle_maximum_age, restart_data_format_output,               &
    179183               simulated_time, topography, dopts_time_count,                   &
    180184               time_since_reference_point, rho_surface, u_gtrans, v_gtrans,    &
    … …  
    260264    INTEGER(iwp) ::  deleted_particles = 0                        !< number of deleted particles per time step   
    261265    INTEGER(iwp) ::  i_splitting_mode                             !< dummy for splitting mode
    262     INTEGER(iwp) ::  iran_part = -1234567                         !< number for random generator   
    263266    INTEGER(iwp) ::  max_number_particles_per_gridbox = 100       !< namelist parameter (see documentation)
    264267    INTEGER(iwp) ::  isf                                          !< dummy for splitting function
    … …  
    282285    INTEGER(iwp) ::  trnp_count_recv_sum                          !< parameter for particle exchange of PEs
    283286
    284     INTEGER(isp), DIMENSION(:,:,:), ALLOCATABLE ::  seq_random_array_particle   !< sequence of random array for particle
     287    INTEGER(isp), DIMENSION(:,:,:), ALLOCATABLE ::  seq_random_array_particles   !< sequence of random array for particle
    285288
    286289    LOGICAL ::  lagrangian_particle_model = .FALSE.       !< namelist parameter (see documentation)
    … …  
    12491252          particle_groups(i)%radius        = radius(i)
    12501253       ENDDO
    1251 !
    1252 !--    Set a seed value for the random number generator to be exclusively
    1253 !--    used for the particle code. The generated random numbers should be
    1254 !--    different on the different PEs.
    1255        iran_part = iran_part + myid
    12561254
    12571255!
    12581256!--    Initialize parallel random number sequence seed for particles
    1259 !--    This is done individually, as thus particle random numbers does
    1260 !--    not affect random numbers used for the flow field.
    1261        ALLOCATE ( seq_random_array_particle(5,nys:nyn,nxl:nxr) )
    1262        seq_random_array_particle = 0
     1257!--    This is done separately here, as thus particle random numbers do not affect the random
     1258!--    numbers used for the flow field (e.g. for generating flow disturbances).
     1259       ALLOCATE ( seq_random_array_particles(5,nys:nyn,nxl:nxr) )
     1260       seq_random_array_particles = 0
    12631261
    12641262!--    Initializing with random_seed_parallel for every vertical
    … …  
    12691267             CALL random_seed_parallel (random_sequence=id_random_array(j, i))
    12701268             CALL random_number_parallel (random_dummy)
    1271              CALL random_seed_parallel (get=seq_random_array_particle(:, j, i))
     1269             CALL random_seed_parallel (get=seq_random_array_particles(:, j, i))
    12721270          ENDDO
    12731271       ENDDO
    … …  
    15371535!
    15381536!--          Put the random seeds at grid point jp, ip
    1539              CALL random_seed_parallel( put=seq_random_array_particle(:,jp,ip) )
     1537             CALL random_seed_parallel( put=seq_random_array_particles(:,jp,ip) )
    15401538             DO  kp = nzb+1, nzt
    15411539                number_of_particles = prt_count(kp,jp,ip)
    … …  
    16071605             ENDDO
    16081606!
    1609 !--       Get the new random seeds from last call at grid point jp, ip
    1610           CALL random_seed_parallel( get=seq_random_array_particle(:,jp,ip) )
     1607!--          Get the new random seeds from last call at grid point jp, ip
     1608             CALL random_seed_parallel( get=seq_random_array_particles(:,jp,ip) )
    16111609          ENDDO
    16121610       ENDDO
    … …  
    17381736!
    17391737!--       Put the random seeds at grid point jp, ip
    1740           CALL random_seed_parallel( put=seq_random_array_particle(:,jp,ip) )
     1738          CALL random_seed_parallel( put=seq_random_array_particles(:,jp,ip) )
    17411739          DO  kp = nzb+1, nzt
    17421740
    … …  
    17711769                particles(n)%weight_factor = particles(n)%weight_factor * aero_weight
    17721770!
    1773 !--             create random numver with parallel number generator
     1771!--             Create random numver with parallel number generator
    17741772                CALL random_number_parallel( random_dummy )
    17751773                IF ( particles(n)%weight_factor - FLOOR(particles(n)%weight_factor,KIND=wp) &
    … …  
    18191817          ENDDO
    18201818!
    1821 !--    Get the new random seeds from last call at grid point j
    1822        CALL random_seed_parallel( get=seq_random_array_particle(:,jp,ip) )
     1819!--       Get the new random seeds from last call at grid point j
     1820          CALL random_seed_parallel( get=seq_random_array_particles(:,jp,ip) )
    18231821       ENDDO
    18241822    ENDDO
    … …  
    22152213!
    22162214!--                   Put the random seeds at grid point j, i
    2217                       CALL random_seed_parallel( put=seq_random_array_particle(:,j,i) )
     2215                      CALL random_seed_parallel( put=seq_random_array_particles(:,j,i) )
    22182216
    22192217                      DO  k = nzb+1, nzt
    … …  
    23012299!
    23022300!--                   Get the new random seeds from last call at grid point jp, ip
    2303                       CALL random_seed_parallel( get=seq_random_array_particle(:,j,i) )
     2301                      CALL random_seed_parallel( get=seq_random_array_particles(:,j,i) )
    23042302
    23052303                   ENDDO
    … …  
    31103108    LOGICAL, INTENT(OUT)  ::  found
    31113109
     3110    INTEGER(isp), DIMENSION(:,:,:), ALLOCATABLE ::  tmp_2d_seq_random_particles  !< temporary array for storing random generator data for the lpm
     3111
    31123112    REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) ::  tmp_3d   !<
    31133113
    … …  
    31163116
    31173117    SELECT CASE ( restart_string(1:length) )
    3118 
    3119        CASE ( 'iran' ) ! matching random numbers is still unresolved issue
    3120           IF ( k == 1 )  READ ( 13 )  iran, iran_part
    31213118
    31223119        CASE ( 'pc_av' )
    … …  
    31603157               tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
    31613158
     3159         CASE ( 'seq_random_array_particles' )
     3160             ALLOCATE( tmp_2d_seq_random_particles(5,nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) )
     3161             IF ( .NOT. ALLOCATED( seq_random_array_particles ) )  THEN
     3162                ALLOCATE( seq_random_array_particles(5,nys:nyn,nxl:nxr) )
     3163             ENDIF
     3164             IF ( k == 1 )  READ ( 13 )  tmp_2d_seq_random_particles
     3165             seq_random_array_particles(:,nysc:nync,nxlc:nxrc) =                                   &
     3166                                                  tmp_2d_seq_random_particles(:,nysf:nynf,nxlf:nxrf)
     3167             DEALLOCATE( tmp_2d_seq_random_particles )
     3168
    31623169          CASE DEFAULT
    31633170
    … …  
    31783185    IMPLICIT NONE
    31793186
     3187    CHARACTER (LEN=20) ::  tmp_name  !< temporary variable
     3188
     3189    INTEGER(iwp) ::  i  !< loop index
     3190
    31803191    LOGICAL ::  array_found  !<
    3181 
    3182     CALL rrd_mpi_io( 'iran', iran ) ! matching random numbers is still unresolved issue
    3183     CALL rrd_mpi_io( 'iran_part', iran_part )
    31843192
    31853193    CALL rd_mpi_io_check_array( 'pc_av' , found = array_found )
    … …  
    32113219       IF ( .NOT. ALLOCATED( ql_vp_av ) )  ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    32123220       CALL rrd_mpi_io( 'ql_vp_av', ql_vp_av )
     3221    ENDIF
     3222
     3223    CALL rd_mpi_io_check_array( 'seq_random_array_particles' , found = array_found )
     3224    IF ( array_found )  THEN
     3225       IF ( .NOT. ALLOCATED( seq_random_array_particles ) )  THEN
     3226          ALLOCATE( seq_random_array_particles(5,nys:nyn,nxl:nxr) )
     3227       ENDIF
     3228       DO  i = 1, SIZE( seq_random_array_particles, 1 )
     3229          WRITE( tmp_name, '(A,I2.2)' )  'seq_random_array_particles', i
     3230          CALL rrd_mpi_io( TRIM(tmp_name), seq_random_array_particles(i,:,:) )
     3231       ENDDO
    32133232    ENDIF
    32143233
    … …  
    32243243 
    32253244    CHARACTER (LEN=10) ::  particle_binary_version   !<
    3226 
     3245    CHARACTER (LEN=20) ::  tmp_name                  !< temporary variable
     3246
     3247    INTEGER(iwp) ::  i                               !< loop index
    32273248    INTEGER(iwp) ::  ip                              !<
    32283249    INTEGER(iwp) ::  jp                              !<
    … …  
    32823303    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
    32833304
    3284        CALL wrd_write_string( 'iran' )  ! matching random numbers is still unresolved issue
    3285        WRITE ( 14 )  iran, iran_part
     3305       IF ( ALLOCATED( seq_random_array_particles ) )  THEN
     3306          CALL wrd_write_string( 'seq_random_array_particles' )
     3307          WRITE ( 14 )  seq_random_array_particles
     3308       ENDIF
    32863309
    32873310    ELSEIF ( restart_data_format_output(1:3) == 'mpi' )  THEN
    32883311
    3289        CALL wrd_mpi_io( 'iran', iran )  ! matching random numbers is still unresolved issue
    3290        CALL wrd_mpi_io( 'iran_part', iran_part )
     3312       IF ( ALLOCATED( seq_random_array_particles ) )  THEN
     3313          DO  i = 1, SIZE( seq_random_array_particles, 1 )
     3314             WRITE( tmp_name, '(A,I2.2)' )  'seq_random_array_particles', i
     3315             CALL wrd_mpi_io( TRIM( tmp_name ), seq_random_array_particles(i,:,:) )
     3316          ENDDO
     3317       ENDIF
    32913318
    32923319    ENDIF
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |