blob: 345b3f19eb2044e4f024bc767be16b22170d51a1 (
plain)
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
|
*DECK XDRSDB
SUBROUTINE XDRSDB(NBELEM,RVECT,DBVECT,KDIR)
C
C--------------------------- XDRSDB ---------------------------------
C
C 1- PROGRAMME STATISTICS:
C
C NAME : XDRSDB
C FUNCTION : DOUBLE PRECISION TO/FROM SIMPLE PRECISION
C DATE : 20-02-1987
C AUTHOR : G.MARLEAU
C
C 2- INPUT AND OUTPUT PARAMETERS:
C
C NBELEM : NUMBER OF WORDS TO TRANSLATE
C RVECT : SIMPLE PRECISION VECTOR - RVECT(NBELEM)
C DBVECT : DOUBLE PRECISION VECTOR - DBRVECT(NBELEM)
C KDIR : DIRECTION OF TRANSLATION
C : KDIR = 1 FROM DOUBLE TO SIMPLE PRECISION
C : KDIR = 2 FROM SIMPLE TO DOUBLE PRECISION
C
C--------------------------- XDRSDB --------------------------------
C
CHARACTER CERROR*4
INTEGER NBELEM,KDIR
REAL RVECT(*)
DOUBLE PRECISION DBVECT(*)
IF(KDIR.EQ.1) THEN
C------
C FROM DOUBLE TO SIMPLE PRECISION
C------
DO 100 IELEM=1,NBELEM
RVECT(IELEM)=REAL(DBVECT(IELEM))
100 CONTINUE
ELSE IF(KDIR.EQ.2) THEN
C------
C FROM SIMPLE TO DOUBLE PRECISION
C------
DO 200 IELEM=NBELEM,1,-1
DBVECT(IELEM)=DBLE(RVECT(IELEM))
200 CONTINUE
ELSE
C------
C INVALID VALUE FOR KDIR
C------
WRITE(CERROR,'(I4)') KDIR
CALL XABORT('XDRSDB: ONLY KDIR=1 AND KDIR=2 ALLOWED; KDIR='
> //CERROR//' FOUND')
ENDIF
RETURN
END
|
