The programs in this section were all written by J. Brunner/CHORUS.
The following program shows the creation of the directory structure and aliases for the CHORUS geometry database.
Once the directories have been created by the server, the program can be rerun to enter the aliases.
Creating the directories and aliases for CHORUS
PROGRAM MKDIRHDB
C ----------------
C CREATES THE DIRECTORY STRUCTURE
C FOR THE GEOMETRY DATABASE OF CHORUS
C
PARAMETER (NPAW=100000,NHBOOK=0,NDX=43)
COMMON /PAWC/ PAW(NPAW)
CHARACTER*4 CHTOP
CHARACTER*80 CHFILE
CHARACTER*80 DNAME
CHARACTER*40 DITAG(NDX)
CHARACTER*4 ALIAS(NDX)
DATA ALIAS /'3021','3022','3023','3024','3061','3062','3063',
+'3041','3042','3043','3044','3051','3052','3053','3054',
+'3011','3012','3015','3016','3017','3014','3018',
+'3031','3032','3033','3034','3091',
+'3071','3072','3073','3074','3075','3076','3077','3078',
+'3081','3082','3083','3084','3085','3086','3087','3088'/
DATA DITAG /'TUBES/X-COORD',
+ 'TUBES/V-COORD',
+ 'TUBES/V-OFFSET',
+ 'TUBES/ORIENTATION',
+ 'TUBES/ANALOG-V-COORD',
+ 'TUBES/ANALOG-V-OFFSET',
+ 'TUBES/MAGNET',
+ 'BREMS/X-COORD',
+ 'BREMS/V-COORD',
+ 'BREMS/V-OFFSET',
+ 'BREMS/ORIENTATION',
+ 'DRIFT/X-COORD',
+ 'DRIFT/V-COORD',
+ 'DRIFT/V-OFFSET',
+ 'DRIFT/ORIENTATION',
+ 'CALOR/X-COORD',
+ 'CALOR/V-COORD',
+ 'CALOR/ELM-V-OFFSET',
+ 'CALOR/HA1-V-OFFSET',
+ 'CALOR/HA2-V-OFFSET',
+ 'CALOR/ORIENTATION',
+ 'CALOR/MASK',
+ 'FIBER/X-COORD',
+ 'FIBER/V-COORD',
+ 'FIBER/V-OFFSET',
+ 'FIBER/ORIENTATION',
+ 'DIAMO/X-COORD',
+ 'TRIGG/X-COORD-PLAN',
+ 'TRIGG/Y-COORD-PLAN',
+ 'TRIGG/Z-COORD-PLAN',
+ 'TRIGG/X-WIDTH-PLAN',
+ 'TRIGG/Y-WIDTH-PLAN',
+ 'TRIGG/Z-WIDTH-PLAN',
+ 'TRIGG/Z-ANGLE-PLAN',
+ 'TRIGG/POINTER-TO-BAR',
+ 'TRIGG/X-COORD-BAR',
+ 'TRIGG/Y-COORD-BAR',
+ 'TRIGG/Z-COORD-BAR',
+ 'TRIGG/X-WIDTH-BAR',
+ 'TRIGG/Y-WIDTH-BAR',
+ 'TRIGG/Z-WIDTH-BAR',
+ 'TRIGG/Z-ANGLE-BAR',
+ 'TRIGG/POINTER-TO-PLAN'/
C
C--- INITIALISATION
C
CALL CDPAW(NPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'ZPHU',IRC)
PRINT '('' IRC FROM CDPAW '',I5)',IRC
LUNCD=1
LUNFZ=2
CALL CDPREF(10,'CH',CHTOP,CHFILE,IRC)
PRINT '('' IRC FROM CDPREF '',I5)',IRC
LRECL = 0
CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
PRINT '('' IRC FROM CDOPEN '',I5)',IRC
C
C--- CREATE DIRECTORIES
C
IPREC = -8
MAX = 100
DELTA = 0.0
NKEYS = 0
DO IDX=1,NDX
DNAME = '//CDCH/GEOMETRY/'//DITAG(IDX)
*
* First run with the following call to CDMDIR
*
CALL CDMDIR(DNAME,NKEYS,' ',' ',MAX,IPREC,DELTA,' ',IRC)
PRINT '('' IRC FROM CDMDIR '',I5)',IRC
*
* Then rerun with the following call uncommented and
* the previous call to CDMDIR commented out
*
* CALL CDALIA(DNAME,ALIAS(IDX),'P',IRC)
* PRINT '('' IRC FROM CDALIA '',I5)',IRC
END DO
C
C--- TERMINATION
C
CALL CDEND(' ','A',IRC)
END
The following program shows an example of how the directories created by the previous program can be populated with vectors.
HEPDB always stores objects as Zebra banks and so the first operation is to convert the vectors into banks using the routine CDVECT. The banks can then be stored using CDSTOR.
Storing vectors in a HEPDB database
PROGRAM FILLHDB
C ----------------
C FILLS THE DIRECTORY STRUCTURE
C FOR THE GEOMETRY DATABASE OF CHORUS
C
DIMENSION KEYDBS(100)
PARAMETER (NPAW=400000,NHBOOK=0,NDX=42)
COMMON /PAWC/ PAW(NPAW)
CHARACTER*4 CHTOP
CHARACTER*80 CHFILE
CHARACTER*80 DNAME
CHARACTER*40 DITAG(NDX)
CHARACTER*4 ALIAS(NDX)
DIMENSION IPO(1300)
DATA (IPO(L),L=1,90)/
+ 13633, 13634, 13635, 13636, 13637, 13638, 13639, 13640, 0,
+ 0, 13641, 13642, 13643, 13644, 13645, 13646, 13647, 13648,
+ 13649, 13650, 13651, 13652, 13653, 13654, 13655, 13656, 13657,
+ 13658, 13659, 13660, 13661, 13662, 13663, 13664, 13665, 13666,
+ 13667, 13668, 0, 0, 13377, 13378, 13379, 13380, 13381,
+ 13382, 13383, 13384, 0, 0, 13385, 13386, 13387, 13388,
+ 13389, 13390, 13391, 13392, 13393, 13394, 13395, 13396, 13397,
+ 13398, 13399, 13400, 13401, 13402, 13403, 13404, 13405, 13406,
+ 13407, 13408, 13409, 13410, 13411, 13412, 0, 0, 13121,
+ 13122, 13123, 13124, 13125, 13126, 13127, 13128, 0, 0/
data (ipo(L),L=91,180)/
+ 13129, 13130, 13131, 13132, 13133, 13134, 13135, 13136, 13137,
+ 13138, 13139, 13140, 13141, 13142, 13143, 13144, 13145, 13146,
+ 13147, 13148, 13149, 13150, 13151, 13152, 13153, 13154, 13155,
+ 13156, 0, 0, 12865, 12866, 12867, 12868, 12869, 12870,
+ 12871, 12872, 0, 0, 12873, 12874, 12875, 12876, 12877,
+ 12878, 12879, 12880, 12881, 12882, 12883, 12884, 12885, 12886,
+ 12887, 12888, 12889, 12890, 12891, 12892, 12893, 12894, 12895,
+ 12896, 12897, 12898, 12899, 12900, 0, 0, 12609, 12610,
+ 12611, 12612, 12613, 12614, 12615, 12616, 0, 0, 12617,
+ 12618, 12619, 12620, 12621, 12622, 12623, 12624, 12625, 12626/
data (IPO(L),L=181,270)/
+ 12627, 12628, 12629, 12630, 12631, 12632, 12633, 12634, 12635,
+ 12636, 12637, 12638, 12639, 12640, 12641, 12642, 12643, 12644,
+ 0, 0, 13697, 13698, 13699, 13700, 13701, 13702, 13703,
+ 13704, 0, 0, 13705, 13706, 13707, 13708, 13709, 13710,
+ 13711, 13712, 13713, 13714, 13715, 13716, 13717, 13718, 13719,
+ 13720, 13721, 13722, 13723, 13724, 13725, 13726, 13727, 13728,
+ 13729, 13730, 13731, 13732, 0, 0, 13441, 13442, 13443,
+ 13444, 13445, 13446, 13447, 13448, 0, 0, 13449, 13450,
+ 13451, 13452, 13453, 13454, 13455, 13456, 13457, 13458, 13459,
+ 13460, 13461, 13462, 13463, 13464, 13465, 13466, 13467, 13468/
data (IPO(L),L=271,360)/
+ 13469, 13470, 13471, 13472, 13473, 13474, 13475, 13476, 0,
+ 0, 13185, 13186, 13187, 13188, 13189, 13190, 13191, 13192,
+ 0, 0, 13193, 13194, 13195, 13196, 13197, 13198, 13199,
+ 13200, 13201, 13202, 13203, 13204, 13205, 13206, 13207, 13208,
+ 13209, 13210, 13211, 13212, 13213, 13214, 13215, 13216, 13217,
+ 13218, 13219, 13220, 0, 0, 12929, 12930, 12931, 12932,
+ 12933, 12934, 12935, 12936, 0, 0, 12937, 12938, 12939,
+ 12940, 12941, 12942, 12943, 12944, 12945, 12946, 12947, 12948,
+ 12949, 12950, 12951, 12952, 12953, 12954, 12955, 12956, 12957,
+ 12958, 12959, 12960, 12961, 12962, 12963, 12964, 0, 0/
data (IPO(L),L=361,450)/
+ 12673, 12674, 12675, 12676, 12677, 12678, 12679, 12680, 0,
+ 0, 12681, 12682, 12683, 12684, 12685, 12686, 12687, 12688,
+ 12689, 12690, 12691, 12692, 12693, 12694, 12695, 12696, 12697,
+ 12698, 12699, 12700, 12701, 12702, 12703, 12704, 12705, 12706,
+ 12707, 12708, 0, 0, 9537, 9538, 9539, 9540, 9541,
+ 9542, 9543, 9544, 9545, 9546, 9547, 9548, 9549, 9550,
+ 9551, 9552, 9553, 9554, 9555, 9556, 9557, 9558, 9559,
+ 9560, 9561, 9562, 9563, 9564, 9565, 9566, 9567, 9568,
+ 9569, 9570, 9571, 9572, 9573, 9574, 9575, 9576, 9281,
+ 9282, 9283, 9284, 9285, 9286, 9287, 9288, 9289, 9290/
data (IPO(L),L=451,540)/
+ 9291, 9292, 9293, 9294, 9295, 9296, 9297, 9298, 9299,
+ 9300, 9301, 9302, 9303, 9304, 9305, 9306, 9307, 9308,
+ 9309, 9310, 9311, 9312, 9313, 9314, 9315, 9316, 9317,
+ 9318, 9319, 9320, 9025, 9026, 9027, 9028, 9029, 9030,
+ 9031, 9032, 9033, 9034, 9035, 9036, 9037, 9038, 9039,
+ 9040, 9041, 9042, 9043, 9044, 9045, 9046, 9047, 9048,
+ 9049, 9050, 9051, 9052, 9053, 9054, 9055, 9056, 9057,
+ 9058, 9059, 9060, 9061, 9062, 9063, 9064, 8769, 8770,
+ 8771, 8772, 8773, 8774, 8775, 8776, 8777, 8778, 8779,
+ 8780, 8781, 8782, 8783, 8784, 8785, 8786, 8787, 8788/
data (IPO(L),L=541,630)/
+ 8789, 8790, 8791, 8792, 8793, 8794, 8795, 8796, 8797,
+ 8798, 8799, 8800, 8801, 8802, 8803, 8804, 8805, 8806,
+ 8807, 8808, 8513, 8514, 8515, 8516, 8517, 8518, 8519,
+ 8520, 8521, 8522, 8523, 8524, 8525, 8526, 8527, 8528,
+ 8529, 8530, 8531, 8532, 8533, 8534, 8535, 8536, 8537,
+ 8538, 8539, 8540, 8541, 8542, 8543, 8544, 8545, 8546,
+ 8547, 8548, 8549, 8550, 8551, 8552, 9601, 9602, 9603,
+ 9604, 9605, 9606, 9607, 9608, 9609, 9610, 9611, 9612,
+ 9613, 9614, 9615, 9616, 9617, 9618, 9619, 9620, 9621,
+ 9622, 9623, 9624, 9625, 9626, 9627, 9628, 9629, 9630/
data (IPO(L),L=631,720)/
+ 9631, 9632, 9633, 9634, 9635, 9636, 9637, 9638, 9639,
+ 9640, 9345, 9346, 9347, 9348, 9349, 9350, 9351, 9352,
+ 9353, 9354, 9355, 9356, 9357, 9358, 9359, 9360, 9361,
+ 9362, 9363, 9364, 9365, 9366, 9367, 9368, 9369, 9370,
+ 9371, 9372, 9373, 9374, 9375, 9376, 9377, 9378, 9379,
+ 9380, 9381, 9382, 9383, 9384, 9089, 9090, 9091, 9092,
+ 9093, 9094, 9095, 9096, 9097, 9098, 9099, 9100, 9101,
+ 9102, 9103, 9104, 9105, 9106, 9107, 9108, 9109, 9110,
+ 9111, 9112, 9113, 9114, 9115, 9116, 9117, 9118, 9119,
+ 9120, 9121, 9122, 9123, 9124, 9125, 9126, 9127, 9128/
data (IPO(L),L=721,810)/
+ 8833, 8834, 8835, 8836, 8837, 8838, 8839, 8840, 8841,
+ 8842, 8843, 8844, 8845, 8846, 8847, 8848, 8849, 8850,
+ 8851, 8852, 8853, 8854, 8855, 8856, 8857, 8858, 8859,
+ 8860, 8861, 8862, 8863, 8864, 8865, 8866, 8867, 8868,
+ 8869, 8870, 8871, 8872, 8577, 8578, 8579, 8580, 8581,
+ 8582, 8583, 8584, 8585, 8586, 8587, 8588, 8589, 8590,
+ 8591, 8592, 8593, 8594, 8595, 8596, 8597, 8598, 8599,
+ 8600, 8601, 8602, 8603, 8604, 8605, 8606, 8607, 8608,
+ 8609, 8610, 8611, 8612, 8613, 8614, 8615, 8616, 5186,
+ 5187, 5188, 5189, 5190, 5191, 5192, 5193, 5194, 5195/
data (IPO(L),L=811,900)/
+ 5196, 5197, 5198, 5199, 5200, 5201, 5202, 5203, 5204,
+ 5205, 5206, 5207, 5208, 5209, 5210, 5211, 5212, 5213,
+ 5214, 5215, 5216, 5217, 5218, 5219, 5220, 5221, 5222,
+ 5223, 5224, 5225, 5226, 5227, 5228, 5229, 5230, 5231,
+ 5232, 5233, 5234, 5235, 5236, 5237, 5238, 5239, 5240,
+ 5241, 5242, 5243, 5244, 5245, 4930, 4931, 4932, 4933,
+ 4934, 4935, 4936, 4937, 4938, 4939, 4940, 4941, 4942,
+ 4943, 4944, 4945, 4946, 4947, 4948, 4949, 4950, 4951,
+ 4952, 4953, 4954, 4955, 4956, 4957, 4958, 4959, 4960,
+ 4961, 4962, 4963, 4964, 4965, 4966, 4967, 4968, 4969/
data (IPO(L),L=901,990)/
+ 4970, 4971, 4972, 4973, 4974, 4975, 4976, 4977, 4978,
+ 4979, 4980, 4981, 4982, 4983, 4984, 4985, 4986, 4987,
+ 4988, 4989, 4674, 4675, 4676, 4677, 4678, 4679, 4680,
+ 4681, 4682, 4683, 4684, 4685, 4686, 4687, 4688, 4689,
+ 4690, 4691, 4692, 4693, 4694, 4695, 4696, 4697, 4698,
+ 4699, 4700, 4701, 4702, 4703, 4704, 4705, 4706, 4707,
+ 4708, 4709, 4710, 4711, 4712, 4713, 4714, 4715, 4716,
+ 4717, 4718, 4719, 4720, 4721, 4722, 4723, 4724, 4725,
+ 4726, 4727, 4728, 4729, 4730, 4731, 4732, 4733, 4418,
+ 4419, 4420, 4421, 4422, 4423, 4424, 4425, 4426, 4427/
data (IPO(L),L=991,1080)/
+ 4468, 4469, 4470, 4471, 4472, 4473, 4474, 4475, 4476,
+ 4477, 5250, 5251, 5252, 5253, 5254, 5255, 5256, 5257,
+ 5258, 5259, 5260, 5261, 5262, 5263, 5264, 5265, 5266,
+ 5267, 5268, 5269, 5270, 5271, 5272, 5273, 5274, 5275,
+ 5276, 5277, 5278, 5279, 5280, 5281, 5282, 5283, 5284,
+ 5285, 5286, 5287, 5288, 5289, 5290, 5291, 5292, 5293,
+ 5294, 5295, 5296, 5297, 5298, 5299, 5300, 5301, 5302,
+ 5303, 5304, 5305, 5306, 5307, 5308, 5309, 4994, 4995,
+ 4996, 4997, 4998, 4999, 5000, 5001, 5002, 5003, 5004,
+ 5005, 5006, 5007, 5008, 5009, 5010, 5011, 5012, 5013/
data (IPO(L),L=1081,1170)/
+ 5014, 5015, 5016, 5017, 5018, 5019, 5020, 5021, 5022,
+ 5023, 5024, 5025, 5026, 5027, 5028, 5029, 5030, 5031,
+ 5032, 5033, 5034, 5035, 5036, 5037, 5038, 5039, 5040,
+ 5041, 5042, 5043, 5044, 5045, 5046, 5047, 5048, 5049,
+ 5050, 5051, 5052, 5053, 4738, 4739, 4740, 4741, 4742,
+ 4743, 4744, 4745, 4746, 4747, 4748, 4749, 4750, 4751,
+ 4752, 4753, 4754, 4755, 4756, 4757, 4758, 4759, 4760,
+ 4761, 4762, 4763, 4764, 4765, 4766, 4767, 4768, 4769,
+ 4770, 4771, 4772, 4773, 4774, 4775, 4776, 4777, 4778,
+ 4779, 4780, 4781, 4782, 4783, 4784, 4785, 4786, 4787/
data (IPO(L),L=1171,1260)/
+ 4788, 4789, 4790, 4791, 4792, 4793, 4794, 4795, 4796,
+ 4797, 4482, 4483, 4484, 4485, 4486, 4487, 4488, 4489,
+ 4490, 4491, 4532, 4533, 4534, 4535, 4536, 4537, 4538,
+ 4539, 4540, 4541, 4428, 4429, 4430, 4431, 4432, 4433,
+ 4434, 4435, 4436, 4437, 4438, 4439, 4440, 4441, 4442,
+ 4443, 4444, 4445, 4446, 4447, 4448, 4449, 4450, 4451,
+ 4452, 4453, 4454, 4455, 4456, 4457, 4458, 4459, 4460,
+ 4461, 4462, 4463, 4464, 4465, 4466, 4467, 4492, 4493,
+ 4494, 4495, 4496, 4497, 4498, 4499, 4500, 4501, 4502,
+ 4503, 4504, 4505, 4506, 4507, 4508, 4509, 4510, 4511/
data (IPO(L),L=1261,1300)/
+ 4512, 4513, 4514, 4515, 4516, 4517, 4518, 4519, 4520,
+ 4521, 4522, 4523, 4524, 4525, 4526, 4527, 4528, 4529,
+ 4530, 4531, 4417, 4673, 4929, 5185, 4478, 4737, 4990,
+ 5249, 0, 0, 4481, 4734, 4993, 5246, 4542, 4798,
+ 5054, 5310, 0, 0/
DATA ALIAS /'3021','3022','3023','3024','3061','3062',
+'3041','3042','3043','3044','3051','3052','3053','3054',
+'3011','3012','3015','3016','3017','3014','3018',
+'3031','3032','3033','3034','3091',
+'3071','3072','3073','3074','3075','3076','3077','3078',
+'3081','3082','3083','3084','3085','3086','3087','3088'/
DATA DITAG /'TUBES/X-COORD',
+ 'TUBES/V-COORD',
+ 'TUBES/V-OFFSET',
+ 'TUBES/ORIENTATION',
+ 'TUBES/ANALOG-V-COORD',
+ 'TUBES/ANALOG-V-OFFSET',
+ 'BREMS/X-COORD',
+ 'BREMS/V-COORD',
+ 'BREMS/V-OFFSET',
+ 'BREMS/ORIENTATION',
+ 'DRIFT/X-COORD',
+ 'DRIFT/V-COORD',
+ 'DRIFT/V-OFFSET',
+ 'DRIFT/ORIENTATION',
+ 'CALOR/X-COORD',
+ 'CALOR/V-COORD',
+ 'CALOR/ELM-V-OFFSET',
+ 'CALOR/HA1-V-OFFSET',
+ 'CALOR/HA2-V-OFFSET',
+ 'CALOR/ORIENTATION',
+ 'CALOR/MASK',
+ 'FIBER/X-COORD',
+ 'FIBER/V-COORD',
+ 'FIBER/V-OFFSET',
+ 'FIBER/ORIENTATION',
+ 'DIAMO/X-COORD',
+ 'TRIGG/X-COORD-PLAN',
+ 'TRIGG/Y-COORD-PLAN',
+ 'TRIGG/Z-COORD-PLAN',
+ 'TRIGG/X-WIDTH-PLAN',
+ 'TRIGG/Y-WIDTH-PLAN',
+ 'TRIGG/Z-WIDTH-PLAN',
+ 'TRIGG/Z-ANGLE-PLAN',
+ 'TRIGG/POINTER-TO-BAR',
+ 'TRIGG/X-COORD-BAR',
+ 'TRIGG/Y-COORD-BAR',
+ 'TRIGG/Z-COORD-BAR',
+ 'TRIGG/X-WIDTH-BAR',
+ 'TRIGG/Y-WIDTH-BAR',
+ 'TRIGG/Z-WIDTH-BAR',
+ 'TRIGG/Z-ANGLE-BAR',
+ 'TRIGG/POINTER-TO-PLAN'/
C
C--- INITIALISATION
C
CALL CDPAW(NPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'ZPHU',IRC)
PRINT '('' IRC FROM CDPAW '',I5)',IRC
LUNCD=1
LUNFZ=2
CALL CDPREF(10,'CH',CHTOP,CHFILE,IRC)
PRINT '('' IRC FROM CDPREF '',I5)',IRC
LRECL = 0
CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
PRINT '('' IRC FROM CDOPEN '',I5)',IRC
C
C--- STORE VECTORS
C
DO IDX=1,NDX
DNAME = '//CDCH/GEOMETRY/'//DITAG(IDX)
NDAT = 1300
CALL CDVECT(' ',IPO,NDAT,JADDR,'PI',IRC)
PRINT '('' IRC FROM CDVECT '',I5)',IRC
KEYDBS(11) = 1
KEYDBS(12) = 999999
IDIV = 0
CALL CDSTOR(DNAME(1:26),JADDR,LDUMI,IDIV,KEYDBS,' ',IRC)
PRINT '('' IRC FROM CDSTOR '',I5)',IRC
END DO
C
C--- TERMINATION
C
CALL CDEND(' ','A',IRC)
END
The following example shows how objects may be copied from one database to another. The directory structures in the two databases is different in this case.
Copying objects from one database to another
PROGRAM COPYHDB
C ----------------
C FILLS THE DIRECTORY STRUCTURE
C FOR THE GEOMETRY DATABASE OF CHORUS
C
DIMENSION KEYDBS(100),KEY(5),JP(5)
DATA KEY /3023,3062,3043,3053,3071/
DATA JP / 3, 6, 10, 14, 7/
PARAMETER (NWPAW=400000,NHBOOK=0,NDX=43)
COMMON/PAWC/NWP,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(NWPAW)
DIMENSION IQ(2),Q(2),LQ(8000)
EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
CHARACTER*7 CHPAT1
DATA CHPAT1 /'//CDC2/'/
CHARACTER*4 CHTOP
CHARACTER*80 CHFILE,CHPATH
CHARACTER*80 DNAME
CHARACTER*40 DITAG(NDX)
CHARACTER*4 ALIAS(NDX)
DATA ALIAS /'3021','3022','3023','3024','3061','3062','3063',
+'3041','3042','3043','3044','3051','3052','3053','3054',
+'3011','3012','3015','3016','3017','3014','3018',
+'3031','3032','3033','3034','3091',
+'3071','3072','3073','3074','3075','3076','3077','3078',
+'3081','3082','3083','3084','3085','3086','3087','3088'/
DATA DITAG /'TUBES/X-COORD',
+ 'TUBES/V-COORD',
+ 'TUBES/V-OFFSET',
+ 'TUBES/ORIENTATION',
+ 'TUBES/ANALOG-V-COORD',
+ 'TUBES/ANALOG-V-OFFSET',
+ 'TUBES/MAGNET',
+ 'BREMS/X-COORD',
+ 'BREMS/V-COORD',
+ 'BREMS/V-OFFSET',
+ 'BREMS/ORIENTATION',
+ 'DRIFT/X-COORD',
+ 'DRIFT/V-COORD',
+ 'DRIFT/V-OFFSET',
+ 'DRIFT/ORIENTATION',
+ 'CALOR/X-COORD',
+ 'CALOR/V-COORD',
+ 'CALOR/ELM-V-OFFSET',
+ 'CALOR/HA1-V-OFFSET',
+ 'CALOR/HA2-V-OFFSET',
+ 'CALOR/ORIENTATION',
+ 'CALOR/MASK',
+ 'FIBER/X-COORD',
+ 'FIBER/V-COORD',
+ 'FIBER/V-OFFSET',
+ 'FIBER/ORIENTATION',
+ 'DIAMO/X-COORD',
+ 'TRIGG/X-COORD-PLAN',
+ 'TRIGG/Y-COORD-PLAN',
+ 'TRIGG/Z-COORD-PLAN',
+ 'TRIGG/X-WIDTH-PLAN',
+ 'TRIGG/Y-WIDTH-PLAN',
+ 'TRIGG/Z-WIDTH-PLAN',
+ 'TRIGG/Z-ANGLE-PLAN',
+ 'TRIGG/POINTER-TO-BAR',
+ 'TRIGG/X-COORD-BAR',
+ 'TRIGG/Y-COORD-BAR',
+ 'TRIGG/Z-COORD-BAR',
+ 'TRIGG/X-WIDTH-BAR',
+ 'TRIGG/Y-WIDTH-BAR',
+ 'TRIGG/Z-WIDTH-BAR',
+ 'TRIGG/Z-ANGLE-BAR',
+ 'TRIGG/POINTER-TO-PLAN'/
C
C--- INITIALISATION, OPEN 2 DATABASE FILES
C
CALL CDPAW(NWPAW,NHBOOK,IDIV,'USR-DIV',5000,50000,'ZPHU',IRC)
PRINT '('' IRC FROM CDPAW '',I5)',IRC
LUNCD=1
LUNFZ=2
CALL CDPREF(10,'CH',CHTOP,CHFILE,IRC)
PRINT '('' IRC FROM CDPREF1 '',I5)',IRC
LRECL = 0
CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
PRINT '('' IRC FROM CDOPEN1 '',I5)',IRC
*
LUNCD=3
LUNFZ=4
CALL CDPREF(10,'C2',CHTOP,CHFILE,IRC)
PRINT '('' IRC FROM CDPREF2 '',I5)',IRC
LRECL = 0
CALL CDOPEN(LUNCD,LUNFZ,CHTOP,CHFILE,LRECL,IDIV,' ',IRC)
PRINT '('' IRC FROM CDOPEN2 '',I5)',IRC
C
C--- COPY OBJECTS
C
C DO IDX=1,NDX
DO J=1,5
WRITE(CHPATH,'(A7,I4)') CHPAT1,KEY(J)
DNAME = '//CDCH/GEOMETRY/'//DITAG(JP(J))
NRUN = 1
CALL CDUSE(CHPATH,JKEY,NRUN,'N',IRC)
JADDR = LQ(JKEY-1)
PRINT '(A30)',CHPATH
PRINT '(I8)',JADDR
PRINT '('' IRC FROM CDUSE '',I5)',IRC
KEYDBS(11) = 1
KEYDBS(12) = 999999
CALL CDSTOR(DNAME,JADDR,LDUMI,IDIV,KEYDBS,' ',IRC)
PRINT '('' IRC FROM CDSTOR '',I5)',IRC
END DO
C
C--- TERMINATION
C
CALL CDEND(' ','A',IRC)
END