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