|
mat253.convert.f
Fortran program which includes
mat253.unmix.f
plus the specific A or B line conversion values to VPDB.
C PROGRAM mat_convert
C
C
C This program converts raw isotopic data from the MAT253 into
C enrichments with resepct to PDB
C
C The program accommodates a-b line differences and crossover
C mixing within the source using the patterns observed during the
C series 2 and 3 data. (Spec nos. 1493 to 3423)
C
C Last updated for the addition of dmix, 1 December 1997, see line 77
C
C
CHARACTER*40 inFile, outFile
CHARACTER*1 exp, cline
CHARACTER*3 hole
CHARACTER*56 cid
CHARACTER*24 cdate
CHARACTER*8 p
C
C
C
C open input file...
C
TYPE *, 'Enter name of input file :'
ACCEPT 1010, inFile
1010 FORMAT(A40)
C
OPEN(UNIT=10, FILE=inFile, FORM='FORMATTED',
+ STATUS='OLD')
C
C open output file........
C
TYPE 1000
1000 format(1x)
TYPE 1000
TYPE *,'Enter output filename'
ACCEPT 1010, outFile
C
OPEN(UNIT=11,FILE=outFile, STATUS='NEW')
C
C
C Read input data
1 READ(10,1001,end=20)cdate,ispec,cid,c13,cpm,xo18,xopm,sa,sv,
+t,p,exp,cline,hole,old_num
C
1001 FORMAT(A24,I7,A56,F7.3,3F10.3,2F6.2,F5.1,A8,A1,1x,A1,A3,I8)
C
C For spec numbers LE 8231
C Use this section when we had A and B line differences otherwise
C Skip to line 77
C
IF(ispec .GT. 8231) GOTO 77
C
C Correct for a-b line differences
C
C
C
IF(cline .EQ. 'A' .AND. exp .EQ. 'N') THEN
C
C Constants for the transformation
C
C O18
A1 = .0145
B1 = -.1458
C1 = .4078
C C13
A2 = .0011
B2 = -.0190
C2 = .0786
C
C
C
c13 = c13 + (A2*(sa)**2+B2*(sa)+C2)
xo18 = xo18 + (A1*(sa)**2+B1*(sa)+C1)
END IF
C
C
C Correct for crossover mixing
C
C
C We have always assumed that the data >5 volts has no offset
C In evaluating atlantisII, we found a .2 per mil offset between our data
C and the other labs. We now believe we have -.0394 offset in data
C >5 volts and are now correcting for it. For spec numbers 29455-36649 we noticed
C a A and B line offset which was different for the two lines. Althought not
C really a mixing problem but a capillary problem, we correct for it similiarly.
C DRO November 1997
C
77 IF(ispec.GE.1 .AND. ispec.LE.29454 )THEN
dmix = -.0394
END IF
C
IF(ispec.GE.29455 .AND. ispec.LE.36649 .AND.cline.EQ.'A')THEN
dmix = -.0073
END IF
C
IF(ispec.GE.29455 .AND. ispec.LE.36649 .AND.cline.EQ.'B')THEN
dmix = -.0223
END IF
C
IF(ispec.GE.36650 .AND. ispec.LE.45605 )THEN
dmix = -.0394
END IF
C
IF(ispec.GE.45606 .AND. ispec.LE.49433 )THEN
dmix = -.028
END IF
C
IF(ispec.GE.49434 .AND. ispec.LE.51708 )THEN
dmix = -.008
END IF
C
IF(ispec.GE.51709 .AND. ispec.LE.55738 )THEN
dmix = -.015
END IF
C
IF(ispec.GE. 55739 )THEN
dmix = -.020
END IF
C
c13 = c13/((.008*sv)-.041+dmix+1.0)
xo18 = xo18/((.008*sv)-.041+dmix+1.0)
C
C
C Correct for enrichment of ref gas with respect to PDB
C
C
C A Line
C
C
IF(ispec.LE.1011 .AND. cline.EQ.'A')THEN
refc = 0.729
refo = 2.477
END IF
C
IF(ispec.GE.1012 .AND. ispec.LE.1308 .AND. cline.EQ.'A')THEN
refc = 0.730
refo = 2.504
END IF
C
IF(ispec.GE.1309 .AND. ispec.LE.1812 .AND. cline.EQ.'A')THEN
refc = 0.720
refo = 2.376
END IF
C
IF(ispec.GE.1813 .AND. ispec.LE.2232 .AND. cline.EQ.'A')THEN
refc = 0.698
refo = 2.337
END IF
C
IF(ispec.GE.2233 .AND. ispec.LE.4823 .AND. cline.EQ.'A')THEN
refc = 0.724
refo = 2.388
END IF
C
IF(ispec.GE.4824 .AND. ispec.LE.5231 .AND. cline.EQ.'A')THEN
refc = 0.737
refo = 2.517
END IF
C
IF(ispec.GE.5232 .AND. ispec.LE.6289 .AND. cline.EQ.'A')THEN
refc = 0.726
refo = 2.353
END IF
C
IF(ispec.GE.6290 .AND. ispec.LE.7295 .AND. cline.EQ.'A')THEN
refc = 0.713
refo = 2.365
END IF
C
IF(ispec.GE.7296 .AND. ispec.LE.7452 .AND. cline.EQ.'A')THEN
refc = 0.766
refo = 2.569
END IF
C
IF(ispec.GE.7453 .AND. ispec.LE.7593 .AND. cline.EQ.'A')THEN
refc = 0.763
refo = 2.459
END IF
C
IF(ispec.GE.7594 .AND. ispec.LE.7829 .AND. cline.EQ.'A')THEN
refc = 0.739
refo = 2.310
END IF
C
IF(ispec.GE.7830 .AND. ispec.LE.8231 .AND. cline.EQ.'A')THEN
refc = 0.762
refo = 2.212
END IF
C
IF(ispec.GE.8232 .AND. ispec.LE.8354 .AND. cline.EQ.'A')THEN
refc = 0.792
refo = 2.475
END IF
C
IF(ispec.GE.8355 .AND. ispec .LE.11704 .AND. cline.EQ.'A')THEN
refc = 0.777
refo = 2.492
END IF
C
C
IF(ispec.GE.11705 .AND. ispec.LE.14190 .AND. cline.EQ.'A')THEN
refc = 0.782
refo = 2.511
END IF
C
C
IF(ispec.GE.14191 .AND. ispec.LE.16194 .AND. cline.EQ.'A')THEN
C end WHOI1 ref gas
refc = 0.788
refo = 2.493
END IF
C
C
IF(ispec.GE.16195 .AND. ispec.LE.19637 .AND. cline.EQ.'A')THEN
C begin WHOI2 ref gas
C A & B capillaries balanced 17oct94
C 3oct94->21oct94
refc = 0.625
refo = 1.981
END IF
C
C
IF(ispec.GE.19638 .AND. ispec.LE.24715 .AND. cline.EQ.'A')THEN
C 22oct94->25oct94
C new bellows & baked source 2feb95 at sepc # 19367
C Retuned source 20980-23262
C New Bellows from Scientific Instruments
refc = 0.624
refo = 2.051
END IF
C
C
IF(ispec.GE.24716 .AND. ispec.LE.28285 .AND. cline.EQ.'A')THEN
C corrected all LN2 traps for efficient trapping
C Ended block because changed bellows
C 7sep95->13jan96
refc = 0.648
refo = 2.082
END IF
C
IF(ispec.GE.28340 .AND. ispec.LE.29454 .AND. cline.EQ.'A')THEN
C end filament #1
C removed data from std17jan96, 27mar96 DRO
C 15jan96->25feb96
refc = 0.640
refo = 2.104
END IF
C
C
IF(ispec.GE.29455 .AND. ispec.LE.29631 .AND. cline.EQ.'A')THEN
C Begin filament #2
C WHOI2 reference gas end
C 25feb96->2mar96
refc = 0.691
refo = 2.013
END IF
C
C
IF(ispec.GE.29632 .AND. ispec.LE.31474 .AND. cline.EQ.'A')THEN
C Begin WHOI3 ref gas
C 2mar96->1may96
refc = 0.695
refo = 2.775
END IF
C
C
IF(ispec.GE.31475 .AND. ispec.LE.33347 .AND. cline.EQ.'A')THEN
C New Bellows old block - 31985->34794
C 1may96->25jul96
C RESET database numbers to zero after spec #33138
refc = 0.709
refo = 2.713
END IF
C
C
IF(ispec.GE.33348 .AND. ispec.LE.36648 .AND. cline.EQ.'A')THEN
C New metalflex bellows old block - 34795->36648
C 29jul96->25oct96
C 5oct96 = balanced capillaries
C "A" line O18 offset of 0.086
C Calculated correction was 2.803 therefor, 0.086 was subtracted
refc = 0.695
refo = 2.807
END IF
C
C
IF(ispec.GE.36649 .AND. ispec.LE.37638 .AND. cline.EQ.'A')THEN
C New Metalflex bellows, source & caps baked & balanced
C all traps adjusted, new connectors
C 25oct96->16dec96
C End WHOI3 ref gas
refc = 0.678
refo = 2.860
END IF
C
IF(ispec.GE.37639 .AND. ispec.LE.45605 .AND. cline.EQ.'A')THEN
C Finnigan bellows
C 16dec96->3sep97
C WHOI4 ref gas begin
C end Filament #2
refc = 0.783
refo = 2.398
END IF
C
C
IF(ispec.GE.45606 .AND. ispec.LE.49318 .AND. cline.EQ.'A')THEN
C 4sep97-13feb98
C Begin Filament #3
C UPS failure and overall bad statistics in block
C Repeated 430 error & trapping problems
refc = 0.775
refo = 2.427
END IF
C
C baked everything including source & rebalanced caps
C NOTE!!!!!! testing WHOI5 ref gas ONLY between 49319 -> 49433
C all data moved to separate file "whoi5.data"
C
C
IF(ispec.GE.49434 .AND. ispec.LE.51708 .AND. cline.EQ.'A')THEN
C Fixed and adjusted all traps
C End WHOI4
refc = 0.743
refo = 2.338
END IF
C
C
IF(ispec.GE.51709 .AND. ispec.LE.55738 .AND. cline.EQ.'A')THEN
C Begin WHOI6
refc = 0.700
refo = 1.295
END IF
C
C
IF(ispec.GE.55739 .AND. ispec.LE.63219 .AND. cline.EQ.'A')THEN
C New A line Capillary; baked and recrimped all
C New Bellows, retuned, new V180, adjusted traps
C End WHOI6 ref gas
refc = 0.693
refo = 1.306
END IF
C
IF(ispec.GE.63220 .AND. cline.EQ.'A')THEN
C Begin WHOI7 ref gas, New A & B line Acid valves
C June 1999
refc = 0.350
refo = 2.802
END IF
C
C BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
C B Line
C
C
IF(ispec.LE.1011 .AND. cline.EQ.'B')THEN
refc = 0.712
refo = 2.456
END IF
C
IF(ispec.GE.1012 .AND. ispec.LE.1308 .AND. cline.EQ.'B')THEN
refc = 0.692
refo = 2.391
END IF
C
IF(ispec.GE.1309 .AND. ispec.LE.1812 .AND. cline.EQ.'B')THEN
refc = 0.710
refo = 2.334
END IF
C
IF(ispec.GE.1813 .AND. ispec.LE.2232 .AND. cline.EQ.'B')THEN
refc = 0.703
refo = 2.390
END IF
C
IF(ispec.GE.2233 .AND. ispec.LE.4823 .AND. cline.EQ.'B')THEN
refc = 0.716
refo = 2.369
END IF
C
IF(ispec.GE.4824 .AND. ispec.LE.5231 .AND. cline.EQ.'B')THEN
refc = 0.751
refo = 2.514
END IF
C
IF(ispec.GE.5232 .AND. ispec.LE.6289 .AND. cline.EQ.'B')THEN
refc = 0.726
refo = 2.323
END IF
C
IF(ispec.GE.6290 .AND. ispec.LE.7295 .AND. cline.EQ.'B')THEN
refc = 0.727
refo = 2.342
END IF
C
IF(ispec.GE.7296 .AND. ispec.LE.7452 .AND. cline.EQ.'B')THEN
refc = 0.728
refo = 2.563
END IF
C
IF(ispec.GE.7453 .AND. ispec.LE.7593 .AND. cline.EQ.'B')THEN
refc = 0.761
refo = 2.494
END IF
C
IF(ispec.GE.7594 .AND. ispec.LE.7829 .AND. cline.EQ.'B')THEN
refc = 0.743
refo = 2.402
END IF
C
IF(ispec.GE.7830 .AND. ispec.LE.8231 .AND. cline.EQ.'B')THEN
refc = 0.742
refo = 2.335
END IF
C
IF(ispec.GE.8232 .AND. ispec.LE.8354 .AND. cline.EQ.'B')THEN
refc = 0.783
refo = 2.389
END IF
C
IF(ispec.GE.8355 .AND. ispec.LE.11704 .AND. cline.EQ.'B')THEN
refc = 0.744
refo = 2.400
END IF
C
IF(ispec.GE.11705 .AND. ispec.LE.14190 .AND. cline.EQ.'B')THEN
refc = 0.744
refo = 2.389
END IF
C
IF(ispec.GE.14191 .AND. ispec.LE.16194 .AND. cline.EQ.'B')THEN
refc = 0.748
refo = 2.380
END IF
C
IF(ispec.GE.16195 .AND. isec.LE.19637 .AND. cline.EQ.'B')THEN
refc = 0.620
refo = 2.011
END IF
C
IF(ispec.GE.19638 .AND. isec.LE.24715 .AND. cline.EQ.'B')THEN
refc = 0.604
refo = 2.008
END IF
C
IF(ispec.GE.24716 .AND. ispec.LE.28285 .AND. cline.EQ.'B')THEN
refc = 0.606
refo = 1.974
END IF
C
IF(ispec.GE.28340 .AND. ispec.LE.29454 .AND. cline.EQ.'B')THEN
refc = 0.612
refo = 2.036
END IF
C
IF(ispec.GE.29455 .AND. ispec.LE.29631 .AND. cline.EQ.'B')THEN
refc = 0.635
refo = 1.972
END IF
C
IF(ispec.GE.29632 .AND. ispec.LE.31474 .AND. cline.EQ.'B')THEN
refc = 0.637
refo = 2.753
END IF
C
IF(ispec.GE.31475 .AND. ispec.LE.33347 .AND. cline.EQ.'B')THEN
refc = 0.659
refo = 2.690
END IF
C
IF(ispec.GE.33348 .AND. ispec.LE.36648 .AND. cline.EQ.'B')THEN
refc = 0.631
refo = 2.712
END IF
C
IF(ispec.GE.36649 .AND. ispec.LE.37638 .AND. cline.EQ.'B')THEN
refc = 0.677
refo = 2.791
END IF
C
IF(ispec.GE.37639 .AND. ispec.LE.45605 .AND. cline.EQ.'B')THEN
refc = 0.762
refo = 2.425
END IF
C
IF(ispec.GE.45606 .AND. ispec.LE.49318 .AND. cline.EQ.'B')THEN
refc = 0.748
refo = 2.404
END IF
C
IF(ispec.GE.49434 .AND. ispec.LE.51708 .AND. cline.EQ.'B')THEN
refc = 0.764
refo = 2.390
END IF
C
IF(ispec.GE.51709 .AND. ispec.LE.55738 .AND. cline.EQ.'B')THEN
refc = 0.696
refo = 1.271
END IF
C
IF(ispec.GE.55739 .AND. ispec.LE.63219 .AND. cline.EQ.'B')THEN
refc = 0.689
refo = 1.280
END IF
C
IF(ispec.GE.63220 .AND. cline.EQ.'B')THEN
refc = 0.340
refo = 2.787
END IF
C
C
C OTHER CORRECTIONS WHICH ARE MADE AFTER PDB CONVERSION
C
C
C
c13 = c13 + refc
xo18 = xo18 + refo
C
C Section to correct for the proportional differences in oxygen isotopic
C composition after the second filament was installed. The further
C away from NBS19, the larger the correction so we changed the slope
C no longer used as of 26 November 1996 and the new relationship is below
C
C IF(ispec.GE.29455)THEN
C xo18 = xo18 + (-2.20-xo18) * 0.0258
C ENDIF
C
C November 27, 1996 DRO, to correct numbers on either side of NBS19
C so that they have the correct isotopic composition
C and NBS19 always has the value of -2.20 PDB
C
C IF(ispec.GE.29455)THEN
C IF(xo18.GT.-2.20)THEN
C xo18 = -2.20 - (-2.20-xo18) * 0.98
C ENDIF
C
C IF(xo18.LT.-2.20)THEN
C xo18 = -2.20 - (-2.20-xo18) * 1.02
C ENDIF
C ENDIF
C
1002 FORMAT(A24,I7,A56,F7.3,3F8.3,2F6.2,F5.1,A8,A1,1x,A1,A3,I8)
C
WRITE(11,1002)cdate,ispec,cid,
+c13,cpm,xo18,xopm,sa,sv,t,p,exp,
+cline,hole,old_num
GO TO 1
C
20 close(10)
close(11)
C
C
STOP
END
|