Changeset 3400 for palm/trunk/UTIL


Ignore:
Timestamp:
Oct 23, 2018 8:57:47 AM (3 years ago)
Author:
sward
Message:

Made agent_preprocessing fortran 2008 conform

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/UTIL/agent_preprocessing/agent_preprocessing.f90

    r3259 r3400  
    2525! -----------------!
    2626! $Id$
     27! Changed getcwd to GET_ENVIRONMENT_VARIABLE and changed X to 1X in format
     28! statements to have code conform to fortran 2008 standard
     29!
     30! 3259 2018-09-18 09:53:18Z sward
    2731! Removed unused variables and fixed real to real comparisons
    2832!
     
    260264       LOGICAL ::  topo_file_flag = .FALSE.  !< true if 3d building data is used
    261265
    262        WRITE(*,'((X,A,/))') 'Looking for topography/building information'
     266       WRITE(*,'((1X,A,/))') 'Looking for topography/building information'
    263267       INQUIRE( FILE = TRIM( input_trunk )//'_static', EXIST = netcdf_flag )
    264268
     
    12371241       IMPLICIT NONE
    12381242
    1239        CHARACTER(LEN=200) ::  dirname
    1240        CHARACTER(LEN=200) ::  rundir
    1241        CHARACTER(LEN=200) ::  input_trunk
    1242        CHARACTER (LEN=80) ::  line  !<
    1243        
    1244        CHARACTER(LEN=2),DIMENSION(1:5) ::  run_pars
    1245 
    1246        INTEGER(iwp) ::  status
    1247        INTEGER(iwp) ::  getcwd
    1248        INTEGER(iwp) ::  ie
    1249        INTEGER(iwp) ::  is
     1243       CHARACTER(LEN=255) ::  dirname      !< dummy to read current working directory
     1244       CHARACTER(LEN=255) ::  rundir       !< base run directory
     1245       CHARACTER(LEN=255) ::  input_trunk  !< base filename for run including path
     1246       CHARACTER(LEN=80) ::  line          !< string to identify namelist
     1247       CHARACTER(LEN=80) ::  line_dum      !< line dummy for error output
     1248
     1249       CHARACTER(LEN=2),DIMENSION(1:5) ::  run_pars  !< parameters from other namelist
     1250
     1251       INTEGER(iwp) ::  ie            !< end index (string manipulation)
     1252       INTEGER(iwp) ::  is            !< start index (string manipulation)
     1253       INTEGER(iwp) ::  line_counter  !< line on which reading error occured
    12501254
    12511255       LOGICAL ::  p3d_flag = .FALSE.  !< indicates whether p3d file was found
     
    12531257       NAMELIST /prepro_par/  flag_2d, internal_buildings, tolerance_dp
    12541258
    1255        WRITE(*,'(X,A)')                                                        &
     1259       WRITE(*,'(1X,A)')                                                        &
    12561260                 "o----------------------------------------------o",           &
    12571261                 "| o------------------------------------------o |",           &
     
    12671271!
    12681272!--    Identify run name and Input files
    1269        status = getcwd( dirname )
    1270        IF ( status /= 0 ) STOP 'getcwd: error'
     1273       CALL GET_ENVIRONMENT_VARIABLE('PWD', dirname)
    12711274       ie = INDEX(dirname, '/', BACK=.TRUE.)
    12721275       is = INDEX(dirname(1:ie-1), '/', BACK=.TRUE.)
     
    13351338       line = ' '
    13361339       DO   WHILE ( INDEX( line, '&prepro_par' ) == 0 )
    1337           READ ( 11, '(A)', END=20 )  line
     1340          READ ( 11, '(A)', END=40 )  line
    13381341       ENDDO
    13391342       BACKSPACE ( 11 )
     
    13411344!
    13421345!--    Read user-defined namelist
    1343        READ ( 11, prepro_par )
    1344 
    1345  20    CONTINUE
     1346       READ ( 11, prepro_par, ERR = 20, END = 40 )
     1347       GOTO 40
     1348
     1349 20    BACKSPACE( 11 )
     1350       READ( 11 , '(A)') line
     1351
     1352       line_dum = ' '
     1353       line_counter = 0
     1354
     1355       REWIND( 11 )
     1356       DO WHILE ( INDEX( line_dum, TRIM(line) ) == 0 )
     1357          READ ( 11, '(A)', END=30 )  line_dum
     1358          line_counter = line_counter + 1
     1359       ENDDO
     1360
     1361 30    WRITE( *, '(A,/,A,I3,A,/,A)' ) 'Error(s) in NAMELIST prepro_par.',      &
     1362                                      'Reading fails on line ', line_counter,  &
     1363                                      ' at ', TRIM(ADJUSTL(line))
     1364       STOP
     1365
     1366 40    CONTINUE
    13461367       CLOSE( 11 )
    13471368
     
    18141835!--    deleted and an error message thrown
    18151836       IF ( .NOT. starting_vertex_found ) THEN
    1816           WRITE(*,'(A,/,A,X,I6,/,A)')                                          &
     1837          WRITE(*,'(A,/,A,1X,I6,/,A)')                                          &
    18171838                     'An error occured during polygon sorting:',               &
    18181839                     'no starting vertex could be found for polygon',          &
    18191840                     i_p, 'This polygon contains the following vertices (x/y)'
    18201841          DO il = 1, nov
    1821              WRITE(*,'(4X,F8.1,X,F8.1)')                                       &
     1842             WRITE(*,'(4X,F8.1,1X,F8.1)')                                       &
    18221843                         polygon%vertices(il)%x, polygon%vertices(il)%x
    18231844          ENDDO
     
    23432364!--    added and allocate the mesh point array, the second time (add == .TRUE.)
    23442365!--    to fill the mesh point array.
    2345        WRITE(*,'(X,A)') 'Adding polygon vertices to mesh ...'
     2366       WRITE(*,'(1X,A)') 'Adding polygon vertices to mesh ...'
    23462367       add = .FALSE.
    23472368       DO
     
    23902411          ALLOCATE( mesh(1:cmp) )
    23912412       ENDDO
    2392        WRITE(*,'(6X,A,X,I10,X,A,/)')  'Done. Added',cmp,'vertices to mesh.'
    2393        WRITE(*,'(X,A)') 'Establishing connections in mesh ...'
     2413       WRITE(*,'(6X,A,1X,I10,1X,A,/)')  'Done. Added',cmp,'vertices to mesh.'
     2414       WRITE(*,'(1X,A)') 'Establishing connections in mesh ...'
    23942415!
    23952416!--    CPU measurement
     
    27072728       INTEGER(iwp) ::  size_of_pols !< size of polygon
    27082729
    2709        WRITE(*,'(X,A)') 'Writing binary output data ...'
     2730       WRITE(*,'(1X,A)') 'Writing binary output data ...'
    27102731
    27112732       OPEN ( 14, FILE= TRIM(runname)//'_nav', FORM='UNFORMATTED', STATUS='replace' )
     
    27542775                          'tolerance_dp accordingly.', '  ', 'Bye, Bye!', ' '
    27552776       CALL CPU_TIME(finish)
    2756        WRITE(*,'(X,A,F10.4,A)') 'Total runtime: ', finish-start, ' seconds'
    2757 
    2758        150 FORMAT (2(I7,X),2(F9.2,X) )
     2777       WRITE(*,'(1X,A,F10.4,A)') 'Total runtime: ', finish-start, ' seconds'
     2778
     2779       150 FORMAT (2(I7,1X),2(F9.2,1X) )
    27592780
    27602781    END SUBROUTINE bin_out_mesh
     
    28352856!-- Delete polygons with no vertices
    28362857    CALL delete_empty_polygons
    2837     WRITE(*,'(2(6X,A,I10,X,A,/))')                                             &
     2858    WRITE(*,'(2(6X,A,I10,1X,A,/))')                                             &
    28382859                  'Done. Created a total of', polygon_counter, 'polygon(s)',   &
    28392860                  '         with a total of', vertex_counter, 'vertices'
Note: See TracChangeset for help on using the changeset viewer.