SUBROUTINE LIES(LUN,XSTAR4,XSTAR8,KENNX4,KENNX8, F ISTAR2,ISTAR4,IRC) C C................................................................ C LESEPROGRAMM FUER DEN BEOBACHTUNGSKATALOG C TELEKI NR. "0549" TEIL "10" DES KATALOGS C................................................................ C IMPLICIT REAL*8 (A-H,O-Z) C REAL*4 XSTAR4(15) REAL*8 XSTAR8(20),epoche,dday,dmonth,dsec INTEGER*2 ISTAR2(30) INTEGER*4 ISTAR4(10),KENNX4(15),KENNX8(20),igrad,imin CHARACTER*45 STR CHARACTER*15 NAMOLD character*8 ras,npd C C KONSTANTEN FUER TRANSFORMATION VON STUNDEN BZW GRAD C INS BOGENMASS DEFINIEREN. C TRA = 2.617993877991494D-01 TRD = 1.745329251994329D-02 C IRC = 0 C C KATALOGDATEN LESEN C ------------------- C C DER STRING "STR" ENTHAELT EINEN SATZ DES BEOBACHTUNGSKATALOGS. C 100 CONTINUE xstar4(3) = 0.0 xstar4(5) = 0.0 xstar8(2) = 0.d0 xstar8(5) = 0.d0 DO I = 1,LEN(STR) STR(i:i)=' ' ENDDO c READ(LUN,'(A)',END=900) STR c c IF(STR(22:29).EQ.'21274907') STR(22:29)='21284907' c IF(STR(30:37).EQ.'12023113') STR(30:37)='12123113' c IF(STR(30:37).EQ.'12606018') STR(30:37)='12605018' C read (str(01:15),'(a15)') namold c Koordinaten: read (str(22:29),'(a8)') ras read (str(30:37),'(a8)') npd c Magnitudine: (wenn vorhanden) if (str(38:40).ne.' ') then read (str(38:40),'(bz,f3.1)') xstar4(1) kennx4(1) = 1 else xstar4(1) = -8888.0 kennx4(1) = 0 endif c Epoche der 1.Beobachtung: read (str(16:17),'(bz,f2.0)') dmonth read (str(18:19),'(bz,f2.0)') dday call kaljul (1859.d0,dmonth,dday,0.d0,0.d0,0.d0,epoche) if (str(20:20).eq.'1') then xstar4(3) = xstar4(3) + 1.0 xstar8(2) = xstar8(2) + epoche endif if (str(21:21).eq.'1') then xstar4(5) = xstar4(5) + 1.0 xstar8(5) = xstar8(5) + epoche endif c Pruefung ob weitere Beobachtungszeilen vorhanden: 10 continue read (lun,'(a)',end=220) str if (str(01:15).eq.namold) then c Bestimmung der weiteren Epochen: read (str(16:17),'(bz,f2.0)') dmonth read (str(18:19),'(bz,f2.0)') dday call kaljul (1859.d0,dmonth,dday,0.d0,0.d0,0.d0,epoche) if (str(20:20).eq.'1') then xstar4(3) = xstar4(3) + 1.0 xstar8(2) = xstar8(2) + epoche endif if (str(21:21).eq.'1') then xstar4(5) = xstar4(5) + 1.0 xstar8(5) = xstar8(5) + epoche endif goto 10 else c Ansonsten Zuruecksetzen der Katalogdatei: backspace lun endif goto 20 220 irc = 1 20 continue if (ras.eq.' ') then c print*, 'RA fehlt ',str(42:45) goto 100 endif if (npd.eq.' ') then c print*,'DEC fehlt ',str(42:45) goto 100 endif C C DEFINITION DER REAL*4 VARIABELN C ================================= C C XSTAR4(1) : = CATMAG = SCHEINBARE HELLIGKEIT IM KATALOG C c erledigt c C XSTAR4(2) : = MERASC = MITTLERER FEHLER DER REKTASZENSION LAUT KAT C XSTAR4(2) = -8888.0 KENNX4(2) = 0 C C XSTAR4(3) : = NOBRAS = ANZAHL DER BEOBACHTUNGEN IN REKTASZENSION C if (xstar4(3).eq.0.0) then xstar4(3) = -8888.0 kennx4(3) = 0 else kennx4(3) = 1 endif C C XSTAR4(4) : = MEDEC = MITTLERER FEHLER DER DEKLINATION LAUT KAT. C XSTAR4(4) = -8888.0 KENNX4(4) = 0 C C XSTAR4(5) : = NOBDEC = ANZAHL DER BEOBACHTUNGEN IN DEKLINATION C if (xstar4(5).eq.0.0) then xstar4(5) = -8888.0 kennx4(5) = 0 else kennx4(5) = 1 endif C C XSTAR4(6) : = MEPMRA = MITTLERER FEHLER DER EIGENBEWEGUNG IN RA C XSTAR4(6) = -8888.0 KENNX4(6) = 0 C C XSTAR4(7) : = NOBPMA = ANZAHL DER BEOBACHTUNGEN FUER DIE EIGENBEW. C XSTAR4(7) = -8888.0 KENNX4(7) = 0 C C XSTAR4(8) : = MEPMDC = MITTLERER FEHLER DER EIGENBEWEGUNG IN DEC C XSTAR4(8) = -8888.0 KENNX4(8) = 0 C C XSTAR4(9) : = NOBPMD = ANZAHL DER BEOBACHTUNGEN FUER DIE EIGENBEW. C XSTAR4(9) = -8888.0 KENNX4(9) = 0 C C DEFINITION DER REAL*8 VARIABELN C ================================ C C XSTAR8(1) : = EQRAS = AEQUINOX DER REKTASZENSION C XSTAR8(1) = 1859.D0 KENNX8(1) = 1 C C XSTAR8(2) : = EPRAS = EPOCHE DER REKTASZENSION C if (xstar8(2).eq.0.d0) then XSTAR8(2) = -8888.D0 KENNX8(2) = 0 else xstar8(2) = xstar8(2) / dble(xstar4(3)) kennx8(2) = 3 endif C C XSTAR8(3) : = RAS = REKTASZENSION IN RADIANS C CALL CHARAD (ras(01:08),'HHMMSSSS',XSTAR8(3),IER,6) if (str(15:15).eq.'1') then kennx8(3) = 21010 else kennx8(3) = 11010 endif if (kennx4(3).eq.0) kennx8(3) = 04910 C C XSTAR8(4) : = EQDEC = AEQUINOX DER DEKLINATION C XSTAR8(4) = xstar8(1) KENNX8(4) = kennx8(1) C C XSTAR8(5) : = EPDEC = EPOCHE DER DEKLINATION C if (xstar8(5).eq.0.d0) then XSTAR8(5) = -8888.D0 KENNX8(5) = 0 else xstar8(5) = xstar8(5) / dble(xstar4(5)) kennx8(5) = 3 endif C C XSTAR8(6) : = DEC = DEKLINATION IN RADIANS C READ (npd(01:03),'(I3)') igrad READ (npd(04:05),'(I2)') imin READ (npd(06:08),'(BZ,F3.1)') dsec CALL POLDEC (1,igrad,imin,dsec,XSTAR8(6)) if (str(15:15).eq.'1') then kennx8(6) = 21010 else kennx8(6) = 11010 endif if (kennx4(5).eq.0) kennx8(6) = 04910 C C XSTAR8(7) : = EQPMA = AEQUINOX DER EIGENBEWEGUNG IN RA C XSTAR8(7) = -8888.D0 KENNX8(7) = 0 C C XSTAR8(8) : = EPPMA = EPOCHE DER EIGENBEWEGUNG IN RA C XSTAR8(8) = -8888.D0 KENNX8(8) = 0 C C XSTAR8(9) : = PMA = EIGENBEWEGUNG IN RA WIE PUBLIZIERT C XSTAR8(9) = -8888.D0 KENNX8(9) = 0 C C XSTAR8(10) : = EQPMD = AEQUINOX DER EIGENBEWEGUNG IN DEC C XSTAR8(10) = -8888.D0 KENNX8(10) = 0 C C XSTAR8(11) : = EPPMD = EPOCHE DER EIGENBEWEGUNG IN DEC C XSTAR8(11) = -8888.D0 KENNX8(11) = 0 C C XSTAR8(12) : = PMD = EIGENBEWEGUNG IN DEC. WIE PUBLIZIERT C XSTAR8(12) = -8888.D0 KENNX8(12) = 0 C C XSTAR8(13): = EPMRAS = MITTLERE BEOBACHTUNGSEPOCHE IN c REKTASZENSION C XSTAR8(13) = XSTAR8(2) KENNX8(13) = KENNX8(2) C C XSTAR8(14): = EPMDEC = MITTLERE BEOBACHTUNGSEPOCHE IN DEKLINATION C XSTAR8(14) = XSTAR8(5) KENNX8(14) = KENNX8(5) C C DEFINITION DER INTEGER*2 VARIABELN C ==================================== C C ISTAR2(1) : = CSORT = KATALOGART C ISTAR2(1) = -3 C C ISTAR2(2) : = CAT = TELEKI-NUMMER DES KATALOGS C ISTAR2(2) = 549 C C ISTAR2(3) : = CATPV = KATALOGTEIL ODER VERSION C ISTAR2(3) = 10 C C ISTAR2(4) : = CATCA = APPENDIX ZUR KATALOGNUMMER NACH ORIGINALKAT C ISTAR2(4) = 0 if (namold(15:15).eq.'1') istar2(4) = 1 C C ISTAR2(5) : = CATDC = DOPPELSTERNKOMPONENTENBEZEICHNUNG IM C ISTAR2(5) = 0 C C ISTAR2(6) : = QUSE = BENUTZUNGSKENNZEICHEN C ISTAR2(6) = -8888 C C ISTAR2(7) : = INDVAR = VERAENDERLICHEN-KENNZEICHEN IM KATALOG C ISTAR2(7) = 0 C C ISTAR2(8) : = INDMAG = KENNZEICHEN FUER CATMAG C ISTAR2(8) = 1 C C ISTAR2(9): = SYSMAG = HELLIGKEITSSYSTEM VON CATMAG (NUMERISCH), C ISTAR2(9) = 1 if (kennx4(1).eq.0) then istar2(8) = 0 istar2(9) = 0 endif C C ISTAR2(10): = IERAS = KENNZEICHEN FUER EPOCHE UND AEQUINOX IN RA C N2 = 5 ISTAR2(10) = 100*KENNX8(1) + 10*KENNX8(2) + N2 C C ISTAR2(11): = QRAS = EIGNUNG DER REKTASZENSION FUER BENUTZUNG. C IF (kennx8(3).eq.04910) THEN ISTAR2(11) = 0 ELSE ISTAR2(11) = 1 ENDIF C C ISTAR2(12): = SYSRAS = KENNZEICHEN FUER SYSTEM VON RAS C ISTAR2(12) = 0 C C ISTAR2(13): = IEDEC = KENNZEICHEN FUER EPOCHE UND AEQUINOX IN DEC C N2 = 5 ISTAR2(13) = 100*KENNX8(4) + 10*KENNX8(5) + N2 C C ISTAR2(14): = QDEC = EIGNUNG DER DEKLINATION FUER BENUTZUNG. C IF (kennx8(6).eq.04910) THEN ISTAR2(14) = 0 ELSE ISTAR2(14) = 1 ENDIF C C ISTAR2(15): = SYSDEC = KENNZEICHEN FUER SYSTEM VON DEC C ISTAR2(15) = 0 C C ISTAR2(16): = IEPMA = KENNZEICHEN FUER EPOCHE UND AEQUINOX C N2 = 0 ISTAR2(16) = 100*KENNX8(7) + 10*KENNX8(8) + N2 C C ISTAR2(17): = QPMA = EIGNUNG DER EIGENBEW. IN RAS FUER BENUTZUNG C ISTAR2(17) = 0 C C ISTAR2(18): = SYSPMA = KENNZEICHEN FUER SYSTEM VON PMA C ISTAR2(18) = -8888 C C ISTAR2(19): = IEPMD = KENNZEICHEN FUER EPOCHE UND AEQUINOX C N2 = 0 ISTAR2(19) = 100*KENNX8(10) + 10*KENNX8(11) + N2 C C ISTAR2(20): = QPMD = EIGNUNG DER EIGENBEW. IN DEC FUER BENUTZUNG C ISTAR2(20) = 0 C C ISTAR2(21): = SYSPMD = KENNZEICHEN FUER SYSTEM VON PMD C ISTAR2(21) = -8888 C C DEFINITION DER INTEGER*4 VARIABELN C ==================================== C C ISTAR4(1) : = CATAN = NUMMER DES STERNS NACH ARI-ZAEHLUNG C ISTAR4(1) = ISTAR4(1) + 1 C C ISTAR4(2) : = CATCN = NUMMER DES STERNS IM ORIGINALKATALOG C ISTAR4(2) = ISTAR4(1) c C PRUEFEN, OB KATALOG DIFFERENZEN GIBT C N1A = KENNX8(3)/10000 N2A = KENNX8(3) - N1A*10000 N2A = N2A/1000 N1D = KENNX8(6)/10000 N2D = KENNX8(6) - N1D*10000 N2D = N2D/1000 C WRITE(6,1234) ISTAR4(1),ISTAR4(2),N2A,N2D 1234 FORMAT(1X,4I10) IF ((N2A.NE.2).AND.(N2D.NE.2)) GOTO 850 C INUM = ISTAR4(1) C C DIE NUMMER DES STERNS LESEN, WIE SIE IM REFERENZKATALOG C GEGEBEN IST. C C NRFK = NUMMER DES REFERENZKATALOGES C NRFK = -8888 C C IVERS IST ENTSPRECHEND DEM REFERENZKATALOG ZU DEFINIEREN C IVERS = -8888 C CALL REKON (IVERS,NRFK,INUM,XSTAR8,KENNX8,ISTAR2) C 850 call applycor(xstar4,kennx4,xstar8,kennx8,istar2,istar4) RETURN C C ENDE DER DATEI ERREICHT, RETURN-CODE -1 DEFINIEREN C 900 CONTINUE C IRC = -1 RETURN 990 STOP END