c$DEBUG
C
C PROGRAM TO CONVERT HYPO71 FORMAT OR HYPOINVERSE
C TO NORDIC STANDARD FORMAT.
C  
C BY M. VILLAGRAN, NOVEMBER-91
C
C
c Updates
c dec 14 91 by jh: change to new nordic format, add more to header line
c mar 93         : fix bugs
c jun 2 93       : --------, more still
c jun 3          L: ---
c feb7 94        : used format f6.2 doe reading s, comment out CERO for weight 9
c dec 94         : ************* version 5.0 ****************  no change
c mar 1 99 by jh :---------------version 7.0 check --------------------
c                 ask for century, no 5 char stations
c
c
C character variables definition
C 
      implicit none
	  character*80 text
      CHARACTER*80 HEADERINFO
	  CHARACTER*30 INFILE
      CHARACTER*5 CERO,SECP
      character*6 secs 
      CHARACTER*4 ST,CODA 
      CHARACTER*3 AMP1,AMP
   	  CHARACTER*2 PHP,PHS,SP
      CHARACTER*1 TYPE,UDP,WTP,UDS,WTS,point     
      logical new_event,write_header
      character*2 century
C
C integer variables definition 
C
        INTEGER YR,MTH,DY,JJ,HRMN,error,icoda,new_hour,old_hour
        real xsec,xcoda



c
c print version
c
      include 'version.inc'
      out_version_date='July 23, 2001'
      if (version_new) out_version_date=version_date
      call print_ver

C
C Formats
C 100 is to read Hypo71pc phases format
C 200 is to write the headline of identification of the quake in NF
c NF means Nordic Format.
C 300 is to write P or S Phases format in NF
C
 200    FORMAT(1X,a2,I2,1X,2I2,1X,I4,1X,f4.1,1x,A1,58X)
	            
C
        error=0
        HEADERINFO(1:40)=' STAT SP IPHASW D HRMN SECON CODA AMPLIT'
c        headerinfo(41:80)=' PERI AZIMU VELO SNR AR TRES W  DIS CAZ7'
        headerinfo(41:80)=' PERI AZIMU VELO AIN AR TRES W  DIS CAZ7'

        WRITE(*,*)'  '
        WRITE(*,*)'  '
C
C open file to convert
C
        WRITE(*,*)' NAME OF HYPO71 FILE ?'
        READ(*,'(A)')INFILE
 666    continue
        write(6,*)' Give century, 19 or 20'
        read(5,'(a2)') century
        if(century.ne.'19'.and.century.ne.'20') goto 666
        OPEN(1,FILE=INFILE,ERR=80,STATUS='OLD')
C
C all quakes will be cataloged like local 
C it has to be updated
C
        TYPE='L'
C
C all phases will be considerated like Z component 
C because H71pc and Hinvpc formats don't have
C notation of that.
C
        SP='SZ'
C
C to be used in P phase if Weigth option in pc format is 9.
C
        CERO='     '
C
C JJ is the quakes counter
C
	JJ=0
C
C OPEN THE NORDIC FORMAT FILE TO CREATE
C WRITE THE HEAD INFORMATION IN OUTPUT FILE
C
        OPEN(2,FILE='hypnor.out',STATUS='unknown')
        open(3,file='hypnor.err',status='unknown')
        WRITE(*,*)'  '
        WRITE(*,*)'  '
C
C START THE PROCESS TO CONVERT FORMAT
C at first the program writes P phase
C that is because the NF uses one line for each phase
C after the program change the variable values
C to write the S phase
C
C
c
c   enter here for new event
c
 20	   continue 
            write_header=.true.
            new_event=.false.
C
C earthquakes counter
C
	    JJ=JJ+1
c
c   here for next line of one event
c
 21     continue
        read(1,'(a)',end=90) text
c
c  check if line is a new event, might by junk with blanks in front
c
        if(text(1:4).eq.'   '.and.(.not.new_event)) goto 21
c
c   set new event flag
c
c
c check that no separator missing, if so make a new event
c
        read(text(16:17),'(i2)')new_hour
        if((new_hour-old_hour).ge.1.and.(.not.write_header)) then
           backspace 1
           old_hour=new_hour
           write_header=.true.
           new_event=.true.
           write(2,*)'   '
           write(3,'(a,a)')' separator: ',text(1:40)
           error=error+1
           goto 21
        endif
        old_hour=new_hour
c
c   check if end of event, if so write blank separation line
c
    	IF(text(1:4).eq.'    ')THEN
           write(2,*)'      '
	   GOTO 20
     	ENDIF
        new_event=.true.
        READ(text,100,ERR=60)ST,PHP,UDP,WTP,YR,MTH,DY,HRMN,
     *  SECP,SECS,
     +  phs,UDS,WTS,AMP,POINT,CODA
 100    FORMAT(A4,A2,2A1,1X,3I2,I4,A5,6X,A6,A2,2A1,3X,A3,A1, 
     +  23X,A4)        
        goto 65
 60     continue
           write(3,'(a)') text
           error=error+1
           goto 21
 65     continue
c
c   check if writing a header
c
	    IF(write_header)then
           read(secp,'(f5.1)') xsec
           WRITE(2,200)century,YR,MTH,DY,HRMN,xsec,TYPE
           WRITE(6,200)century,YR,MTH,DY,HRMN,xsec,TYPE
           WRITE(2,'(a80)')HEADERINFO 
	      write_header=.false. 
        endif
C
C also check the 9 weigth option of the hp71 and hinvs programs
C
 27     continue
c       IF(WTP.EQ.'9') HRMN=CERO
C
C if the programs H71pc and Hinvpc reads coda values of "0"
C accept that like not a coda value, for that case
C in NF coda has to be blank
C
		IF(CODA.EQ.'   0') CODA='    '
C
C For an H71pc format the program will change the way of notacion
C of the arrival, up will be C and Down D
C
        IF(UDP.EQ.' ')  GOTO 30
        IF(UDP.EQ.'U')THEN
	 	  UDP='C' 
		ELSE
	      UDP='D'
		ENDIF
30      IF(UDS.EQ.' ')THEN 
	  	   GOTO 40
		ENDIF
        IF(UDS.EQ.'U')THEN
          UDS='C'
        ELSE
          UDS='D'
        ENDIF
40      AMP1='   '
C
C    Writes P in the NF file and make variable values to
C    can write S phase
C
c
c   convert coda to integer and write back if not zero
c
        read(coda,'(f4.1)') xcoda
        icoda=xcoda
        if(icoda.ne.0) write(coda,'(i4)') icoda
c
c   check if P-phase has been supplied 
c
        if(secp.ne.'     ') then
           if(php.eq.'  ') php='EP'
           WRITE(2,300)ST,SP,PHP,WTP,UDP,HRMN,SECP,CODA,AMP1
 300       FORMAT(1X,A4,1X,A2,1X,A2,3X,A1,1X,A1,1x,i4,1X,
     *     A5,1X,a4,1X,A3)
        endif
c
c   check if S-phase is there
c
        if(secs.ne.'      ') then
c
c   if no S phase is written, substitute
c
          if(phs.eq.'  ') phs='ES'
c
c   get s time, write in f5.1 to assure that values larger than
c   will be readable in nordic format
c
          read(secs,'(f6.2)') xsec
          write(secs,'(f6.1)') xsec
          WRITE(2,301)ST,SP,PHS,WTS,UDS,HRMN,SECS(2:6)
 301      FORMAT(1X,A4,1X,A2,1X,A2,3X,A1,1X,A1,1x,I4,1X,A5)
        endif
		goto 21
C
C ERRORS DISPLAY
C
80      WRITE(*,*)'  '
        WRITE(*,*)'  '
        WRITE(*,*)'  '
        WRITE(*,*)'             THAT INPUTFILE DO NOT EXISTS !'
        WRITE(*,*)'  '
        WRITE(*,*)'  '
        WRITE(*,*)'  '
        GOTO 99
C
C FINISH
C
90      IF(error.ne.0) THEN
           write(6,*) error, 'errors were found, see hypnor.err'
        endif
		WRITE(*,'(10X,I5,1X,A22)')JJ,'QUAKES WERE CHANGED !!'
        write(6,*)' Output file name is hypnor.out'
98      CLOSE(1)
99      STOP
        END
