!+ Program to construct a weighted average of two SAMSON-files.
!
! Method:
!	Straightforward.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!	Version		Date		Comment
!	1.0		12-04-95	First Version under RCS
!					(J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77 with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      PROGRAM WADD
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/dimensions_field.ucf'
      INCLUDE 'incl/error.pcf'
      INCLUDE 'incl/prec_machine.ucf'
      INCLUDE 'incl/precision.pcf'
      INCLUDE 'incl/samson_pstar.ecf'
!
!     DECLARATION OF VARIABLES.
      CHARACTER
     &     FILE_1*80
!             NAME OF FIRST INPUT FILE
     &   , TITLE_1*80
!             TITLE OF FIRST FILE
     &   , FILE_2*80
!             NAME OF SECOND INPUT FILE
     &   , TITLE_2*80
!             TITLE OF SECOND FILE
     &   , FILE_OUT*80
!             OUTPUT FILE
      INTEGER
     &     IERR
!             ERROR FLAG
     &   , IOS
!             I/O ERROR FLAG
     &   , N_PROFILE_1
!             NUMBER OF PROFILES IN FIRST FILE
     &   , N_LAYER_1
!             NUMBER OF LAYERS IN FIRST FILE
     &   , N_PROFILE_2
!             NUMBER OF PROFILES IN SECOND FILE
     &   , N_LAYER_2
!             NUMBER OF LAYERS IN SECOND FILE
     &   , I
!             LOOP VARIABLE
     &   , L
!             LOOP VARIABLE
      REAL*8
     &     P_1(NPD_LAYER+1)
!             PRESSURES IN FIRST FILE
     &   , P_2(NPD_LAYER+1)
!             PRESSURES IN SECOND FILE
     &   , PSTAR
!             SURFACE PRESSURE
     &   , FIELD_1(NPD_PROFILE, NPD_LAYER+1)
!             FIRST FIELD READ IN
     &   , FIELD_2(NPD_PROFILE, NPD_LAYER+1)
!             SECOND FIELD READ IN
     &   , FIELD_OUT(NPD_PROFILE, NPD_LAYER+1)
!             OUTPUT FIELD
     &   , WEIGHT_1
!             FIRST WEIGHTING FACTOR
     &   , WEIGHT_2
!             FIRST WEIGHTING FACTOR
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     READ_SAMSON_FIELD, WRITE_SAMSON_FIELD
!
!
      DATA PSTAR/PSTAR_DEFAULT/
!
!
!
      WRITE(IU_USER, '(/A)') 'ENTER NAME OF FIRST INPUT FILE.'
      READ(IU_STDIN, '(A)') FILE_1
      CALL READ_SAMSON_FIELD(IERR, .TRUE., .FALSE.
     &   , FILE_1, TITLE_1
     &   , N_PROFILE_1, N_LAYER_1, P_1, PSTAR, FIELD_1
     &   )
      IF (IERR.NE.I_NORMAL) STOP
!
1     WRITE(IU_USER, '(/A)') 'ENTER WEIGHTING FACTOR FOR FIRST FILE.'
      READ(IU_STDIN, *, IOSTAT=IOS) WEIGHT_1
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(A)') '+++ ILLEGAL RESPONSE: PLEASE REENTER.'
         GOTO 1
      ENDIF
!
      WRITE(IU_USER, '(/A)') 'ENTER NAME OF SECOND INPUT FILE.'
      READ(IU_STDIN, '(A)') FILE_2
      CALL READ_SAMSON_FIELD(IERR, .TRUE., .FALSE.
     &   , FILE_2, TITLE_2
     &   , N_PROFILE_2, N_LAYER_2, P_2, PSTAR, FIELD_2
     &   )
      IF (IERR.NE.I_NORMAL) STOP
!
2     WRITE(IU_USER, '(/A)') 'ENTER WEIGHTING FACTOR FOR SECOND FILE.'
      READ(IU_STDIN, *, IOSTAT=IOS) WEIGHT_2
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(A)') '+++ ILLEGAL RESPONSE: PLEASE REENTER.'
         GOTO 2
      ENDIF
!
!     CHECK FOR COMPATIBILITY.
      IF ( (N_PROFILE_1.NE.N_PROFILE_2).OR.
     &     (N_LAYER_1.NE.N_LAYER_2) ) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR: THESE FILES ARE OF INCOMPATIBLE SIZES.'
         STOP
      ENDIF
      DO I=1, N_LAYER_1+1
         IF ( ABS(P_1(I)-P_2(I)).LT.TOL_TEST ) THEN
            DO L=1, N_PROFILE_1
               FIELD_OUT(L, I)=WEIGHT_1*FIELD_1(L, I)
     &            +WEIGHT_2*FIELD_2(L, I)
            ENDDO
         ELSE
            WRITE(IU_ERR, '(/A)')
     &         '*** ERROR: THESE FILES HAVE '
     &         //'INCOMPATIBLE PRESSURE LEVELS.'
            STOP
         ENDIF
      ENDDO
!
      WRITE(IU_USER, '(/A)') 'ENTER NAME OF OUTPUT FILE'
      READ(IU_STDIN, '(A)') FILE_OUT
      CALL WRITE_SAMSON_FIELD(IERR, .FALSE.
     &   , FILE_OUT, TITLE_1
     &   , N_PROFILE_1, N_LAYER_1, P_1, PSTAR, FIELD_OUT)
      IF (IERR.NE.I_NORMAL) STOP
!
!
      STOP
      END
