[Pw_forum] espresso compilation error IBM SP4 arch

carlo sbraccia sbraccia at sissa.it
Fri Oct 1 09:28:22 CEST 2004


Dear Aaron,
with some version of the AIX compiler, some combination of flags lead to
variables being defined as static, hence giving a conflict with PURE
function. To solve the problem (or compiler bug) we must force the
variable to be AUTOMATIC. Try with the attached routine.
carlo

On Fri, 2004-10-01 at 00:02, aaron at nemo.physics.ncsu.edu wrote:
> Hi,
> 
> I'm very excited to try the new release.
> However I've run into a small compilation error as follows:
> 
> ***********************************************************
> ***********************************************************
>         mpxlf -qalias=noaryovrlp -I../include  -O3 -qstrict -qarch=auto 
> -qtune=auto -qsuffix=cpp=f90  -qdpc -Q -qalias=nointptr -qfree=f90 
> -I/tmp/work/amgeorge/pw2.1/install 
> -WF,-D__AIX,-D__PARA,-D__MPI,-DHAS_ZHEGVX 
> -I/tmp/work/amgeorge/pw2.1/Modules -I/tmp/work/amgeorge/pw2.1/PW 
> -I/tmp/work/amgeorge/pw2.1/PH -c parser.f90
> "parser.f90", 1514-286 (S) The variable, j, has the SAVE or STATIC 
> attribute.  A variable declared in a pure subprogram must not have the 
> SAVE or STATIC attribute.  You may have specified the SAVE option 
> explicitly or by default.
> "parser.f90", 1514-286 (S) The variable, sep2, has the SAVE or STATIC 
> attribute.  A variable declared in a pure subprogram must not have the 
> SAVE or STATIC attribute.  You may have specified the SAVE option 
> explicitly or by default.
> "parser.f90", 1514-286 (S) The variable, sep1, has the SAVE or STATIC 
> attribute.  A variable declared in a pure subprogram must not have the 
> SAVE or STATIC attribute.  You may have specified the SAVE option 
> explicitly or by default.
> ** parser   === End of Compilation 1 ===
> ***********************************************************
> ***********************************************************
> 
> Please advise.
> 
> Thanks in advance,
> 
> Aaron
> 
> 
> 
> 
> _______________________________________________
> Pw_forum mailing list
> Pw_forum at pwscf.org
> http://www.democritos.it/mailman/listinfo/pw_forum
-------------- next part --------------
!
! Copyright (C) 2001-2004 Carlo Cavazzoni and PWSCF group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!
! ... SUBROUTINE con_cam:       counts the number of fields in a string 
!                               separated by the optional character
!
! ... SUBROUTINE field_count:   accepts two string (one of them is optional) 
!                               and one integer and count the number of fields
!                               in the string separated by a blank or a tab 
!                               character. If the optional string is specified
!                               (it has anyway len=1) it is assumed as the 
!                               separator character.
!                               Ignores any charcter following the exclamation 
!                               mark (fortran comment)
!
! ... SUBROUTINE field_compare: accepts two strings and one integer. Counts the
!                               fields contained in the first string and 
!                               compares it with the integer. 
!                               If they are less than the integer calls the 
!                               routine error and show by the second string the
!                               name of the field where read-error occurred.
!
#include "f_defs.h"
!
!----------------------------------------------------------------------------
MODULE parser
  !----------------------------------------------------------------------------
  !
  USE io_global, ONLY : stdout
  USE kinds
  !
  CONTAINS
  !
  !-----------------------------------------------------------------------
  PURE FUNCTION int_to_char( int )
    !-----------------------------------------------------------------------
    !
    IMPLICIT NONE
    !
    INTEGER, INTENT(IN) :: int
    CHARACTER (LEN=6)   :: int_to_char
    !
    !   
    IF ( int < 10 ) THEN
       !
       WRITE( UNIT = int_to_char , FMT = "(I1)" ) int
       !
    ELSE IF ( int < 100 ) THEN
       !
       WRITE( UNIT = int_to_char , FMT = "(I2)" ) int
       !
    ELSE IF ( int < 1000 ) THEN
       !
       WRITE( UNIT = int_to_char , FMT = "(I3)" ) int
       !
    ELSE IF ( int < 10000 ) THEN
       !
       WRITE( UNIT = int_to_char , FMT = "(I4)" ) int
       !
    ELSE      
       ! 
       WRITE( UNIT = int_to_char , FMT = "(I5)" ) int     
       !
    END IF    
    !
    RETURN
    !
  END FUNCTION int_to_char
  !
  !
  !--------------------------------------------------------------------------
  SUBROUTINE delete_if_present( filename, in_warning )
    !--------------------------------------------------------------------------
    !
    IMPLICIT NONE
    !
    CHARACTER(LEN=*),  INTENT(IN) :: filename
    LOGICAL, OPTIONAL, INTENT(IN) :: in_warning
    LOGICAL                       :: exst, opnd, warning
    INTEGER                       :: iunit
    !
    INQUIRE( FILE = filename, EXIST = exst )
    !
    IF ( exst ) THEN
       !
       unit_loop: DO iunit = 99, 1, - 1
          !
          INQUIRE( UNIT = iunit, OPENED = opnd )
          !
          IF ( .NOT. opnd ) THEN
             !
             warning = .FALSE.
             !
             IF ( PRESENT( in_warning ) ) warning = in_warning
             !
             OPEN(  UNIT = iunit, FILE = filename , STATUS = 'OLD' )
             CLOSE( UNIT = iunit, STATUS = 'DELETE' )
             !
             IF ( warning ) &
                WRITE( UNIT = stdout, FMT = '(/,5X,"WARNING: ",A, &
                     & " file was present; old file deleted")' ) filename
             !
             RETURN
             !
          END IF
          !
       END DO unit_loop
       !
       CALL errore( 'delete_if_present', 'free unit not found ?!?', 1 )
       !
    END IF
    !
    RETURN
    !
  END SUBROUTINE delete_if_present
  !
  !--------------------------------------------------------------------------
  PURE SUBROUTINE field_count( num, line, car )
    !--------------------------------------------------------------------------
    !
    IMPLICIT NONE
    !
    INTEGER,                    INTENT(OUT) :: num
    CHARACTER(LEN=*),           INTENT(IN)  :: line
    CHARACTER(LEN=1), OPTIONAL, INTENT(IN)  :: car
#if defined __AIX
    !  with AIX compiler some combination of flags lead to
    !  variables being defined as static, hence giving a conflict
    !  with PURE function. We then force the variable be AUTOMATIC
    CHARACTER(LEN=1), AUTOMATIC             :: sep1, sep2    
    INTEGER, AUTOMATIC                      :: j
#else
    CHARACTER(LEN=1)                        :: sep1, sep2    
    INTEGER                                 :: j
#endif
    !
    !
    num = 0
    !
    IF ( .NOT. present(car) ) THEN
       !
       sep1 = char(32)  ! ... blank character
       sep2 = char(9)   ! ... tab character
       !
       DO j = 2, MAX( LEN( line ), 256 )
          !
          IF ( line(j:j) == '!' .OR. line(j:j) == char(0) ) THEN
             !
             IF ( line(j-1:j-1) /= sep1 .AND. line(j-1:j-1) /= sep2 ) THEN
                !
                num = num + 1
                !
             END IF   
             !
             EXIT
             !
          END IF
          !
          IF ( ( line(j:j) == sep1 .OR. line(j:j) == sep2 ) .AND. &
               ( line(j-1:j-1) /= sep1 .AND. line(j-1:j-1) /= sep2 ) ) THEN
             !
             num = num + 1
             !
          END IF
          !
       END DO
       !
    ELSE
       !
       sep1 = car
       !
       DO j = 2, MAX( LEN( line ), 256 )
          ! 
          IF ( line(j:j) == '!' .OR. &
               line(j:j) == char(0) .OR. line(j:j) == char(32) ) THEN
             !
             IF ( line(j-1:j-1) /= sep1 ) num = num + 1
             !
             EXIT
             !
          END IF
          !
          IF ( line(j:j) == sep1 .AND. line(j-1:j-1) /= sep1 ) num = num + 1
          !
       END DO
       !
    END IF
    !
    RETURN
    !
  END SUBROUTINE field_count
  !
  !
  !--------------------------------------------------------------------------
  SUBROUTINE read_line( line, nfield, field, end_of_file )
    !--------------------------------------------------------------------------
    !
    USE mp,        ONLY : mp_bcast
    USE mp_global, ONLY : group
    USE io_global, ONLY : ionode, ionode_id
    !
    IMPLICIT NONE
    !
    CHARACTER(LEN=*),           INTENT(OUT) :: line
    CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: field
    INTEGER,          OPTIONAL, INTENT(IN)  :: nfield
    LOGICAL,          OPTIONAL, INTENT(OUT) :: end_of_file
    LOGICAL                                 :: tend
    !
    !
    IF( LEN( line ) < 256 ) THEN
       CALL errore(' read_line ', ' input line too short ', LEN( line ) )
    END IF
    !
    IF ( ionode ) THEN
       READ (5, fmt='(A256)', END=10) line
       tend = .FALSE.
       GO TO 20
10     tend = .TRUE.
20     CONTINUE
    END IF
    !
    CALL mp_bcast( tend, ionode_id, group )
    CALL mp_bcast( line, ionode_id, group )
    !
    IF( PRESENT(end_of_file) ) THEN
       end_of_file = tend
    ELSE IF( tend ) THEN
       CALL errore(' read_line ', ' end of file ', 0 )
    ELSE
       IF( PRESENT(field) ) CALL field_compare( line, nfield, field )
    END IF
    !
    RETURN
    !
  END SUBROUTINE read_line
  !
  !
  !--------------------------------------------------------------------------
  SUBROUTINE field_compare( str, nf, var )
    !--------------------------------------------------------------------------
    !
    IMPLICIT NONE
    !
    CHARACTER(LEN=*), INTENT(IN) :: var
    INTEGER,          INTENT(IN) :: nf
    CHARACTER(LEN=*), INTENT(IN) :: str
    INTEGER                      :: nc
    !
    CALL field_count( nc, str )
    !
    IF( nc < nf ) &
      CALL errore( ' field_compare ', &
                 & ' wrong number of fields: ' // TRIM( var ), 1 )
    !
    RETURN
    !
  END SUBROUTINE field_compare
  !
  !
  !--------------------------------------------------------------------------
  SUBROUTINE con_cam(num, line, car)
    !--------------------------------------------------------------------------
    CHARACTER(LEN=*) :: line
    CHARACTER(LEN=1) :: sep
    CHARACTER(LEN=1), OPTIONAL :: car
    INTEGER :: num, j

    num = 0
    IF (len(line) .GT. 256 ) THEN
       WRITE( stdout,*) 'riga ', line
       WRITE( stdout,*) 'lunga ', len(line)
       num = -1
       RETURN
    END IF

    WRITE( stdout,*) '1riga ', line
    WRITE( stdout,*) '1lunga ', len(line)
    IF ( .NOT. present(car) ) THEN
       sep=char(32)             !char(32) is the blank character
    ELSE
       sep=car
    END IF

    DO j=2, MAX(len(line),256)
       IF ( line(j:j) == '!' .OR. line(j:j) == char(0)) THEN
          RETURN
       END IF
       IF ( (line(j:j) .EQ. sep) .AND. &
            (line(j-1:j-1) .NE. sep) )  THEN
          num = num + 1
       END IF
    END DO
    RETURN
  END SUBROUTINE con_cam
  !
END MODULE parser


More information about the users mailing list