- Timestamp:
- Oct 23, 2018 8:57:47 AM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/UTIL/agent_preprocessing/agent_preprocessing.f90
r3259 r3400 25 25 ! -----------------! 26 26 ! $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 27 31 ! Removed unused variables and fixed real to real comparisons 28 32 ! … … 260 264 LOGICAL :: topo_file_flag = .FALSE. !< true if 3d building data is used 261 265 262 WRITE(*,'(( X,A,/))') 'Looking for topography/building information'266 WRITE(*,'((1X,A,/))') 'Looking for topography/building information' 263 267 INQUIRE( FILE = TRIM( input_trunk )//'_static', EXIST = netcdf_flag ) 264 268 … … 1237 1241 IMPLICIT NONE 1238 1242 1239 CHARACTER(LEN=2 00) :: dirname1240 CHARACTER(LEN=2 00) :: rundir1241 CHARACTER(LEN=2 00) :: input_trunk1242 CHARACTER (LEN=80) :: line !<1243 1244 CHARACTER(LEN=2),DIMENSION(1:5) :: run_pars 1245 1246 INTEGER(iwp) :: status 1247 INTEGER(iwp) :: getcwd1248 INTEGER(iwp) :: i e1249 INTEGER(iwp) :: is1243 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 1250 1254 1251 1255 LOGICAL :: p3d_flag = .FALSE. !< indicates whether p3d file was found … … 1253 1257 NAMELIST /prepro_par/ flag_2d, internal_buildings, tolerance_dp 1254 1258 1255 WRITE(*,'( X,A)') &1259 WRITE(*,'(1X,A)') & 1256 1260 "o----------------------------------------------o", & 1257 1261 "| o------------------------------------------o |", & … … 1267 1271 ! 1268 1272 !-- Identify run name and Input files 1269 status = getcwd( dirname ) 1270 IF ( status /= 0 ) STOP 'getcwd: error' 1273 CALL GET_ENVIRONMENT_VARIABLE('PWD', dirname) 1271 1274 ie = INDEX(dirname, '/', BACK=.TRUE.) 1272 1275 is = INDEX(dirname(1:ie-1), '/', BACK=.TRUE.) … … 1335 1338 line = ' ' 1336 1339 DO WHILE ( INDEX( line, '&prepro_par' ) == 0 ) 1337 READ ( 11, '(A)', END= 20 ) line1340 READ ( 11, '(A)', END=40 ) line 1338 1341 ENDDO 1339 1342 BACKSPACE ( 11 ) … … 1341 1344 ! 1342 1345 !-- 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 1346 1367 CLOSE( 11 ) 1347 1368 … … 1814 1835 !-- deleted and an error message thrown 1815 1836 IF ( .NOT. starting_vertex_found ) THEN 1816 WRITE(*,'(A,/,A, X,I6,/,A)') &1837 WRITE(*,'(A,/,A,1X,I6,/,A)') & 1817 1838 'An error occured during polygon sorting:', & 1818 1839 'no starting vertex could be found for polygon', & 1819 1840 i_p, 'This polygon contains the following vertices (x/y)' 1820 1841 DO il = 1, nov 1821 WRITE(*,'(4X,F8.1, X,F8.1)') &1842 WRITE(*,'(4X,F8.1,1X,F8.1)') & 1822 1843 polygon%vertices(il)%x, polygon%vertices(il)%x 1823 1844 ENDDO … … 2343 2364 !-- added and allocate the mesh point array, the second time (add == .TRUE.) 2344 2365 !-- to fill the mesh point array. 2345 WRITE(*,'( X,A)') 'Adding polygon vertices to mesh ...'2366 WRITE(*,'(1X,A)') 'Adding polygon vertices to mesh ...' 2346 2367 add = .FALSE. 2347 2368 DO … … 2390 2411 ALLOCATE( mesh(1:cmp) ) 2391 2412 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 ...' 2394 2415 ! 2395 2416 !-- CPU measurement … … 2707 2728 INTEGER(iwp) :: size_of_pols !< size of polygon 2708 2729 2709 WRITE(*,'( X,A)') 'Writing binary output data ...'2730 WRITE(*,'(1X,A)') 'Writing binary output data ...' 2710 2731 2711 2732 OPEN ( 14, FILE= TRIM(runname)//'_nav', FORM='UNFORMATTED', STATUS='replace' ) … … 2754 2775 'tolerance_dp accordingly.', ' ', 'Bye, Bye!', ' ' 2755 2776 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) ) 2759 2780 2760 2781 END SUBROUTINE bin_out_mesh … … 2835 2856 !-- Delete polygons with no vertices 2836 2857 CALL delete_empty_polygons 2837 WRITE(*,'(2(6X,A,I10, X,A,/))') &2858 WRITE(*,'(2(6X,A,I10,1X,A,/))') & 2838 2859 'Done. Created a total of', polygon_counter, 'polygon(s)', & 2839 2860 ' with a total of', vertex_counter, 'vertices'
Note: See TracChangeset
for help on using the changeset viewer.