blob: 2fcac1d13ce2d94e0e37fae068ef4d71653be5f5 (
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
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
|
*DECK LIBA21
SUBROUTINE LIBA21(TYPSEG,RETCAR)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Description of the archive segments used in the APOLIB-2 file
* used as external subroutine by subroutine AEXTRT.
*
*Copyright:
* Copyright (C) 2002 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version
*
*Author(s): A. Hebert
*
*Parameters: input
* TYPSEG type of segment.
*
*Parameters: output
* RETCAR encoded generic character type of segment.
*
*-----------------------------------------------------------------------
*
CHARACTER*(*) TYPSEG
CHARACTER*(*) RETCAR
*
IF (TYPSEG .EQ. 'APOLIB') THEN
RETCAR = 'LIIIIIIIIIII'
*
ELSEIF (TYPSEG .EQ. 'PCOM') THEN
RETCAR = 'C1C1'
*
ELSEIF (TYPSEG .EQ. 'PCONST') THEN
RETCAR = 'I1I1I1I1I1I1R1'
*
ELSEIF (TYPSEG .EQ. 'PFIX') THEN
RETCAR = 'IIILLLIIIRRI1I1I1L1R1R1R1C1C1'
*
ELSEIF (TYPSEG .EQ. 'PFLUXC') THEN
RETCAR = 'R1'
*
ELSEIF (TYPSEG .EQ. 'PHEAD ') THEN
RETCAR = 'CC1C1R1'
*
ELSEIF (TYPSEG .EQ. 'PMAIL ') THEN
RETCAR = 'RIR1R1I1I1'
*
ELSEIF (TYPSEG .EQ. 'PNUMF') THEN
RETCAR = 'C1C1R3'
*
ELSEIF (TYPSEG .EQ. 'PPPSN') THEN
RETCAR = 'IIIIIII1I1I1'
*
ELSEIF (TYPSEG .EQ. 'PPSN') THEN
RETCAR = 'R1'
*
ELSEIF (TYPSEG .EQ. 'PSECT') THEN
RETCAR = 'R1'
*
ELSEIF (TYPSEG .EQ. 'PTHOM1') THEN
RETCAR = 'RCI1I1I1I2I2R1R1R1R1'
*
ELSEIF (TYPSEG .EQ. 'PTHOM2') THEN
RETCAR = 'R3R3R3'
*
ELSEIF (TYPSEG .EQ. 'PTHOM3') THEN
RETCAR = 'R1R1R1R1'
*
ELSEIF (TYPSEG .EQ. 'PTHOM4') THEN
RETCAR = 'R1R1R1R1R1R1R1R1R1R1R1'
*
ELSEIF (TYPSEG .EQ. 'PTHOM5') THEN
RETCAR = 'R1R1R1'
*
ELSEIF (TYPSEG .EQ. 'QFIX') THEN
RETCAR = 'I1'
*
ELSEIF (TYPSEG .EQ. 'QFIXS') THEN
RETCAR = 'I1'
*
ELSEIF (TYPSEG .EQ. 'QFLUXC') THEN
RETCAR = 'I1'
ELSE
RETCAR = ' '
ENDIF
*
RETURN
END
|
