!+ Subroutine to split a profile into SAMSON-files.
!
! Method:
!	For each field in a profile is examined. Appropriate pressure
!	coordinates are derived and the field is written to a file
!	with a suitable suffix.
!
! 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.
!
!- ---------------------------------------------------------------------
      SUBROUTINE WRITE_PROFILE(IERR
     &   , N_LEVEL, N_COLUMN_PROFILE, I_DATA_GROUP, I_DATA_TYPE, PROFILE
     &   , L_REFERENCE, N_LEVEL_REF, P_REF, Z_REF
     &   , NAME_PROFILE, LENGTH
     &   )
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/dimensions_field.ucf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
      INCLUDE 'incl/gas_list.pcf'
      INCLUDE 'incl/aerosol_component.pcf'
      INCLUDE 'incl/input_head.pcf'
      INCLUDE 'incl/input_head.ncf'
      INCLUDE 'incl/samson_parm.ecf'
      INCLUDE 'incl/samson_pstar.ecf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     N_LEVEL
!             NUMBER OF LEVELS IN PROFILE
     &   , N_COLUMN_PROFILE
!             NUMBER OF COLUMNS IN PROFILE
     &   , I_DATA_GROUP(NPD_DATA_COLUMN)
!             DATA TYPES OF COLUMNS
     &   , I_DATA_TYPE(NPD_DATA_COLUMN)
!             DATA TYPES OF COLUMNS
     &   , LENGTH
!             LENGTH OF PROFILE NAME
     &   , N_LEVEL_REF
!             NUMBER OF LEVELS IN REFERENCE ATM.
      CHARACTER	!, INTENT(IN)
     &     NAME_PROFILE*80
!             NAME OF PROFILE
      LOGICAL	!, INTENT(IN)
     &     L_REFERENCE
!             TRUE IF REFERENCE PROFILE PRESENT
      REAL*8	!, INTENT(IN)
     &     PROFILE(NPD_LAYER+1, NPD_DATA_COLUMN)
!             DATA FOR OUTPUT
     &   , P_REF(NPD_LAYER+1)
!             REFERENCE ATMOSPHERIC PRESSURE
     &   , Z_REF(NPD_LAYER+1)
!             REFERENCE ATMOSPHERIC HEIGHTS
!
!     LOCAL VARIABLES.
      INTEGER
     &     I_COLUMN
!             COLUMN INDEX
     &   , I_TYPE
!             TYPE INDEX
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
      LOGICAL
     &     L_PRESSURE
!             PRESSURE FLAG
     &   , L_HEIGHT
!             HEIGHT FLAG
      CHARACTER
     &     TITLE*80
!             TITLE FOR SAMSON FILE
     &   , FILE_NAME*80
!             NAME OF OUTPUT FILE
      REAL*8
     &     FIELD(NPD_LAYER+1)
!             OUTPUT FIELD
     &   , P(NPD_LAYER+1)
!             OUTPUT PRESSURE
     &   , PSTAR
!             SURFACE PRESSURE
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     WRITE_SAMSON_FIELD
!
!
!     SET VALUES ON A DATA STATEMENT.
      INCLUDE 'incl/input_head.dcf'
      DATA PSTAR/PSTAR_DEFAULT/
!
!
!
!     INITIALIZE THE LOGICALS.
      L_PRESSURE=.FALSE.
      L_HEIGHT=.FALSE.
!
!     SCAN THE LIST OF DATA TYPES TO FIND THE PRESSURE, IF PRESENT, OR
!     THE HEIGHT IF NOT.
      I_COLUMN=0
1     I_COLUMN=I_COLUMN+1
      IF ( (I_DATA_GROUP(I_COLUMN).EQ.IP_PHYSICAL_DATA).AND.
     &   (I_DATA_TYPE(I_COLUMN).EQ.IP_PRESSURE) ) THEN
         L_PRESSURE=.TRUE.
         DO I=1, N_LEVEL
            P(I)=PROFILE(I, I_COLUMN)
         ENDDO
      ELSE IF (I_COLUMN.LT.N_COLUMN_PROFILE) THEN
         GOTO 1
      ENDIF
!
      IF (.NOT.L_PRESSURE) THEN
!        THE PRESSURE MUST BE INTERPOLATED FROM THE HEIGHT.
!        CHECK THAT A REFERENCE PROFILE IS SET.
         IF (.NOT.L_REFERENCE) THEN
            WRITE(IU_ERR, '(/A)')
     &         '** ERROR: NO REFERENCE PROFILE IS SET.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
         I_COLUMN=0
2        I_COLUMN=I_COLUMN+1
         IF ( (I_DATA_GROUP(I_COLUMN).EQ.IP_PHYSICAL_DATA).AND.
     &      (I_DATA_TYPE(I_COLUMN).EQ.IP_HEIGHT) ) THEN
            L_HEIGHT=.TRUE.
         ELSE IF (I_COLUMN.LT.N_COLUMN_PROFILE) THEN
            GOTO 2
         ENDIF
!
         IF (.NOT.L_HEIGHT) THEN
            WRITE(IU_ERR, '(/A)')
     &         '*** ERROR: CURRENT PROFILE CONTAINS '
     &         //'NO HEIGHT OR PRESSURE DATA.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
!
         DO I=1, N_LEVEL
!           FIND THE PRESSURE LEVELS IN THE REFERENCE PROFILE BRACKETING
!           THE DESIRED LEVEL. NOTE THAT HEIGHTS IN THE REFERENCE ARE IN
!           ASCENDING ORDER FOR CONFORMITY WITH SAMSON.
            J=N_LEVEL_REF
3           IF ( (Z_REF(J-1).LT.PROFILE(I, I_COLUMN))
     &         .AND.(J.GT.2) ) THEN
               J=J-1
               GOTO 3
            ENDIF
            P(I)=P_REF(J)*EXP((PROFILE(I, I_COLUMN)-Z_REF(J))
     &         *LOG(P_REF(J-1)/P_REF(J))/(Z_REF(J-1)-Z_REF(J)))
         ENDDO
      ENDIF
!
!     WRITE A SEPARATE FILE FOR EACH COLUMN.
      DO J=1, N_COLUMN_PROFILE
         I_TYPE=I_DATA_TYPE(J)
!        DISCARD SPECIFIED COLUMNS.
         IF (I_TYPE.NE.IP_DISCARD) THEN
            DO I=1, LEN(FILE_NAME)
               FILE_NAME(I:I)=' '
            ENDDO
            IF (I_DATA_GROUP(J).EQ.IP_PHYSICAL_DATA) THEN
               FILE_NAME(1: LENGTH+7)=NAME_PROFILE(1: LENGTH)//'.'
     &            //PHYS_SUFFIX(I_TYPE)
               TITLE(1: 30)=PHYS_TITLE(I_TYPE)(1: 30)
            ELSE IF (I_DATA_GROUP(J).EQ.IP_GASEOUS_DATA) THEN
               FILE_NAME(1: LENGTH+7)=NAME_PROFILE(1: LENGTH)//'.'
     &            //GAS_SUFFIX(I_TYPE)
               TITLE(1: 30)=GAS_TITLE(I_TYPE)(1: 30)
            ELSE IF (I_DATA_GROUP(J).EQ.IP_AEROSOL_DATA) THEN
               FILE_NAME(1: LENGTH+7)=NAME_PROFILE(1: LENGTH)//'.'
     &            //AEROSOL_SUFFIX(I_TYPE)
               TITLE(1: 30)=AEROSOL_TITLE(I_TYPE)(1: 30)
            ENDIF
            DO I=31, LEN(TITLE)
               TITLE(I: I)=' '
            ENDDO
            DO I=1, N_LEVEL
               FIELD(I)=PROFILE(I, J)
            ENDDO
            CALL WRITE_SAMSON_FIELD(IERR, .FALSE., FILE_NAME, TITLE
     &         , 1, N_LEVEL-1, P, PSTAR, FIELD)
            IF (IERR.NE.I_NORMAL) RETURN
         ENDIF
      ENDDO
!
!
      RETURN
      END
