REDDAT.inc
References to this file elsewhere.
1 SUBROUTINE REDDAT
2 I(NFL ,
3 O IDATE , KT ,
4 O LEVEL , ELEM , TITLE , UNIT , KTSD , KTSA ,
5 O DATA , IRTN ,
6 I IDIM , JDIM , KMAX ,
7 W BASE , AMP ,IDA )
8 C
9 INTEGER IDATE(5)
10 CHARACTER* 4 LEVEL, ELEM
11 CHARACTER*32 TITLE
12 CHARACTER*16 UNIT
13 INTEGER KTSD, KTSA
14 DIMENSION DATA(IDIM*JDIM)
15 c INTEGER*2 IDA(IDIM*JDIM) !shc-rizvi
16 INTEGER IDA(IDIM*JDIM/2) !shc-rizvi
17 C
18 INTEGER IDNEXT(5)
19 C
20 READ (NFL,END=999,ERR=999) IDATE, KT, NELM, LEVEL, ELEM
21 IF( NELM.GT.1 ) THEN
22 WRITE(96,*) 'REDDAT:NELM.GT.1'
23 WRITE(96,*) 'REDDAT:NELM=', NELM
24 STOP 999
25 ELSE IF( NELM.EQ.0 ) THEN
26 C ---------------------------------------------------------------
27 C >>> DD 連結対応のつもり <<<
28 C ---------------------------------------------------------------
29 READ(NFL,END=998,ERR=998)
30 1 NNSP, IDNEXT, NNSP, NNSP, NNSP, NNSP, NNSP, NNSP,
31 2 NNSP, NNSP, NNSP, NNSP, NNSP
32 IF(IDATE(1).NE.IDNEXT(1).OR.IDATE(2).NE.IDNEXT(2)
33 1 .OR.IDATE(3).NE.IDNEXT(3).OR.IDATE(4).NE.IDNEXT(4)) THEN
34 WRITE(96,*) '## INVALID DD CONNECTION'
35 WRITE(96,*) IDATE
36 WRITE(96,*) IDNEXT
37 GOTO 998
38 ENDIF
39 WRITE(96,*) '## VALID DD CONNECTION'
40 READ(NFL)
41 READ(NFL)
42 READ(NFL)
43 READ(NFL)
44 READ(NFL)
45 DO 10 I=1,NNSP
46 READ(NFL)
47 10 CONTINUE
48 READ (NFL,END=999,ERR=999) IDATE, KT, NELM, LEVEL, ELEM
49 ENDIF
50 C
51 1 READ (NFL,END=999,ERR=999)
52 1 LEVEL, ELEM, TITLE, UNIT,
53 2 KTSD, KTSA, BASE, AMP,
54 3 (IDA(I),I=1,IDIM*JDIM)
55 CALL CI2R4V(DATA,BASE,AMP,IDA,IDIM*JDIM)
56 CC DO 10 I=1,IDIM*JDIM
57 CC DATA(I)=BASE + AMP*IDA(I)
58 CC 10 CONTINUE
59 C
60 IRTN=0
61 RETURN
62 C
63 998 IRTN=-1
64 RETURN
65 C
66 999 WRITE(96,*) 'REDDAT: READ ERROR IN FILE',NFL
67 STOP 999
68 C
69 END SUBROUTINE REDDAT
70