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
|
C Copyright (c) 2003-2010 University of Florida
C
C This program is free software; you can redistribute it and/or modify
C it under the terms of the GNU General Public License as published by
C the Free Software Foundation; either version 2 of the License, or
C (at your option) any later version.
C This program is distributed in the hope that it will be useful,
C but WITHOUT ANY WARRANTY; without even the implied warranty of
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
C GNU General Public License for more details.
C The GNU General Public License is included in this distribution
C in the file COPYRIGHT.
subroutine igetrec(iFlag,szArchive,szRecName,iRecLen,iDest)
c-----------------------------------------------------------------------------
c Reads integer data from JOBARC file.
c
c Note: The data on JOBARC is stored as integer*8 for compatibility with
c the serial ACES II program's format. So this subroutine converts
c the data read from JOBARC into the internal integer format and
c returns it in iDest.
c
c iflag > 0 --> an existing record is retrieved, length stored in iRecLen.
c = 0 --> record length is returned (or -1 if record doesn't exist).
c < 0 --> existing record is retrieved or iDest(1:iRecLen) is cleared.
c-----------------------------------------------------------------------------
implicit none
integer iFlag, iRecLen, iDest(*)
character*(*) szArchive, szRecName
#include "jobarc.h"
integer i
c-----------------------------------------------------------------------------
c Call getrec to get the raw data.
c-----------------------------------------------------------------------------
if (iFlag .eq. 0) then
call getrec(iFlag,szArchive,szRecName,iRecLen,iDest)
else
call igetrec_work(iFlag,szArchive,szRecName,iRecLen,iDest)
endif
return
end
subroutine igetrec_work(iFlag,szArchive,szRecName,iRecLen,iDest)
c-----------------------------------------------------------------------------
c Reads integer data from JOBARC file.
c
c Note: The data on JOBARC is stored as integer*8 for compatibility with
c the serial ACES II program's format. So this subroutine converts
c the data read from JOBARC into the internal integer format and
c returns it in iDest.
c
c iflag > 0 --> an existing record is retrieved, length stored in iRecLen.
c < 0 --> existing record is retrieved or iDest(1:iRecLen) is cleared.
c-----------------------------------------------------------------------------
implicit none
integer iFlag, iRecLen, iDest(*)
character*(*) szArchive, szRecName
#include "jobarc.h"
integer*8 idest8(iRecLen)
integer i
c-----------------------------------------------------------------------------
c Call getrec to get the raw data.
c-----------------------------------------------------------------------------
call getrec(iFlag,szArchive,szRecName,iRecLen,iDest8)
c-----------------------------------------------------------------------------
c Convert the data.
c-----------------------------------------------------------------------------
do i = 1, iRecLen
iDest(i) = iDest8(i)
enddo
return
end
|
