program rewritewithdepthcorrectionhistories

c  NOTE: this is a skeleton program and requires you to add your own data
c     input and output routines.

	implicit none 

        integer i
	integer numnonxbs2,numnonxbs1
	
	character*20 dummy
	character*4 fixplat(100)
	character*5 otherinsts(100)


	common /otherplats /fixplat,otherinsts,numnonxbs1,numnonxbs2


	open (unit=66,file='../non-xbtplatforms.txt',
	1    status='old')
	do i=1,3
	   read(66,'(a20)')dummy
	enddo
	i=0
	do while(1.eq.1)
	   i=i+1
	   read(66,'(a20)')dummy
	   read(dummy,'(4x,a5)')otherinsts(i)
	   print *,'otherinsts=',otherinsts(i),i
	   if(dummy(1:2).eq.'cc')goto 66
	enddo
 66	continue
	numnonxbs1=i-1
	do i=1,3
	   read(66,'(a20)')dummy
	enddo
	i=0
	do while(1.eq.1)
	   i=i+1
	   read(66,'(a20)')dummy
	   read(dummy,'(5x,a4)')fixplat(i)
	   print *,'fixplat=',fixplat(i),i,dummy
	   if(dummy(1:2).eq.'cc')goto 766
	enddo
 766	continue
	numnonxbs2=i-1


	do i=1,no_of_obs

	call readdata(i)

        call depthcorrection(i)

 	call writedata(i)

57	continue

	enddo

	stop
	end

c
c -------------------------------------------------------------------

c c  c  c  c  c  cc cc cc c cc


	subroutine depthcorrection(obsnumber)

c  NOTE:  this is also a skeleton version of the code - you must add the 
c     variable declarations and communication from the reading routines
c      before compiling this code...

	implicit none


	integer no_obs,pqual,indunit,rawunit,obsnumber
        integer ios,numsegs,hiseq
	integer hseq,nseq,indep
	integer m,i,j,iend,ist,k,bindep,l,nh
	integer mim,mmm,mm,n,ddy,yy,mom,kk,nk
	integer numnonxbs2,numnonxbs1
	
	real dd,depqc,depreal,maxd

	character*4 fixplat(100)
	character*5 otherinsts(100)

	logical goodbuddy,nonxbt

	common /otherplats /fixplat,otherinsts,numnonxbs1,numnonxbs2

	save

	nonxbt=.false.

	if(data_type.ne.'XB'.and.data_type.ne.'BA')then
	   return
	endif


	do i=1,Nsurfc
	   if(SRFC_Code(i).eq.'PLAT')then
	      do j=1,numnonxbs2
		 if(SRFC_Parm(i)(1:4).eq.fixplat(j)(1:4))then
		    nonxbt=.true.
		 endif
	      enddo
	   endif
	   if(SRFC_Code(i).eq.'PFR$')then
	      do j=1,numnonxbs1
		 if(SRFC_Parm(i)(1:5).eq.otherinsts(j)(1:5))then
		    nonxbt=.true.
		 endif
	      enddo
	   endif
	enddo


	call fdate(fa)
	Up_Date(1:4)=fa(21:24)
        Up_Date(7:8)=fa(9:10)
	call idate(mom,ddy,yy)

	write (Up_Date(5:6),'(i2.2)')mom
	do i=1,8
	   if(Up_Date(i:i).eq.' ')Up_Date(i:i)='0'
	enddo
c
c first, catch those that are misidentified as PEQ$=1 when are really t-10's
	
	do i=1,Nsurfc
	   if(SRFC_Code(i).eq.'PEQ$')then
	      if(index(SRFC_Parm(i)(1:3),'1  ').ne.0)then
		 do k=1,Nsurfc
		    if(SRFC_Code(k).eq.'PRT$')then
		       if(index(SRFC_Parm(k),'T-10').ne.0)then
			  print *,'key1 at peq error=',key1
			  SRFC_Parm(i)(1:3)='61 '
			  goto 999
		       endif
		    endif
		 enddo
	      endif
	   endif
	enddo
	do i=1,Nsurfc
	   if(SRFC_Code(i).eq.'PEQ$'.and. 
	1	SRFC_Parm(i)(1:3).eq.'999')then
	      goto 887
	   endif
	enddo

c  now depth correct those that still need it...

        if(nonxbt)return

        do i=1,Nsurfc
           if(SRFC_Code(i).eq.'PEQ$')then
              if(index(SRFC_Parm(i)(1:3),'001').ne.0 .or. 
     &             (index(SRFC_Parm(i)(1:3),'041').ne.0) .or.
     &             (index(SRFC_Parm(i)(1:3),'031').ne.0) .or.
     &             (index(SRFC_Parm(i)(1:3),'051').ne.0) .or.
     &             (index(SRFC_Parm(i)(1:3),'1  ').ne.0) .or.
     &             (index(SRFC_Parm(i)(1:3),'221').ne.0) .or.
     &             (index(SRFC_Parm(i)(1:3),'31 ').ne.0) .or.
     &             (index(SRFC_Parm(i)(1:3),'41 ').ne.0) .or.
     &             (index(SRFC_Parm(i)(1:3),'461').ne.0) .or.
     &             (index(SRFC_Parm(i)(1:3),'51 ').ne.0) .or.
     &             (index(SRFC_Parm(i)(1:3),'01 ').ne.0))then
                 do j=1,nos_seg
                    do k=1,no_depths(j)
                       Depth_Press(j,k)=Depth_Press(j,k)*1.0336
                    enddo
                    read(Deep_Depth(j),'(f5.1)',iostat=ios)dd
		    if(ios.ne.0)then	
		       dd=Depth_Press(nos_seg,no_depths(nos_seg))
		       goto 111

		       endif
		    endif
                    dd=dd*1.0336
 111		    if(dd.gt.1000.)then
                       write(Deep_Depth(j),'(f5.0)')dd
                    else
                       write(Deep_Depth(j),'(f5.1)')dd
                    endif
                 enddo

c  NOTE:  Remember to depth correct the history depths - change this to
c    reflect your own Ident_Code...

                 do j=1,num_hists
		    if(Ident_Code(j).eq.'CS')then
		       read(Aux_ID(j),'(f8.1)')dd
		       dd=dd*1.0336
		       write(Aux_ID(j),'(f8.1)')dd
		    endif
		 enddo
		 num_hists=num_hists+1
		 Act_Code(num_hists)='DP'
		 Ident_Code(num_hists)= 'CS'
		 PRC_Code(num_hists)='CSCB' 
		 Version(num_hists)='1.0'
		 PRC_Date(num_hists)=up_date
		 Act_Parm(num_hists)='DEPH'
		 Aux_ID(num_hists)='0.0000    '
		 Previous_Val(num_hists)='999.999 '

		 do kk=3,1,-1
		    if(SRFC_Parm(i)(kk:kk).eq.'1')then
		       SRFC_Parm(i)(kk:kk)='2'
		       goto 444
		    endif
		 enddo
 444		 continue
		 SRFC_Code(Nsurfc+1)='DPC$'
		 SRFC_Parm(Nsurfc+1)='04        '
		 SRFC_Q_Parm(Nsurfc+1)='2'
		 Nsurfc=Nsurfc+1		 
		 SRFC_Code(Nsurfc+1)='FRA$'
		 SRFC_Parm(Nsurfc+1)='1.0336    '
		 SRFC_Q_Parm(Nsurfc+1)=' '
		 Nsurfc=Nsurfc+1

		 goto 999

              endif
           elseif(SRFC_Code(i).eq.'PFR$')then
              if(index(SRFC_Parm(i)(1:3),'001').ne.0 .or. 
     &             (index(SRFC_Parm(i)(1:3),'041').ne.0) .or.
     &             (index(SRFC_Parm(i)(1:3),'031').ne.0) .or.
     &             (index(SRFC_Parm(i)(1:3),'051').ne.0) .or.
     &      	   (index(SRFC_Parm(i)(1:3),'201').ne.0) .or.
     &      	   (index(SRFC_Parm(i)(1:3),'211').ne.0) .or.
     &      	   (index(SRFC_Parm(i)(1:3),'221').ne.0) .or.
     &      	   (index(SRFC_Parm(i)(1:3),'251').ne.0) .or.
     &   	   (index(SRFC_Parm(i)(1:3),'461').ne.0))then

c need correction..,

                 do j=1,nos_seg
                    do k=1,no_depths(j)
                       Depth_Press(j,k)=Depth_Press(j,k)*1.0336
                    enddo
                    read(Deep_Depth(j),'(f5.1)')dd
                    dd=dd*1.0336
                    if(dd.gt.1000.)then
                       write(Deep_Depth(j),'(f5.0)')dd
                    else
                       write(Deep_Depth(j),'(f5.1)')dd
                    endif
                 enddo
                 do j=1,num_hists
		    if(Ident_Code(j).eq.'CS')then
		       read(Aux_ID(j),'(f8.1)')dd
		       dd=dd*1.0336
		       write(Aux_ID(j),'(f8.1)')dd
		    endif
                 enddo
		 num_hists=num_hists+1
		 Act_Code(num_hists)='DP'
		 Ident_Code(num_hists)= 'CS'
		 PRC_Code(num_hists)='CSCB' 
		 Version(num_hists)='1.0'
		 PRC_Date(num_hists)=up_date
		 Act_Parm(num_hists)='DEPH'
		 Aux_ID(num_hists)='0.0000    '
		 Previous_Val(num_hists)='999.999 '

                 SRFC_Parm(i)(3:3)='2'
		 SRFC_Code(Nsurfc+1)='DPC$'
		 SRFC_Parm(Nsurfc+1)='04        '
		 SRFC_Q_Parm(Nsurfc+1)='2'
		 Nsurfc=Nsurfc+1
		 SRFC_Code(Nsurfc+1)='FRA$'
		 SRFC_Parm(Nsurfc+1)='1.0336    '
		 SRFC_Q_Parm(Nsurfc+1)=' '
		 Nsurfc=Nsurfc+1
		 
              endif
	      if(index(SRFC_Parm(i)(1:3),'///').eq.0
	1		.and. SRFC_Parm(i)(1:5).ne. '00000')then
		 goto 999
	      endif
           endif
	enddo


c  those were the ones where you knew the fall rate and probe type
c  now we look at the ones where you only know the probe type...

	do k=1,Nsurfc
           if(SRFC_Code(k).eq.'PRT$')then
	      if(index(SRFC_Parm(k),'-07').ne.0 .or.
	1	   index(SRFC_Parm(k),'-04').ne.0 .or.
	2	   index(SRFC_Parm(k),'-06').ne.0 .or.
	3	   index(SRFC_Parm(k),'DB').ne.0)then

                 do j=1,nos_seg
                    do kk=1,no_depths(j)
                       Depth_Press(j,kk)=Depth_Press(j,kk)*1.0336
                    enddo
                    read(Deep_Depth(j),'(f5.1)')dd
                    dd=dd*1.0336
                    if(dd.gt.1000.)then
                       write(Deep_Depth(j),'(f5.0)')dd
                    else
                       write(Deep_Depth(j),'(f5.1)')dd
                    endif
                 enddo
                 do j=1,num_hists
		    if(Ident_Code(j).eq.'CS')then
		       read(Aux_ID(j),'(f8.1)')dd
		       dd=dd*1.0336
		       write(Aux_ID(j),'(f8.1)')dd
		    endif
                 enddo
		 num_hists=num_hists+1
		 Act_Code(num_hists)='DP'
		 Ident_Code(num_hists)= 'CS'
		 PRC_Code(num_hists)='CSCB' 
		 Version(num_hists)='1.0'
		 PRC_Date(num_hists)=up_date
		 Act_Parm(num_hists)='DEPH'
		 Aux_ID(num_hists)='0.0000    '
		 Previous_Val(num_hists)='999.999 '

		 SRFC_Code(Nsurfc+1)='DPC$'
		 SRFC_Parm(Nsurfc+1)='04        '
		 SRFC_Q_Parm(Nsurfc+1)='2'
		 Nsurfc=Nsurfc+1		 
		 SRFC_Code(Nsurfc+1)='FRA$'
		 SRFC_Parm(Nsurfc+1)='1.0336    '
		 SRFC_Q_Parm(Nsurfc+1)=' '
		 Nsurfc=Nsurfc+1
		 goto 999
	      else
		 goto 999
              endif
           endif
        enddo

333     continue

c  now do the ones you GUESS should be done....

 887	maxd=0.
	do j=1,nos_seg
	   maxd=max(maxd,Depth_Press(j,no_depths(j)))
	enddo

	if(maxd.le.950.)then
	   
	   do j=1,nos_seg
	      do kk=1,no_depths(j)
		 Depth_Press(j,kk)=Depth_Press(j,kk)*1.0336
	      enddo
	      read(Deep_Depth(j),'(f5.1)')dd
	      dd=dd*1.0336
	      if(dd.gt.1000.)then
		 write(Deep_Depth(j),'(f5.0)')dd
	      else
		 write(Deep_Depth(j),'(f5.1)')dd
	      endif
	   enddo
	   do j=1,num_hists
	      if(Ident_Code(j).eq.'CS')then
		 read(Aux_ID(j),'(f8.1)')dd
		 dd=dd*1.0336
		 write(Aux_ID(j),'(f8.1)')dd
	      endif
	   enddo
	   num_hists=num_hists+1
	   Act_Code(num_hists)='DP'
	   Ident_Code(num_hists)= 'CS'
	   PRC_Code(num_hists)='CSCB' 
	   Version(num_hists)='1.0'
	   PRC_Date(num_hists)=up_date
	   Act_Parm(num_hists)='DEPH'
	   Aux_ID(num_hists)='0.0000    '
	   Previous_Val(num_hists)='999.999 '
	   
	   SRFC_Code(Nsurfc+1)='DPC$'
	   SRFC_Parm(Nsurfc+1)='05        '
	   SRFC_Q_Parm(Nsurfc+1)='2'
	   Nsurfc=Nsurfc+1		 
	   SRFC_Code(Nsurfc+1)='FRA$'
	   SRFC_Parm(Nsurfc+1)='1.0336    '
	   SRFC_Q_Parm(Nsurfc+1)=' '
	   Nsurfc=Nsurfc+1
	   goto 999

	endif


 999	continue

	return
	end