Wrappers for iargc, getarg, getenv used everywhere. Next step: replace them

giannozz · giannozz · commit ae4105c086f1 · 2015-09-21T21:04:37.000Z
with standard calls if accepted by all relevant compilers
diff --git a/Modules/command_line_options.f90 b/Modules/command_line_options.f90
@@ -48,19 +48,13 @@ MODULE command_line_options
 CONTAINS
   !
   SUBROUTINE get_command_line ( input_command_line )
-#if defined(__NAG)
-     USE F90_UNIX_ENV, ONLY : iargc, getarg
-#endif
      IMPLICIT NONE
      CHARACTER(LEN=*), OPTIONAL :: input_command_line 
      INTEGER :: narg
-#if !defined(__NAG)
-     INTEGER  :: iargc
-     ! Do not define iargc as external: gfortran doesn't like it
-#endif
      LOGICAL :: read_string
      CHARACTER(LEN=256) :: arg 
      CHARACTER(LEN=6), EXTERNAL :: int_to_char
+     INTEGER, EXTERNAL :: i_argc
      !
      command_line = ' '
      read_string = PRESENT ( input_command_line )
@@ -71,7 +65,7 @@ SUBROUTINE get_command_line ( input_command_line )
      IF (read_string) THEN
         nargs = my_iargc ( input_command_line )
      ELSE
-        nargs = iargc()
+        nargs = i_argc()
      ENDIF
      CALL mp_bcast ( nargs, root, world_comm )
      !
@@ -85,55 +79,55 @@ SUBROUTINE get_command_line ( input_command_line )
         IF (read_string) THEN
            CALL my_getarg ( input_command_line, narg, arg )
         ELSE
-           CALL getarg ( narg, arg )
+           CALL get_arg ( narg, arg )
         ENDIF
         narg = narg + 1
         SELECT CASE ( TRIM(arg) )
            CASE ( '-i', '-in', '-inp', '-input' ) 
            IF (read_string) THEN
               CALL my_getarg ( input_command_line, narg, input_file_ )
            ELSE
-              CALL getarg ( narg, input_file_ )
+              CALL get_arg ( narg, input_file_ )
            ENDIF
               IF ( TRIM (input_file_) == ' ' ) GO TO 15
               narg = narg + 1
            CASE ( '-ni', '-nimage', '-nimages' ) 
               IF (read_string) THEN
                  CALL my_getarg ( input_command_line, narg, arg )
               ELSE
-                 CALL getarg ( narg, arg )
+                 CALL get_arg ( narg, arg )
               ENDIF
               READ ( arg, *, ERR = 15, END = 15) nimage_
               narg = narg + 1
            CASE ( '-nk', '-npool', '-npools') 
               IF (read_string) THEN
                  CALL my_getarg ( input_command_line, narg, arg )
               ELSE
-                 CALL getarg ( narg, arg )
+                 CALL get_arg ( narg, arg )
               ENDIF
               READ ( arg, *, ERR = 15, END = 15) npool_
               narg = narg + 1
            CASE ( '-nt', '-ntg', '-ntask_groups') 
               IF (read_string) THEN
                  CALL my_getarg ( input_command_line, narg, arg )
               ELSE
-                 CALL getarg ( narg, arg )
+                 CALL get_arg ( narg, arg )
               ENDIF
               READ ( arg, *, ERR = 15, END = 15) ntg_
               narg = narg + 1
            CASE ( '-nb', '-nband', '-nbgrp', '-nband_group') 
               IF (read_string) THEN
                  CALL my_getarg ( input_command_line, narg, arg )
               ELSE
-                 CALL getarg ( narg, arg )
+                 CALL get_arg ( narg, arg )
               ENDIF
               READ ( arg, *, ERR = 15, END = 15) nband_
               narg = narg + 1
            CASE ( '-nd', '-ndiag', '-northo', '-nproc_diag', '-nproc_ortho') 
               IF (read_string) THEN
                  CALL my_getarg ( input_command_line, narg, arg )
               ELSE
-                 CALL getarg ( narg, arg )
+                 CALL get_arg ( narg, arg )
               ENDIF
               READ ( arg, *, ERR = 15, END = 15) ndiag_
               narg = narg + 1
diff --git a/Modules/plugin_arguments.f90 b/Modules/plugin_arguments.f90
@@ -19,27 +19,22 @@ SUBROUTINE plugin_arguments()
   USE io_global,     ONLY : stdout
   !
   USE plugin_flags
-#if defined(__NAG)
-  USE F90_UNIX_ENV, ONLY : iargc, getarg
-#endif
   !
   IMPLICIT NONE
   !
-#if !defined(__NAG)
-  INTEGER  :: iargc
-#endif
+  INTEGER, EXTERNAL :: i_argc
   INTEGER  :: iiarg, nargs, i, i0
   CHARACTER (len=1), EXTERNAL ::  lowercase
   CHARACTER (len=256) :: arg
   !
-  nargs = iargc()
+  nargs = i_argc()
   ! add here more plugins
   use_plumed = .false.
   use_pw2casino = .false.
   use_environ = .false.
   !
   DO iiarg = 1, nargs 
-    CALL getarg( iiarg, plugin_name)
+    CALL get_arg( iiarg, plugin_name)
     IF ( plugin_name(1:1) == '-') THEN
        i0 = 1
        IF ( plugin_name(2:2) == '-') i0 = 2
diff --git a/NEB/src/path_io_tools.f90 b/NEB/src/path_io_tools.f90
@@ -13,30 +13,25 @@ FUNCTION input_images_getarg( ) RESULT(input_images)
   ! return N (0 if not found)
   !
   USE kinds,         ONLY : DP
-#if defined(__NAG)
-  USE F90_UNIX_ENV, ONLY : iargc, getarg
-#endif
   !
   IMPLICIT NONE
   !
   INTEGER :: input_images
   CHARACTER(len=256) ::  myname
-#if !defined(__NAG)
-  INTEGER :: iargc
-#endif
+  INTEGER, EXTERNAL :: i_argc
   INTEGER :: iiarg, nargs, i, i0
   !
-  nargs = iargc()
+  nargs = i_argc()
   input_images = 0
   !
   DO iiarg = 1, nargs
      !
-     CALL getarg( iiarg, myname)
+     CALL get_arg( iiarg, myname)
      !
      IF ( TRIM( myname ) == '-input_images' .OR. &
           TRIM( myname ) == '--input_images' ) THEN
         !
-        CALL getarg( ( iiarg + 1 ) , myname )
+        CALL get_arg( ( iiarg + 1 ) , myname )
         !
         READ(myname,*) input_images
         RETURN
diff --git a/PHonon/PH/q2qstar.f90 b/PHonon/PH/q2qstar.f90
@@ -47,9 +47,6 @@ PROGRAM Q2QSTAR
   USE io_dyn_mat,         ONLY : read_dyn_mat_param, read_dyn_mat_header, &
                                  read_dyn_mat, read_dyn_mat_tail, &
                                  write_dyn_mat_header
-#if defined(__NAG)
-   USE F90_UNIX_ENV, ONLY : iargc, getarg
-#endif
   !
   IMPLICIT NONE
   !
@@ -65,19 +62,17 @@ PROGRAM Q2QSTAR
   !
   COMPLEX(DP),ALLOCATABLE :: phi(:,:,:,:), d2(:,:)
   INTEGER :: i,j, icar,jcar, na,nb
-#if !defined(__NAG)
-  INTEGER :: iargc ! intrinsic function
-#endif
+  INTEGER, EXTERNAL :: i_argc ! wrapper for iargc
   !
   NAMELIST / input / fildyn
   !
   CALL mp_startup()
   CALL environment_start(CODE)
   !
-  nargs = iargc()
+  nargs = i_argc()
   IF(nargs < 1) CALL errore(CODE, 'Argument is missing! Syntax: "q2qstar dynfile [outfile]"', 1)
   !
-  CALL getarg(1, fildyn)
+  CALL get_arg(1, fildyn)
   CALL mp_bcast(fildyn, ionode_id,world_comm)
   !
   ! check input
@@ -86,7 +81,7 @@ PROGRAM Q2QSTAR
   !
   ! set up output
   IF (nargs > 1) THEN
-    CALL getarg(2, filout)
+    CALL get_arg(2, filout)
   ELSE
       filout = TRIM(fildyn)//".rot"
   ENDIF
diff --git a/PP/src/Makefile b/PP/src/Makefile
@@ -169,7 +169,7 @@ pw_export.x : pw_export.o libpp.a $(MODULES) $(LIBOBJS)
 	- ( cd ../../bin ; ln -fs ../PP/src/$@ . )
 
 sumpdos.x : sumpdos.o 
-	$(LD) $(LDFLAGS) -o $@ sumpdos.o
+	$(LD) $(LDFLAGS) -o $@ sumpdos.o $(MODULES) $(LIBOBJS) $(LIBS)
 	- ( cd ../../bin ; ln -fs ../PP/src/$@ . )
 
 epsilon.x : epsilon.o libpp.a $(MODULES) $(LIBOBJS)
diff --git a/PP/src/sumpdos.f90 b/PP/src/sumpdos.f90
@@ -7,10 +7,6 @@
 !
 PROGRAM sumpdos
   !
-#if defined(__NAG)
-  USE F90_UNIX_ENV, ONLY : iargc, getarg
-#endif
-  !
   IMPLICIT NONE
   !
   ! AUTHOR: Andrea Ferretti
@@ -21,9 +17,7 @@ PROGRAM sumpdos
   ! file names are read from stdin
   ! USAGE: sumpdos <file1> ... <fileN>
   !
-#if !defined(__NAG)
-  INTEGER             :: iargc              ! function giving no of arguments
-#endif
+  INTEGER, EXTERNAL   :: i_argc             ! function giving no of arguments
   INTEGER             :: ngrid              ! dimension of the energy grid
   INTEGER             :: nfile              ! number of files to sum
   INTEGER             :: nspin              ! number of spin_component
@@ -52,13 +46,13 @@ PROGRAM sumpdos
 !
 ! get the number of arguments (i.e. the number of files)
 !
-   nfile = iargc ()
+   nfile = i_argc ()
    IF ( nfile == 0 ) THEN
       WRITE(0,"( 'No file to sum' )")
       STOP
    ENDIF
 
-   CALL getarg ( 1, str1 )
+   CALL get_arg ( 1, str1 )
    !
    SELECT CASE ( trim(str1) )
    CASE ( "-h" )
@@ -79,7 +73,7 @@ PROGRAM sumpdos
       !
       ! read file names from file
       !
-      CALL getarg ( 2, filein )
+      CALL get_arg ( 2, filein )
       IF ( len_trim(filein) == 0 ) CALL errore('sumpdos','provide filein name',2)
 
       INQUIRE( FILE=trim(filein), EXIST=exist )
@@ -126,7 +120,7 @@ PROGRAM sumpdos
       ALLOCATE( file(nfile), STAT=ierr )
       IF (ierr/=0) CALL errore('sumpdos','allocating FILE',abs(ierr))
       DO iarg = 1, nfile
-         CALL getarg ( iarg, file(iarg) )
+         CALL get_arg ( iarg, file(iarg) )
       ENDDO
 
    END SELECT
diff --git a/flib/inpfile.f90 b/flib/inpfile.f90
@@ -5,54 +5,64 @@
 ! in the root directory of the present distribution,
 ! or http://www.gnu.org/copyleft/gpl.txt .
 !
-SUBROUTINE get_env ( variable_name, variable_value )
-  !
-  ! Wrapper for intrinsic getenv - all machine-dependent stuff here
+! Wrappers for intrinsic iargc, getarg, getenv - machine-dependent stuff here
+!
+INTEGER FUNCTION i_argc ( )
+#if defined(__NAG)
+  USE F90_UNIX_ENV, ONLY : iargc
+#else
+  ! do not declare it external: gfortran doesn't like it
+  INTEGER :: iargc
+#endif
+  i_argc = iargc ( )
+END FUNCTION i_argc
   !
+SUBROUTINE get_env ( variable_name, variable_value )
 #if defined(__NAG)
   USE F90_UNIX_ENV, ONLY : getenv
 #endif
   CHARACTER (LEN=*)  :: variable_name, variable_value
-  !
   CALL getenv ( variable_name, variable_value)
-  !
 END SUBROUTINE get_env
+!
+SUBROUTINE get_arg ( iarg, arg )
+#if defined(__NAG)
+  USE F90_UNIX_ENV, ONLY : getarg
+#endif
+  INTEGER, INTENT(IN) :: iarg
+  CHARACTER (LEN=*), INTENT(OUT) :: arg
+  CALL getarg ( iarg, arg )
+END SUBROUTINE get_arg
+!
 !----------------------------------------------------------------------------
 SUBROUTINE input_from_file( )
   !
   ! This subroutine checks command-line arguments for -i[nput] "file name"
   ! if "file name" is present, attach input unit 5 to the specified file
   !
-#if defined(__NAG)
-  USE F90_UNIX_ENV, ONLY : iargc, getarg
-#endif
-  !
   IMPLICIT NONE
   !
   INTEGER             :: stdin = 5, stderr = 6, ierr = 0
   CHARACTER (LEN=256) :: input_file
   LOGICAL             :: found
   !
-#if !defined(__NAG)
-  INTEGER  :: iargc
-  ! Do not define iargc as external: gfortran doesn't like it
-#endif
+  INTEGER, EXTERNAL   :: i_argc
   INTEGER :: iiarg, nargs
   !
-  nargs = iargc()
+  nargs = i_argc()
   found = .FALSE.
   input_file = ' '
   !
   DO iiarg = 1, ( nargs - 1 )
      !
-     CALL getarg( iiarg, input_file )
+     CALL get_arg( iiarg, input_file )
      !
      IF ( TRIM( input_file ) == '-i'     .OR. &
           TRIM( input_file ) == '-in'    .OR. &
           TRIM( input_file ) == '-inp'   .OR. &
           TRIM( input_file ) == '-input' ) THEN
         !
-        CALL getarg( ( iiarg + 1 ) , input_file )
+        CALL get_arg( ( iiarg + 1 ) , input_file )
         found =.TRUE.
         EXIT
         !
@@ -94,11 +104,11 @@ SUBROUTINE get_file( input_file )
   !
   CHARACTER (LEN=256) :: prgname
   INTEGER             :: nargs
-  INTEGER             :: iargc
   LOGICAL             :: exst
+  INTEGER, EXTERNAL   :: i_argc
   !
-  nargs = iargc()
-  CALL getarg (0,prgname)
+  nargs = i_argc()
+  CALL get_arg (0,prgname)
   !
   IF ( nargs == 0 ) THEN
 10   PRINT  '("Input file > ",$)'
@@ -110,7 +120,7 @@ SUBROUTINE get_file( input_file )
         GO TO 10
      END IF
   ELSE IF ( nargs == 1 ) then
-     CALL getarg (1,input_file)
+     CALL get_arg (1,input_file)
   ELSE
      PRINT  '(A,": too many arguments ",i4)', TRIM(prgname), nargs
   END IF

Original file line number	Diff line number	Diff line change
`@@ -13,30 +13,25 @@ FUNCTION input_images_getarg( ) RESULT(input_images)`
`13`	`13`	`! return N (0 if not found)`
`14`	`14`	`!`
`15`	`15`	`USE kinds, ONLY : DP`
`16`		`-#if defined(__NAG)`
`17`		`- USE F90_UNIX_ENV, ONLY : iargc, getarg`
`18`		`-#endif`
`19`	`16`	`!`
`20`	`17`	`IMPLICIT NONE`
`21`	`18`	`!`
`22`	`19`	`INTEGER :: input_images`
`23`	`20`	`CHARACTER(len=256) :: myname`
`24`		`-#if !defined(__NAG)`
`25`		`- INTEGER :: iargc`
`26`		`-#endif`
	`21`	`+ INTEGER, EXTERNAL :: i_argc`
`27`	`22`	`INTEGER :: iiarg, nargs, i, i0`
`28`	`23`	`!`
`29`		`- nargs = iargc()`
	`24`	`+ nargs = i_argc()`
`30`	`25`	`input_images = 0`
`31`	`26`	`!`
`32`	`27`	`DO iiarg = 1, nargs`
`33`	`28`	`!`
`34`		`- CALL getarg( iiarg, myname)`
	`29`	`+ CALL get_arg( iiarg, myname)`
`35`	`30`	`!`
`36`	`31`	`IF ( TRIM( myname ) == '-input_images' .OR. &`
`37`	`32`	`TRIM( myname ) == '--input_images' ) THEN`
`38`	`33`	`!`
`39`		`- CALL getarg( ( iiarg + 1 ) , myname )`
	`34`	`+ CALL get_arg( ( iiarg + 1 ) , myname )`
`40`	`35`	`!`
`41`	`36`	`READ(myname,*) input_images`
`42`	`37`	`RETURN`
Original file line number	Diff line number	Diff line change
`@@ -47,9 +47,6 @@ PROGRAM Q2QSTAR`
`47`	`47`	`USE io_dyn_mat, ONLY : read_dyn_mat_param, read_dyn_mat_header, &`
`48`	`48`	`read_dyn_mat, read_dyn_mat_tail, &`
`49`	`49`	`write_dyn_mat_header`
`50`		`-#if defined(__NAG)`
`51`		`- USE F90_UNIX_ENV, ONLY : iargc, getarg`
`52`		`-#endif`
`53`	`50`	`!`
`54`	`51`	`IMPLICIT NONE`
`55`	`52`	`!`
`@@ -65,19 +62,17 @@ PROGRAM Q2QSTAR`
`65`	`62`	`!`
`66`	`63`	`COMPLEX(DP),ALLOCATABLE :: phi(:,:,:,:), d2(:,:)`
`67`	`64`	`INTEGER :: i,j, icar,jcar, na,nb`
`68`		`-#if !defined(__NAG)`
`69`		`- INTEGER :: iargc ! intrinsic function`
`70`		`-#endif`
	`65`	`+ INTEGER, EXTERNAL :: i_argc ! wrapper for iargc`
`71`	`66`	`!`
`72`	`67`	`NAMELIST / input / fildyn`
`73`	`68`	`!`
`74`	`69`	`CALL mp_startup()`
`75`	`70`	`CALL environment_start(CODE)`
`76`	`71`	`!`
`77`		`- nargs = iargc()`
	`72`	`+ nargs = i_argc()`
`78`	`73`	`IF(nargs < 1) CALL errore(CODE, 'Argument is missing! Syntax: "q2qstar dynfile [outfile]"', 1)`
`79`	`74`	`!`
`80`		`- CALL getarg(1, fildyn)`
	`75`	`+ CALL get_arg(1, fildyn)`
`81`	`76`	`CALL mp_bcast(fildyn, ionode_id,world_comm)`
`82`	`77`	`!`
`83`	`78`	`! check input`
`@@ -86,7 +81,7 @@ PROGRAM Q2QSTAR`
`86`	`81`	`!`
`87`	`82`	`! set up output`
`88`	`83`	`IF (nargs > 1) THEN`
`89`		`- CALL getarg(2, filout)`
	`84`	`+ CALL get_arg(2, filout)`
`90`	`85`	`ELSE`
`91`	`86`	`filout = TRIM(fildyn)//".rot"`
`92`	`87`	`ENDIF`
Original file line number	Diff line number	Diff line change
`@@ -7,10 +7,6 @@`
`7`	`7`	`!`
`8`	`8`	`PROGRAM sumpdos`
`9`	`9`	`!`
`10`		`-#if defined(__NAG)`
`11`		`- USE F90_UNIX_ENV, ONLY : iargc, getarg`
`12`		`-#endif`
`13`		`- !`
`14`	`10`	`IMPLICIT NONE`
`15`	`11`	`!`
`16`	`12`	`! AUTHOR: Andrea Ferretti`
`@@ -21,9 +17,7 @@ PROGRAM sumpdos`
`21`	`17`	`! file names are read from stdin`
`22`	`18`	`! USAGE: sumpdos <file1> ... <fileN>`
`23`	`19`	`!`
`24`		`-#if !defined(__NAG)`
`25`		`- INTEGER :: iargc ! function giving no of arguments`
`26`		`-#endif`
	`20`	`+ INTEGER, EXTERNAL :: i_argc ! function giving no of arguments`
`27`	`21`	`INTEGER :: ngrid ! dimension of the energy grid`
`28`	`22`	`INTEGER :: nfile ! number of files to sum`
`29`	`23`	`INTEGER :: nspin ! number of spin_component`
`@@ -52,13 +46,13 @@ PROGRAM sumpdos`
`52`	`46`	`!`
`53`	`47`	`! get the number of arguments (i.e. the number of files)`
`54`	`48`	`!`
`55`		`- nfile = iargc ()`
	`49`	`+ nfile = i_argc ()`
`56`	`50`	`IF ( nfile == 0 ) THEN`
`57`	`51`	`WRITE(0,"( 'No file to sum' )")`
`58`	`52`	`STOP`
`59`	`53`	`ENDIF`
`60`	`54`
`61`		`- CALL getarg ( 1, str1 )`
	`55`	`+ CALL get_arg ( 1, str1 )`
`62`	`56`	`!`
`63`	`57`	`SELECT CASE ( trim(str1) )`
`64`	`58`	`CASE ( "-h" )`
`@@ -79,7 +73,7 @@ PROGRAM sumpdos`
`79`	`73`	`!`
`80`	`74`	`! read file names from file`
`81`	`75`	`!`
`82`		`- CALL getarg ( 2, filein )`
	`76`	`+ CALL get_arg ( 2, filein )`
`83`	`77`	`IF ( len_trim(filein) == 0 ) CALL errore('sumpdos','provide filein name',2)`
`84`	`78`
`85`	`79`	`INQUIRE( FILE=trim(filein), EXIST=exist )`
`@@ -126,7 +120,7 @@ PROGRAM sumpdos`
`126`	`120`	`ALLOCATE( file(nfile), STAT=ierr )`
`127`	`121`	`IF (ierr/=0) CALL errore('sumpdos','allocating FILE',abs(ierr))`
`128`	`122`	`DO iarg = 1, nfile`
`129`		`- CALL getarg ( iarg, file(iarg) )`
	`123`	`+ CALL get_arg ( iarg, file(iarg) )`
`130`	`124`	`ENDDO`
`131`	`125`
`132`	`126`	`END SELECT`