PROGRAM MAIN PARAMETER ( NSTAR = 612627) c C Katlenmax ist die Groesse der Felder, in denen nachher Doppel- C identifizierungen aufgeloest werden. Offensichtlich darf der C Katalog nicht mehr Sterne enthalten c PARAMETER ( KATLENMAX = 3000000 ) INTEGER NINDEX(3000000),IDMAX c C ERZEUGT EINE PLATTENDATEI IN DER NUR DIE FUER DIE IDENTIFIZIERUNG C WICHTIGEN DATEN ABGESPEICHERT WERDEN. c CHARACTER ST(34)*72,DATNAM*7,DATNAM1*8,DATNAM2*3 CHARACTER DATNAM3*6,DATNAM4*6,BUFFER(100)*34 REAL*8 XST8(20),XINDEX(3000000),XMTX(3,3) REAL*8 SXINDEX(KATLENMAX) REAL*4 XST4(15) INTEGER CATAN,I,IST4(10),RC,KX4(15),KX8(20),POS1,POS2 INTEGER OLDNUM INTEGER*2 IST2(30) INTEGER SNINDEX(KATLENMAX) integer headlen integer ier ccc character*39 mastername ! Her ccc character*41 mastername ! Crux2 ccc character*40 mastername ! Tuc5 character*72 mastername ! mod. am 17.2.05 LOGICAL EX,DONE COMMON /nrun/ nrun COMMON /idrun/ idrun COMMON /MATRIX/ XMTX COMMON /YEAR/ EPO COMMON /MSTAR/ NINDEX,NCOUNT COMMON /RUN/ DATNAM2 COMMON /headlen/ headlen common /mastername/ mastername DATA CATAN /0/ C C evtl. Korrekturen lesen c loadcors('korrektur',ier) call loadcor('korrektur',ier) if (ier.lt.0) then print *,'**** Fehler bei Laden der Korrekturdatei' stop end if headlen = 11 mastername='../../data/master.2' ccc ccc ccc idrun = 1 do i=1,nstar xindex(i) = -8888.d0 end do RC = 0 DONE=.FALSE. CALL READALL(ST) CALL SEEK(ST(19),17,POS1,POS2) DATNAM2 = 'id1' !ST(19)(POS1:POS2) DATNAM = 'katalog' !DATNAM2(1:8) ccc ccc CALL FILEOP(1,DATNAM,'F',EX) ccc ccc DATNAM1 = DATNAM//'T' CALL FILEOPDA(2,DATNAM1,'U',320,EX) ccc ccc print *,'Wandeln von ',DATNAM,' nach ',DATNAM1 CALL DATA(EX) ccc ccc 1 CALL LIES(1,XST4,XST8,KX4,KX8,IST2,IST4,RC) ccc ccc c c stop c c C print*,ist4(1) c PRINT*,rc c WRITE(*,'(1X,A,I8,F10.3)')'MAIN',IST4(2),XST8(6) C------------------------------------------------------ IF (RC .NE. 0) GOTO 2 CATAN= CATAN + 1 IST4(1)=CATAN c C STORING OF DELTA AND THE RUNNING NUMBER OF THE CATALOGUE STAR FOR XSORT c NINDEX(CATAN)= CATAN XINDEX(CATAN) = XST8(6) c C SAVING OF CATALOGUE DATA c C MD/GAVO: This is where the format for the nid files C is determined; the strings generated here are what's C handed around in the rest of the program. C C GAVO change: fiddle in kennx8 and kennx4 into previously unused C parts of the record. We need these to make sense of the various C data. See GAVO_INPUTS/arigfh/README C WRITE(2,REC=CATAN)(XST8(I),I=1,14), & (KX8(I), I=1,12), & (XST4(I),I=1,9), & (KX4(I),I=1,6), & (IST4(I),I=1,2), & (KX8(I),I=13,14), & (KX4(I),I=7,12), & (IST2(I),I=1,30) ccc ccc ccc WRITE(*,*) (XST8(I),I=1,20),(XST4(I),I=1,15), ccc &(IST4(I),I=1,10),(IST2(I),I=1,30) ccc WRITE(*,*) nindex(catan),xindex(catan) C------------------------------------------------------ GOTO 1 2 CONTINUE CLOSE(1) CLOSE(2) c c do i = 1,rc c write(*,*) nindex(i),xindex(i) c end do c C SORTING OF CATALOGUE DATA WITH ASCENDING DELTA c print *,'Sortiere Katalogdaten' c write(*,*) 'catan = ',catan CALL XSORT(XINDEX,NINDEX,CATAN) c C CREATING OF IDENTIFICATION FILE c PRINT*,'Erzeuge Katalogdatei, ',DATNAM1,' zu ',DATNAM2 CALL IDCREATE(NINDEX,DATNAM1,DATNAM2,CATAN) print *,Datnam2 c stop c PRINT*,'Erzeuge Masterliste' CALL LISTMAKE(XINDEX,NINDEX,ST) ccc ccc do i = 1,100 write(*,*) 'i, xindex(i)',i,xindex(i) end do c c stop c C NOW MAINID CONTAINS DATA OF THE MASTER CATALOGUE C SORTING OF THE MASTER WITH ASCENDING DELTA c NTOT = NSTAR PRINT*,'Sortieren des Masters' CALL XSORT(XINDEX,NINDEX,NTOT) do i = 1,100 write(*,*) 'i, xindex(i)',i,xindex(i) end do print *,Datnam2 cccc c print *,'checking order', nstar c do i=1,nstar-1 c if (xindex(i).gt.xindex(i+1)) then c print *,'non-sorted',i c end if c end do c stop c C IDENTIFICATION OF THE CATALOGUE c PRINT*,'Identifizierung' CALL MAINID(ST) ccc ccc C STOP print *,Datnam2 CALL READOUT(SXINDEX,SNINDEX,IDMAX) print *,Datnam2 CALL XSORT(SXINDEX,SNINDEX,IDMAX) print *,Datnam2 DATNAM3=DATNAM2//'.T1' DATNAM4=DATNAM2//'.T2' PRINT *,'IDCREATE2 mit ',DATNAM3,' ',DATNAM4 ccc ccc CALL IDCREATE2(SNINDEX,DATNAM3,DATNAM4,IDMAX) PRINT*,'Aufloesen der Doppelidentifizierungen' CALL IDOUBLE c C Hier folgen eventuelle Nachidentifizierungen c if (nrun.eq.1) goto 4444 print *,'Erste Nachidentifizierung' DATNAM2 = 'id2' idrun = 2 NCOUNT = 0 Print *,'1. Nachid: Identifizierung' CALL MAINID(ST) C STOP PRINT*,'1. Nachid: Aufloesen der Doppelidentifizierungen' CALL READOUT(SXINDEX,SNINDEX,IDMAX) CALL XSORT(SXINDEX,SNINDEX,IDMAX) DATNAM3=DATNAM2//'.T1' DATNAM4=DATNAM2//'.T2' PRINT *,'IDCREATE2 mit ',DATNAM3,' ',DATNAM4 CALL IDCREATE2(SNINDEX,DATNAM3,DATNAM4,IDMAX) PRINT*,IDMAX CALL IDOUBLE c C Zweite Nachidentifizierung c if (nrun.eq.2) goto 4444 print *,'Zweite Nachidentifizierung' DATNAM2 = 'id3' idrun = 3 ncount = 0 Print *,'2. Nachid: Identifizierung' CALL MAINID(ST) C STOP PRINT*,'2. Nachid: Aufloesen der Doppelidentifizierungen' CALL READOUT(SXINDEX,SNINDEX,IDMAX) CALL XSORT(SXINDEX,SNINDEX,IDMAX) DATNAM3=DATNAM2//'.T1' DATNAM4=DATNAM2//'.T2' PRINT *,'IDCREATE2 mit ',DATNAM3,' ',DATNAM4 CALL IDCREATE2(SNINDEX,DATNAM3,DATNAM4,IDMAX) PRINT*,IDMAX CALL IDOUBLE 4444 print *,'--- Identifizierung beendet' C------------------------------------------------------ END C BLOCK DATA GLOBAL1 C DIMENSION XMTX(3,3) C COMMON /MATRIX/ XMTX C COMMON /TARGET/ EPO C DATA ((XMTX(I,J),J=1,3),I=1,3) /9*0.D0/ ,EPO /0.D0/ C END