MODULE survey_data



!  Copyright 1994, Miles Ellis, Ivor Philips and Tom Lahey

!  Copyright 1994, Addison-Wesley Publishers Ltd.

!  Copyright 1994, Addison-Wesley Publishing Company Inc.

!  Permission is granted for the use of this code for the purpose of teaching

!  and/or learning the Fortran 90 language provided that the above copyright

!  notices are included in any copies made.

!  Neither the authors nor the publishers accept any responsibility for

!  any results obtained by use of this code.



   IMPLICIT NONE



   ! This module contains a type definition and constants

   ! for use with the input and processing of survey data



   ! Type definition for survey response

   TYPE survey_info

      CHARACTER(LEN=20) :: name

      CHARACTER :: sex

      INTEGER :: job_status,age,months_jobless,at_home_code

      REAL :: salary,other_income

   END TYPE survey_info



   ! Various codes

   CHARACTER, PARAMETER :: female="F", male="M"  ! Sex

   INTEGER, PARAMETER ::                        &

            ft_ed=1,ft_job=2,pt_job=3,          &! Job status

            no_job=4,at_home=5,                 &! ----------

            ch_minder=1,rel_minder=2,other=3,   &! At home code

            unused=-1                            ! Unused code



END MODULE Survey_data





SUBROUTINE input(unit,max_datasets,survey_data,num_datasets, &

                 error_code)



!  Copyright 1994, Miles Ellis, Ivor Philips and Tom Lahey

!  Copyright 1994, Addison-Wesley Publishers Ltd.

!  Copyright 1994, Addison-Wesley Publishing Company Inc.

!  Permission is granted for the use of this code for the purpose of teaching

!  and/or learning the Fortran 90 language provided that the above copyright

!  notices are included in any copies made.

!  Neither the authors nor the publishers accept any responsibility for

!  any results obtained by use of this code.



   USE Survey_data

   IMPLICIT NONE



   ! This subroutine reads up to max_datasets records prepared

   ! as follows, returning the number read in num_datasets



   ! Columns 1-20  Name 

   !           23  Sex (M or F)

   !           25  Job status (1-5) 

   !        28,29  Age - for status 1, 4 or 5 

   !        28-31  Monthly salary - for status 2 and 3 

   !        32-34  Other monthly income - for status 3 

   !        32-34  Months unemployed - for status 4 

   !           31  Special code (1-3) - for status 5 



   ! Arguments

   INTEGER :: unit,max_datasets,num_datasets,error_code

   TYPE(survey_info), DIMENSION(:) :: survey_data



   ! Local variables

   CHARACTER(LEN=30) :: data_file

   CHARACTER(LEN=20) :: name

   CHARACTER :: sex

   INTEGER :: i,ios,status,age,months,code

   REAL :: salary,income



   ! Ask for name of data file

   ! A maximum of three attempts will be allowed to open the file

   DO i=1,3

      PRINT *,"Type name of data file"

      READ '(A)',data_file

      ! Open file at beginning

      OPEN (UNIT=unit,FILE=data_file,POSITION="REWIND",    &

            IOSTAT=ios)

      IF (ios==0) EXIT

      ! Error when opening file - try again

      PRINT *,"Unable to open file - please try again"

   END DO



   ! If open was unsuccessful after 3 attempts return error=-1

   IF (ios/=0) THEN

      error_code = -1

      RETURN

   END IF

   error_code = 0



   ! Loop to read data 

   DO i=1,max_datasets

      ! Read (part of) next set of data

      READ (UNIT=unit,FMT='(A20,2X,A1,1X,I1,2X,I2,1X,I1)',  &

            IOSTAT=ios) name,sex,status,age,code



      ! Check for errors and end of file

      SELECT CASE (ios)

      CASE (:-1)              ! End of file - no more data

         EXIT



      CASE (1:)               ! Error during reading

         error_code = -2

         EXIT

      END SELECT



      ! Process data read and backspace for more if necessary

      SELECT CASE (status)

      CASE (ft_ed,at_home)

         ! All data for this person already read

         ! Set unused items to unused code

         months = unused

         salary = unused

         income = unused

         IF (status == ft_ed) code = unused



      CASE (ft_job,pt_job)

         ! Backspace and read financial details

         BACKSPACE unit

         READ (UNIT=unit,FMT='(T28,F4.0,2X,F4.0)') salary,income

         ! Set unused items to unused code

         age = unused

         months = unused

         code = unused

         IF (status == ft_job) income = unused



      CASE (no_job)

         ! Backspace and read unemployment details

         BACKSPACE unit

         READ (UNIT=unit,FMT='(T32,I3)') months

         ! Set unused items to unused code

         salary = unused

         income = unused

         code = unused

      END SELECT



      ! Record is now fully input, so copy to main data array

      survey_data(i) = survey_info (name,sex,status,age, &

                                    months,code,salary,income)



   END DO



   ! All data input - check if end of file was read

   IF (i > max_datasets) error_code = -3



   ! Save number of records read and return

   num_datasets = i-1



END SUBROUTINE input

