var/external/bufr/rsvfvm.f

   1       SUBROUTINE RSVFVM(NEM1,NEM2)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    RSVFVM
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE STEPS THROUGH THE "FOLLOWING VALUE"
   9 C   MNEMONIC NEM1 AND, FOR EACH "." CHARACTER ENCOUNTERED (EXCEPT FOR
  10 C   THE INITIAL ONE), OVERWRITES IT WITH THE NEXT CORRESPONDING
  11 C   CHARACTER FROM NEM2 (SEE REMARKS).
  12 C
  13 C PROGRAM HISTORY LOG:
  14 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  15 C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
  16 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  17 C                           INTERDEPENDENCIES
  18 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
  19 C                           DOCUMENTATION
  20 C
  21 C USAGE:    CALL RSVFVM (NEM1, NEM2)
  22 C   INPUT ARGUMENT LIST:
  23 C     NEM1     - CHARACTER*8: "FOLLOWING VALUE" MNEMONIC
  24 C     NEM2     - CHARACTER*8: MNEMONIC IMMEDIATELY FOLLOWING NEM1
  25 C                WITHIN USER DICTIONARY TABLE
  26 C
  27 C   OUTPUT ARGUMENT LIST:
  28 C     NEM1     - CHARACTER*8: COPY OF INPUT NEM1 WITH ALL "."
  29 C                CHARACTERS (EXCEPT INITIAL ONE) OVERWRITTEN WITH
  30 C                CORRESPONDING CHARACTERS FROM NEM2
  31 C
  32 C REMARKS:
  33 C    FOR EXAMPLE:
  34 C     if, on input:    NEM1 = ".DTH...."
  35 C                      NEM2 = "MXTM    "
  36 C     then, on output: NEM1 = ".DTHMXTM"
  37 C
  38 C
  39 C    THIS ROUTINE CALLS:        None
  40 C    THIS ROUTINE IS CALLED BY: NEMTBD   SEQSDX
  41 C                               Normally not called by any application
  42 C                               programs.
  43 C
  44 C ATTRIBUTES:
  45 C   LANGUAGE: FORTRAN 77
  46 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  47 C
  48 C$$$
  49
  50       CHARACTER*8 NEM1,NEM2
  51
  52       DO I=1,LEN(NEM1)
  53       IF(I.EQ.1) THEN
  54
  55 C        Skip initial "." and initialize J.
  56
  57          J = 1
  58       ELSE
  59          IF(NEM1(I:I).EQ.'.') THEN
  60             NEM1(I:I) = NEM2(J:J)
  61             J = J+1
  62          ENDIF
  63       ENDIF
  64       ENDDO
  65
  66       RETURN
  67       END