1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
C Copyright 1981-2007 ECMWF
C
C Licensed under the GNU Lesser General Public License which
C incorporates the terms and conditions of version 3 of the GNU
C General Public License.
C See LICENSE and gpl-3.0.txt for details.
C
INTEGER FUNCTION INTFC( INGRIB,INLEN,FLDIN,OUTGRIB,OUTLEN,FLDOUT)
C
C---->
C**** INTFC
C
C Purpose
C -------
C
C Move input field to output field.
C
C
C Interface
C ---------
C
C IRET = INTFC( INGRIB,INLEN,FLDIN,OUTGRIB,OUTLEN,FLDOUT)
C
C Input
C -----
C
C INGRIB - Input field (packed).
C INLEN - Input field length (words).
C FLDIN - Input field (unpacked).
C
C
C Output
C ------
C
C OUTGRIB - Output field (packed).
C OUTLEN - Output field length (words).
C FLDOUT - Output field (unpacked).
C
C
C Method
C ------
C
C Move data (packed or unpacked) without special processing.
C
C
C Externals
C ---------
C
C None.
C
C
C Author
C ------
C
C J.D.Chambers ECMWF Jan 1995
C
C----<
C
IMPLICIT NONE
C
C Function arguments
INTEGER INGRIB(*),OUTGRIB(*),INLEN,OUTLEN
REAL FLDIN(*),FLDOUT(*)
C
#include "parim.h"
#include "nifld.common"
#include "nofld.common"
#include "grfixed.h"
C
C Parameters
INTEGER JPROUTINE
PARAMETER (JPROUTINE = 26700 )
C
C Local variables
C
INTEGER LOOP
C
C ------------------------------------------------------------------
C* Section 1. Initialise
C ------------------------------------------------------------------
C
100 CONTINUE
INTFC = 0
C
C ------------------------------------------------------------------
C* Section 2. Move data from input to output.
C ------------------------------------------------------------------
C
200 CONTINUE
C
C If input is a GRIB product
If (NIFORM .EQ. 1) THEN
C
C Move packed values to user array
DO 210 LOOP = 1, INLEN
OUTGRIB( LOOP ) = INGRIB( LOOP )
210 CONTINUE
C
ELSE
C
C Otherwise, move unpacked values to user array
DO 220 LOOP = 1, INLEN
FLDOUT( LOOP ) = FLDIN( LOOP )
220 CONTINUE
C
ENDIF
C
C Return the number of values, the unpacked array length
OUTLEN = INLEN
C
C ------------------------------------------------------------------
C* Section 9. Closedown.
C ------------------------------------------------------------------
C
900 CONTINUE
C
C Clear change flags for next product processing
LCHANGE = .FALSE.
LSMCHNG = .FALSE.
C
RETURN
END
|
