1 SUBROUTINE RCSTPL (LUN)
3 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
6 ! PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06
8 ! ABSTRACT: THIS SUBROUTINE STORES THE SUBSET TEMPLATE INTO INTERNAL
9 ! SUBSET ARRAYS IN COMMON BLOCKS /USRINT/ AND /USRBIT/. THIS IS IN
10 ! PREPARATION FOR THE ACTUAL UNPACKING OF THE SUBSET IN BUFR ARCHIVE
11 ! LIBRARY SUBROUTINE RDTREE.
13 ! PROGRAM HISTORY LOG:
14 ! 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
15 ! 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
16 ! "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
18 ! 1998-10-27 J. WOOLLEN -- MODIFIED TO CORRECT PROBLEMS CAUSED BY IN-
19 ! LINING CODE WITH FPP DIRECTIVES
20 ! 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
21 ! OPENED AT ONE TIME INCREASED FROM 10 TO 32
22 ! (NECESSARY IN ORDER TO PROCESS MULTIPLE
23 ! BUFR FILES UNDER THE MPI)
24 ! 2000-09-19 J. WOOLLEN -- MAXIMUM MESSAGE LENGTH INCREASED FROM
25 ! 10,000 TO 20,000 BYTES
26 ! 2002-05-14 J. WOOLLEN -- REMOVED OLD CRAY COMPILER DIRECTIVES
27 ! 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
29 ! 2003-11-04 D. KEYSER -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
30 ! INCREASED FROM 15000 TO 16000 (WAS IN
31 ! VERIFICATION VERSION); MAXRCR (MAXIMUM
32 ! NUMBER OF RECURSION LEVELS) INCREASED FROM
33 ! 50 TO 100 (WAS IN VERIFICATION VERSION);
34 ! UNIFIED/PORTABLE FOR WRF; ADDED
35 ! DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
36 ! MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
37 ! TERMINATES ABNORMALLY; COMMENTED OUT
38 ! HARDWIRE OF VTMP TO "BMISS" (10E10) WHEN IT
39 ! IS > 10E9 (CAUSED PROBLEMS ON SOME FOREIGN
41 ! 2004-08-09 J. ATOR -- MAXIMUM MESSAGE LENGTH INCREASED FROM
42 ! 20,000 TO 50,000 BYTES
44 ! USAGE: CALL RCSTPL (LUN)
45 ! INPUT ARGUMENT LIST:
46 ! LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
49 ! THIS ROUTINE CALLS: BORT UPBB
50 ! THIS ROUTINE IS CALLED BY: RDTREE
51 ! Normally not called by any application
55 ! LANGUAGE: FORTRAN 77
56 ! MACHINE: PORTABLE TO ALL PLATFORMS
62 PARAMETER (MAXRCR = 100)
64 COMMON / BITBUF / MAXBYT, IBIT, IBAY (MXMSGLD4), MBYT (NFILES), &
65 MBAY (MXMSGLD4, NFILES)
66 COMMON / MSGCWD / NMSG (NFILES), NSUB (NFILES), MSUB (NFILES), &
67 INODE (NFILES), IDATE (NFILES)
68 ! COMMON / TABLES / MAXTAB, NTAB, TAG (MAXJL), TYP (MAXJL), KNT ( &
69 ! MAXJL), JUMP (MAXJL), LINK (MAXJL), JMPB (MAXJL), IBT (MAXJL), &
70 ! IRF (MAXJL), ISC (MAXJL), ITP (MAXJL), VALI (MAXJL), KNTI (MAXJL),&
71 ! ISEQ (MAXJL, 2), JSEQ (MAXJL)
72 ! COMMON / USRINT / NVAL (NFILES), INV (MAXJL, NFILES), VAL (MAXJL, &
74 COMMON / USRBIT / NBIT (MAXJL), MBIT (MAXJL)
75 ! COMMON / USRTMP / ITMP (MAXJL, MAXRCR), VTMP (MAXJL, MAXRCR)
77 CHARACTER(128) BORT_STR
80 DIMENSION NBMP (2, MAXRCR), NEWN (2, MAXRCR)
81 DIMENSION KNX (MAXRCR)
84 !-----------------------------------------------------------------------
85 !-----------------------------------------------------------------------
86 IF ( .NOT. ALLOCATED (NVAL) ) ALLOCATE ( NVAL(NFILES) )
87 IF ( .NOT. ALLOCATED (INV) ) ALLOCATE ( INV(MAXJL,NFILES) )
88 IF ( .NOT. ALLOCATED (VAL) ) ALLOCATE ( VAL(MAXJL,NFILES) )
90 IF ( .NOT. ALLOCATED (ITMP) ) ALLOCATE (ITMP (MAXJL, MAXRCR))
91 IF ( .NOT. ALLOCATED (VTMP) ) ALLOCATE (VTMP (MAXJL, MAXRCR))
93 ! SET THE INITIAL VALUES FOR THE TEMPLATE
94 ! ---------------------------------------
96 ! .... Positional index of Table A mnem.
97 INV (1, LUN) = INODE (LUN)
111 ! SET UP THE PARAMETERS FOR A LEVEL OF RECURSION
112 ! ----------------------------------------------
117 IF (NR.GT.MAXRCR) GOTO 900
123 IF (N1.EQ.0) GOTO 901
124 IF (N2 - N1 + 1.GT.MAXJL) GOTO 902
126 NEWN (2, NR) = N2 - N1 + 1
128 DO N = 1, NEWN (2, NR)
129 NN = JSEQ (N + N1 - 1)
131 VTMP (N, NR) = VALI (NN)
134 ! STORE NODES AT SOME RECURSION LEVEL
135 ! -----------------------------------
137 20 DO I = NBMP (1, NR), NBMP (2, NR)
138 IF (KNX (NR) .EQ.0000) KNX (NR) = KNVN
139 IF (I.GT.NBMP (1, NR) ) NEWN (1, NR) = 1
140 DO J = NEWN (1, NR), NEWN (2, NR)
143 ! .... INV is positional index in internal jump/link table for packed
144 ! subset element KNVN in MBAY
145 INV (KNVN, LUN) = NODE
146 ! .... Actual unpacked subset values (VAL) are init. here (numbers as
148 VAL (KNVN, LUN) = VTMP (J, NR)
149 ! .... MBIT is the bit in MBAY pointing to where the packed subset
150 ! element KNVN begins
151 MBIT (KNVN) = MBIT (KNVN - 1) + NBIT (KNVN - 1)
152 ! .... NBIT is the number of bits in MBAY occupied by packed subset
154 NBIT (KNVN) = IBT (NODE)
155 IF (ITP (NODE) .EQ.1) THEN
156 CALL UPBB (MBMP, NBIT (KNVN), MBIT (KNVN), MBAY (1, LUN) )
162 NEW = KNVN - KNX (NR)
163 VAL (KNX (NR) + 1, LUN) = VAL (KNX (NR) + 1, LUN) + NEW
167 ! CONTINUE AT ONE RECURSION LEVEL BACK
168 ! ------------------------------------
170 IF (NR - 1.NE.0) THEN
175 ! FINALLY STORE THE LENGTH OF (NUMBER OF ELEMENTS IN) SUBSET TEMPLATE
176 ! -------------------------------------------------------------------
184 900 WRITE (BORT_STR, '("BUFRLIB: RCSTPL - THE NUMBER OF RECURSION '// &
185 'LEVELS EXCEEDS THE LIMIT (",I3,")")') MAXRCR
187 901 WRITE (BORT_STR, '("BUFRLIB: RCSTPL - UNSET EXPANSION SEGMENT ",A)&
190 902 WRITE (BORT_STR, '("BUFRLIB: RCSTPL - TEMPLATE ARRAY OVERFLOW, '//&
191 'EXCEEDS THE LIMIT (",I6,") (",A,")")') MAXJL, TAG (NODI)
193 END SUBROUTINE RCSTPL