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
|
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 INTPNUM(KONOFF)
C
C---->
C**** INTPNUM
C
C Purpose
C -------
C
C Returns current INTP_CYCLE version number.
C
C
C Interface
C ---------
C
C INUM = INTPNUM(KONOFF)
C
C Input
C -----
C
C KONOFF - switch for displayed message
C = 0 if display is required on the first call
C = non-zero if display is not required
C
C
C Output
C ------
C
C Returns a 6-digit version number, aaabbc, where:
C aaa = 3-digit major number
C bb = 2-digit minor number
C c = 1-digit spare number (normally 0)
C
C
C Method
C ------
C
C Reads a 6-digit version number from the environment variable
C INTP_CYCLE. If this does not give a 6-digit number, an internal
C hard-coded default value is used.
C
C On the first call, the function (optionally) displays a message:
C
C **************************************
C * INTP_CYCLE version number = aaabbc *
C **************************************
C
C
C Externals
C ---------
C
C None.
C
C
C Author
C ------
C
C J.D.Chambers ECMWF May 1998
C
C
C----<
C ------------------------------------------------------------------
C* Section 0. Variables.
C ------------------------------------------------------------------
C
C
IMPLICIT NONE
C
#include "grprs.h"
C
C Function arguments
C
INTEGER KONOFF
C
C Local variables
C
INTEGER INUMBER, ICOUNT, IOFFSET
SAVE INUMBER, ICOUNT
CHARACTER*38 CMESS
CHARACTER*20 YNUMBER
C
DATA INUMBER/000010/, ICOUNT/0/
DATA CMESS/'* INTP_CYCLE version number = ****** *'/
C
C ------------------------------------------------------------------
C* Section 1. Initialise
C ------------------------------------------------------------------
C
100 CONTINUE
C
IF( ICOUNT.EQ.0 ) THEN
C
C See if the environment variable has an override value
C
CALL GETENV( 'INTP_CYCLE', YNUMBER)
IOFFSET = INDEX( YNUMBER, ' ')
IF( IOFFSET.EQ.7 ) THEN
READ(YNUMBER,'(I6.6)') INUMBER
ENDIF
C
C First time through, display the message if required
C
IF( KONOFF.EQ.0 ) THEN
WRITE(CMESS(31:36),'(I6.6)') INUMBER
WRITE(GRPRSM,*) '**************************************'
WRITE(GRPRSM,*) CMESS
WRITE(GRPRSM,*) '**************************************'
ENDIF
ICOUNT = 1
ENDIF
C
INTPNUM = INUMBER
C
RETURN
END
|
