Changeset 3400 for palm/trunk/UTIL/agent_preprocessing

Timestamp:

Oct 23, 2018 8:57:47 AM (5 years ago)

Author:

sward

Message:

Made agent_preprocessing fortran 2008 conform

File:

• palm/trunk/UTIL/agent_preprocessing/agent_preprocessing.f90 (modified) (13 diffs)

palm/trunk/UTIL/agent_preprocessing/agent_preprocessing.f90

@@ -25 +25 @@
 ! -----------------!
 ! $Id$
+! Changed getcwd to GET_ENVIRONMENT_VARIABLE and changed X to 1X in format
+! statements to have code conform to fortran 2008 standard
+! 
+! 3259 2018-09-18 09:53:18Z sward
 ! Removed unused variables and fixed real to real comparisons
 ! 
@@ -260 +264 @@
        LOGICAL ::  topo_file_flag = .FALSE.  !< true if 3d building data is used
 
-       WRITE(*,'((X,A,/))') 'Looking for topography/building information'
+       WRITE(*,'((1X,A,/))') 'Looking for topography/building information'
        INQUIRE( FILE = TRIM( input_trunk )//'_static', EXIST = netcdf_flag )
 
@@ -1237 +1241 @@
        IMPLICIT NONE
 
-       CHARACTER(LEN=200) ::  dirname
-       CHARACTER(LEN=200) ::  rundir
-       CHARACTER(LEN=200) ::  input_trunk
-       CHARACTER (LEN=80) ::  line  !<
-       
-       CHARACTER(LEN=2),DIMENSION(1:5) ::  run_pars
-
-       INTEGER(iwp) ::  status
-       INTEGER(iwp) ::  getcwd
-       INTEGER(iwp) ::  ie
-       INTEGER(iwp) ::  is
+       CHARACTER(LEN=255) ::  dirname      !< dummy to read current working directory
+       CHARACTER(LEN=255) ::  rundir       !< base run directory
+       CHARACTER(LEN=255) ::  input_trunk  !< base filename for run including path
+       CHARACTER(LEN=80) ::  line          !< string to identify namelist
+       CHARACTER(LEN=80) ::  line_dum      !< line dummy for error output
+
+       CHARACTER(LEN=2),DIMENSION(1:5) ::  run_pars  !< parameters from other namelist
+
+       INTEGER(iwp) ::  ie            !< end index (string manipulation)
+       INTEGER(iwp) ::  is            !< start index (string manipulation)
+       INTEGER(iwp) ::  line_counter  !< line on which reading error occured
 
        LOGICAL ::  p3d_flag = .FALSE.  !< indicates whether p3d file was found
@@ -1253 +1257 @@
        NAMELIST /prepro_par/  flag_2d, internal_buildings, tolerance_dp
 
-       WRITE(*,'(X,A)')                                                        &
+       WRITE(*,'(1X,A)')                                                        &
                  "o----------------------------------------------o",           &
                  "| o------------------------------------------o |",           &
@@ -1267 +1271 @@
 !
 !--    Identify run name and Input files
-       status = getcwd( dirname )
-       IF ( status /= 0 ) STOP 'getcwd: error'
+       CALL GET_ENVIRONMENT_VARIABLE('PWD', dirname)
        ie = INDEX(dirname, '/', BACK=.TRUE.)
        is = INDEX(dirname(1:ie-1), '/', BACK=.TRUE.)
@@ -1335 +1338 @@
        line = ' '
        DO   WHILE ( INDEX( line, '&prepro_par' ) == 0 )
-          READ ( 11, '(A)', END=20 )  line
+          READ ( 11, '(A)', END=40 )  line
        ENDDO
        BACKSPACE ( 11 )
@@ -1341 +1344 @@
 !
 !--    Read user-defined namelist
-       READ ( 11, prepro_par )
-
- 20    CONTINUE
+       READ ( 11, prepro_par, ERR = 20, END = 40 )
+       GOTO 40
+
+ 20    BACKSPACE( 11 )
+       READ( 11 , '(A)') line
+
+       line_dum = ' '
+       line_counter = 0
+
+       REWIND( 11 )
+       DO WHILE ( INDEX( line_dum, TRIM(line) ) == 0 )
+          READ ( 11, '(A)', END=30 )  line_dum
+          line_counter = line_counter + 1
+       ENDDO
+
+ 30    WRITE( *, '(A,/,A,I3,A,/,A)' ) 'Error(s) in NAMELIST prepro_par.',      &
+                                      'Reading fails on line ', line_counter,  &
+                                      ' at ', TRIM(ADJUSTL(line))
+       STOP
+
+ 40    CONTINUE
        CLOSE( 11 )
 
@@ -1814 +1835 @@
 !--    deleted and an error message thrown
        IF ( .NOT. starting_vertex_found ) THEN
-          WRITE(*,'(A,/,A,X,I6,/,A)')                                          &
+          WRITE(*,'(A,/,A,1X,I6,/,A)')                                          &
                      'An error occured during polygon sorting:',               &
                      'no starting vertex could be found for polygon',          &
                      i_p, 'This polygon contains the following vertices (x/y)'
           DO il = 1, nov
-             WRITE(*,'(4X,F8.1,X,F8.1)')                                       &
+             WRITE(*,'(4X,F8.1,1X,F8.1)')                                       &
                          polygon%vertices(il)%x, polygon%vertices(il)%x
           ENDDO
@@ -2343 +2364 @@
 !--    added and allocate the mesh point array, the second time (add == .TRUE.)
 !--    to fill the mesh point array.
-       WRITE(*,'(X,A)') 'Adding polygon vertices to mesh ...'
+       WRITE(*,'(1X,A)') 'Adding polygon vertices to mesh ...'
        add = .FALSE.
        DO
@@ -2390 +2411 @@
           ALLOCATE( mesh(1:cmp) )
        ENDDO
-       WRITE(*,'(6X,A,X,I10,X,A,/)')  'Done. Added',cmp,'vertices to mesh.'
-       WRITE(*,'(X,A)') 'Establishing connections in mesh ...'
+       WRITE(*,'(6X,A,1X,I10,1X,A,/)')  'Done. Added',cmp,'vertices to mesh.'
+       WRITE(*,'(1X,A)') 'Establishing connections in mesh ...'
 !
 !--    CPU measurement
@@ -2707 +2728 @@
        INTEGER(iwp) ::  size_of_pols !< size of polygon
 
-       WRITE(*,'(X,A)') 'Writing binary output data ...'
+       WRITE(*,'(1X,A)') 'Writing binary output data ...'
 
        OPEN ( 14, FILE= TRIM(runname)//'_nav', FORM='UNFORMATTED', STATUS='replace' )
@@ -2754 +2775 @@
                           'tolerance_dp accordingly.', '  ', 'Bye, Bye!', ' '
        CALL CPU_TIME(finish)
-       WRITE(*,'(X,A,F10.4,A)') 'Total runtime: ', finish-start, ' seconds'
-
-       150 FORMAT (2(I7,X),2(F9.2,X) )
+       WRITE(*,'(1X,A,F10.4,A)') 'Total runtime: ', finish-start, ' seconds'
+
+       150 FORMAT (2(I7,1X),2(F9.2,1X) )
 
     END SUBROUTINE bin_out_mesh
@@ -2835 +2856 @@
 !-- Delete polygons with no vertices
     CALL delete_empty_polygons
-    WRITE(*,'(2(6X,A,I10,X,A,/))')                                             &
+    WRITE(*,'(2(6X,A,I10,1X,A,/))')                                             &
                   'Done. Created a total of', polygon_counter, 'polygon(s)',   &
                   '         with a total of', vertex_counter, 'vertices'