C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     LDM_WRF_PK       **
C**************************
C
C
      SUBROUTINE LDM_WRF_PK (IUNOUT, KEYWORD, CH_FLAG, NPK, 
     +                       PRDF, IOPTYP)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Write out pack dependent real parameter values to LDM file
C
C ***** 'LDM' SERVICE ROUTINE ONLY ****
C
C Author:  John W. Campbell, June 1993
C
C Arguments:
C
      INTEGER IUNOUT
      CHARACTER*(*) KEYWORD
      INTEGER CH_FLAG(*)
      INTEGER NPK
      LOGICAL PRDF
      INTEGER IOPTYP

C IUNOUT   (R)   Unit number for output file (see LDM_WRITE)
C KEYWORD  (R)   Parameter name keyword (full)
C CH_FLAG  (R)   Parameter changed flags
C NPK      (R)   Number of packs (minimum 1)
C PRDF     (R)   Print default values unconditionally
C IOPTYP   (R)   IOPTYP flag from LDM_WRITE routine call
C
C====== Parameter statements
C 

C
C====== GLOBALS:
C

C
C====== FUNCTION TYPES:
C
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL CHANGES
      LOGICAL TERM
      INTEGER ICHAN
      INTEGER IOP
      INTEGER IUN
      INTEGER I
      INTEGER LL
      INTEGER IVAL
      INTEGER ND
      INTEGER ITYP
      INTEGER IFLAG
      INTEGER IERR
      CHARACTER*1 VALSTR
      CHARACTER*1 ERRSTR
      CHARACTER*80 LIN
      CHARACTER*80 STR
      REAL VALUE
      REAL VREF
      REAL EPS

C     LOGICAL CHANGES      !Changed parameter values flag
C     LOGICAL TERM         !Terminal o/p flag
C     INTEGER ICHAN        !Changed values channel
C     INTEGER IOP          !Output flag (see LDM_WRITE)
C     INTEGER IUN          !Output unit no.
C     INTEGER I            !Packs loop variable
C     INTEGER LL           !Significant length of line/string
C     INTEGER IVAL         !Integer value of parameter
C     INTEGER ND           !No. of decimal placed for parameter value print
C     INTEGER ITYP         !Parameter type flag from LDM_GET
C     INTEGER IFLAG        !Parameter value status flag from LDM_GET
C     INTEGER IERR         !Error flag from LDM_GET
C     CHARACTER*1 VALSTR   !Parameter value string (treated as dummy here)
C     CHARACTER*1 ERRSTR   !Error return string (treated as dummy here)
C     CHARACTER*80 LIN     !Buffer for output line
C     CHARACTER*80 STR     !String for current keyword & value
C     REAL VALUE           !Real value of parameter
C     REAL VREF            !Reference value
C     REAL EPS             !Small difference for 'equal' values test
C
C-------------------------------------------------------------------------------
C
      IF (IOPTYP.GT.0) THEN
         CHANGES = .FALSE.
         ICHAN = 0
         IOP = IOPTYP
      ELSE
         CHANGES = .TRUE.
         ICHAN = -IOPTYP
         IOP = 1
         IF (ICHAN.LT.1.OR.ICHAN.GT.16) RETURN
      END IF
      IF (IUNOUT.GT.0) THEN
         IUN = IUNOUT
         TERM = .FALSE.
      ELSE
         IUN = -IUNOUT
         TERM = .TRUE.
      END IF
      IF (IOP.EQ.4.OR.CHANGES) GO TO 300
C
C====== See if same for all packs
C
      CALL LDM_GET (KEYWORD, 1, 0, VALSTR, VREF, ND, IVAL,
     +              IFLAG, ITYP, IERR, ERRSTR)
      EPS = 1.0E-09
      DO 200 I = 1, NPK
         CALL LDM_GET (KEYWORD, I, 0, VALSTR, VALUE, ND, IVAL,
     +                 IFLAG, ITYP, IERR, ERRSTR)
         IF (ABS(VALUE-VREF).GT.EPS) GO TO 300
200   CONTINUE
      CALL LDM_GET (KEYWORD, 1, 1, VALSTR, VALUE, ND, IVAL,
     +              IFLAG, ITYP, IERR, ERRSTR)
      IF (PRDF.OR.IFLAG.GT.0) THEN
         STR = KEYWORD
         CALL STR_ADDF (STR, VALUE, ND, 1)
         IF (TERM) THEN
            CALL TTSEND (IUN,STR(1:LENSTR(STR)),1)
         ELSE
            WRITE(IUN,1000) STR(1:LENSTR(STR))
         END IF
      END IF
      RETURN
C
C====== No uniform pattern / output all
C
300   LIN = ' '
      DO 320 I = 1, NPK
         CALL LDM_GET (KEYWORD, I, 0, VALSTR, VALUE, ND, IVAL,
     +                IFLAG, ITYP, IERR, ERRSTR)
         IF (CHANGES) THEN
            CALL LDM_CHANGED (ICHAN, CH_FLAG(I), IFLAG)
            IF (IFLAG.EQ.0) GO TO 320
         END IF
         STR = KEYWORD
         CALL STR_ADDS (STR, '[',0)
         CALL STR_ADDI (STR, I, 0)
         CALL STR_ADDS (STR, ']', 0)
         CALL STR_ADDF (STR, VALUE, ND, 1)
         CALL LDM_ADDOUT (LIN, STR, IUN, TERM)
320   CONTINUE
      IF (LIN.NE.' ') THEN
         IF (TERM) THEN
            CALL TTSEND (IUN,LIN(1:LENSTR(LIN)),1)
         ELSE
            WRITE(IUN,1000) LIN(1:LENSTR(LIN))
         END IF
      END IF
      RETURN
C
C====== Format statements
C
1000  FORMAT (A)
      END         
