1      SUBROUTINE XNAM23(IOP)
2C
3C***  SUBROUTINE TO READ OR WRITE NAMELIST EXPR
4C
5      COMMON /IBODY/  AHA(141)
6      COMMON /IWING/  AHB(141)
7      COMMON /IHT/    AHC(141)
8      COMMON /IBW/    AHD(141)
9      COMMON /IVT/    AHE(2)
10      COMMON /IDWASH/ AHF(61)
11      COMMON /EXPER/  AHG(116)
12      COMMON /SBETA/  STB(135),TRA(108),TRAH(108)
13      COMMON /CONSNT/ PI,DEG,UNUSED,RAD,KAND
14C
15      INTEGER EXPR
16      LOGICAL EOF
17C
18      DIMENSION LENH(32),LDMH(32),EXPR(131),LOCH(32),AH(469)
19      DIMENSION NLNAME(4)
20C
21C***  NAMELIST EXPR
22C
23      DATA NLNAME / 4HE   ,4HX   ,4HP   ,4HR   /
24      DATA LENH / 3*3,4,4,3*3,4,4,3*3,5*4,5,5,6,6,5,3,5*5,4,5,4 /
25      DATA LDMH / 23*20,9*1 /
26      DATA LOCH / 1,21,41,61,81,101,121,141,161,181,201,221,241,
27     1            261,281,301,321,341,361,381,401,421,441,461,
28     2            462,463,464,465,466,467,468,469 /
29      DATA EXPR /     4HC   ,4HD   ,4HB   ,4HC   ,4HL   ,4HB   ,
30     1  4HC   ,4HM   ,4HB   ,4HC   ,4HL   ,4HA   ,4HB   ,4HC   ,
31     2  4HM   ,4HA   ,4HB   ,4HC   ,4HD   ,4HW   ,4HC   ,4HL   ,
32     3  4HW   ,4HC   ,4HM   ,4HW   ,4HC   ,4HL   ,4HA   ,4HW   ,
33     4  4HC   ,4HM   ,4HA   ,4HW   ,4HC   ,4HD   ,4HH   ,4HC   ,
34     5  4HL   ,4HH   ,4HC   ,4HM   ,4HH   ,4HC   ,4HL   ,4HA   ,
35     6  4HH   ,4HC   ,4HM   ,4HA   ,4HH   ,4HC   ,4HD   ,4HW   ,
36     7  4HB   ,4HC   ,4HL   ,4HW   ,4HB   ,4HC   ,4HM   ,4HW   ,
37     8  4HB   ,4HC   ,4HL   ,4HA   ,4HW   ,4HB   ,4HC   ,4HM   ,
38     9  4HA   ,4HW   ,4HB   ,4HQ   ,4HO   ,4HQ   ,4HI   ,4HN   ,
39     A  4HF   ,4HE   ,4HP   ,4HS   ,4HL   ,4HO   ,4HN   ,4HD   ,
40     B  4HE   ,4HO   ,4HD   ,4HA   ,4HC   ,4HD   ,4HV   ,4HA   ,
41     C  4HL   ,4HP   ,4HO   ,4HW   ,4HA   ,4HL   ,4HP   ,4HL   ,
42     D  4HW   ,4HA   ,4HL   ,4HP   ,4HO   ,4HH   ,4HA   ,4HL   ,
43     E  4HP   ,4HL   ,4HH   ,4HA   ,4HC   ,4HL   ,4HM   ,4HW   ,
44     F  4HC   ,4HL   ,4HM   ,4HW   ,4HA   ,4HC   ,4HL   ,4HM   ,
45     G  4HH   ,4HC   ,4HL   ,4HM   ,4HH   /
46C
47C**   LOOP TO FILL WORKING ARRAY
48C     J PARAMETER IS TO PUT CLA AND CMA FROM COMMON INTO CORRECT POSITIO
49C     IN THE WORKING ARRAY (SEE INSERT TO USERS MANUAL MARK UP COPY FOR
50C     EXPLANATION OF IOM COMMON BLOCKS WHEN USING EXPERIMENTAL SUBSTIUTI
51C
52      J=1
53      DO 1000 I=1,100
54         J=J+1
55         AH(I)=AHA(J)
56         AH(I+100)=AHB(J)
57         AH(I+200)=AHC(J)
58         AH(I+300)=AHD(J)
59         IF(I .EQ. 60)J=101
60 1000 CONTINUE
61      DO 1010 I=1,60
62         AH(I+400)=AHF(I+1)
63 1010 CONTINUE
64      AH(461)=AHE(2)
65      DO 1020 I=1,4
66         AH(I+461)=AHG(I+112)
67 1020 CONTINUE
68      AH(466)=TRA(37)
69      AH(467)=TRA(38)
70      AH(468)=TRAH(37)
71      AH(469)=TRAH(38)
72C
73C***  IF IOP EQUAL 0 READ NAMELIST EXPR, IF IOP EQUAL 1 WRITE EXPR
74C
75      IF(IOP .EQ. 0)
76     1 CALL NAMER(KAND,10,NLNAME,4,EXPR,131,LENH,32,LDMH,AH,469,
77     2            LOCH,EOF)
78      IF(IOP .EQ. 1)
79     1 CALL NAMEW(KAND,6,NLNAME,4,EXPR,131,LENH,32,LDMH,AH,469,LOCH)
80C
81C***  REPLACE DATA READ INTO APPROPRIATE COMMON BLOCKS
82C
83      J=1
84      DO 1030 I=1,100
85         J=J+1
86         AHA(J)=AH(I)
87         AHB(J)=AH(I+100)
88         AHC(J)=AH(I+200)
89         AHD(J)=AH(I+300)
90         IF(I .EQ. 60)J=101
91 1030 CONTINUE
92      DO 1040 I=1,60
93         AHF(I+1)=AH(I+400)
94 1040 CONTINUE
95      AHE(2)=AH(461)
96      DO 1050 I=1,4
97         AHG(I+112)=AH(I+461)
98 1050 CONTINUE
99      TRA(37)=AH(466)
100      TRA(38)=AH(467)
101      TRAH(37)=AH(468)
102      TRAH(38)=AH(469)
103C
104      RETURN
105      END
106