!+ Program to generate a null SAMSON file.
!
! Method:
!	Pressure levels are read in and a SAMSON file with
!	a null field at these levels is written.
!
! 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 GEN_NULL
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/dimensions_field.ucf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/gas_list.pcf'
      INCLUDE 'incl/aerosol_component.pcf'
      INCLUDE 'incl/def_data_in.icf'
      INCLUDE 'incl/samson_parm.ecf'
      INCLUDE 'incl/samson_pstar.ecf'
      INCLUDE 'incl/input_head.pcf'
      INCLUDE 'incl/input_head.ncf'
      INCLUDE 'incl/error.pcf'
!
!     DECLARATION OF VARIABLES.
      INTEGER
     &     IERR
!             ERROR FLAG
     &   , IOS
!             I/O ERROR FLAG
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , N_PROFILE
!             NUMBER OF PRESSURE LEVELS
     &   , N_LEVEL
!             NUMBER OF PRESSURE LEVELS
     &   , POINTER(NPD_LAYER+1)
!             POINTER FOR SORTING
      CHARACTER
     &     UNIT*6
!             UNIT FOR PRESSURE
     &   , FILE_NULL*80
!             NAME OF NULL FILE
     &   , TITLE*80
!             SAMSON TITLE
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
      REAL*8
     &     P_LEVEL(NPD_LAYER+1)
!             SPECIFIED LEVELS
     &   , KEY(NPD_LAYER+1)
!             SORTING KEY
     &   , FACTOR
!             INPUT CONVERSION FACTOR
     &   , FIELD_NULL(NPD_PROFILE, NPD_LAYER+1)
!             NULL FIELD GENERATED
     &   , PSTAR
!             SURFACE PRESSURE
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     SHELL_SORT, WRITE_SAMSON_FIELD
!
!
      INCLUDE 'incl/input_head.dcf'
      DATA PSTAR/PSTAR_DEFAULT/
!
!
!
!     READ FROM STANDARD INPUT THE REQUIRED PRESSURE LEVELS
      WRITE(IU_USER, '(/A)')
     &   'ENTER UNIT FOR FOLLOWING PRESSURE LEVELS:'
1     READ(IU_STDIN, '(A)') UNIT
      K=0
2     K=K+1
      IF (UNIT.EQ.NAME_UNIT(K)) THEN
         FACTOR=FACTOR_UNIT(K)
      ELSE IF (K.LT.NPD_UNIT) THEN
         GOTO 2
      ELSE
         WRITE(IU_ERR, '(A)') '+++ UNRECOGNIZED UNIT:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE REENTER'
            GOTO 1
         ENDIF
      ENDIF
      WRITE(IU_USER, '(A)') 'ENTER NUMBER OF PRESSURE LEVELS.'
3     READ(IU_STDIN, *, IOSTAT=IOS) N_LEVEL
      IF  (IOS.NE.0) THEN
         WRITE(IU_ERR, '(A)') 'ILLEGAL RESPONSE:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE REENTER.'
            GOTO 3
         ENDIF
      ENDIF
      IF (N_LEVEL.GT.NPD_LAYER+1) THEN
         WRITE(IU_ERR, '(/A)') 'TOO MANY LEVELS:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE REDUCE.'
            GOTO 3
         ENDIF
      ENDIF
      WRITE(IU_USER, '(A)') 'SPECIFY PRESSURES AT THESE LEVELS.'
      READ(IU_STDIN, *, IOSTAT=IOS) (P_LEVEL(K), K=1, N_LEVEL)
!
      WRITE(IU_USER, '(A)') 'ENTER NUMBER OF PROFILES.'
4     READ(IU_STDIN, *, IOSTAT=IOS) N_PROFILE
      IF  (IOS.NE.0) THEN
         WRITE(IU_ERR, '(A)') 'ILLEGAL RESPONSE:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE REENTER.'
            GOTO 4
         ENDIF
      ENDIF
      IF (N_PROFILE.GT.NPD_PROFILE) THEN
         WRITE(IU_ERR, '(/A)') '+++ TOO MANY PROFILES:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_USER, '(/A)') 'PLEASE REDUCE.'
            GOTO 4
         ENDIF
      ENDIF
!
!     OBTAIN THE NAME OF THE OUTPUT FILE.
      WRITE(IU_USER, '(/A)') 'ENTER THE NAME OF THE OUTPUT FILE.'
      READ(IU_STDIN, '(A)') FILE_NULL
!
!     SORT THE PRESSURES
      DO I=1, N_LEVEL
         KEY(I)=P_LEVEL(I)
         POINTER(I)=I
      ENDDO
      CALL SHELL_SORT(N_LEVEL, POINTER, KEY)
      DO I=1, N_LEVEL
         KEY(I)=P_LEVEL(POINTER(I))
      ENDDO
      DO I=1, N_LEVEL
         P_LEVEL(I)=FACTOR*KEY(I)
      ENDDO
!
!     PREPARE THE CORRECT FIELD.
      DO I=1, N_LEVEL
         DO J=1, N_PROFILE
            field_null(j, I)=0.0D+00
         ENDDO
      ENDDO
!
!     CONSTRUCT THE SAMSON HEADERS.
      TITLE(1:30)=PHYS_TITLE(IP_NULL_FIELD)(1:30)
      DO I=31, LEN(TITLE)
         TITLE(I: I)=' '
      ENDDO
      CALL WRITE_SAMSON_FIELD(IERR, .FALSE., FILE_NULL, TITLE
     &   , N_PROFILE, N_LEVEL-1, P_LEVEL, PSTAR, FIELD_NULL)
!
!
      STOP
      END
