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