C C H E C 2 2 / FORTRAN 77 release 16.2 REL.16 C C July 22, 2009 reduced to 1500 objects REL.16.2 C C Reductions of UBV or uvby photoelectric observations C by C Petr Harmanec C Astronomical Institute of the Charles University REL.14.1 C V Holesovickach 2 REL.14.1 C 180 00 Praha 8 - Troja REL.14.1 C Czech Republic C e-mail: hec@sunstel.asu.cas.cz REL.14.1 C C C -------------------------- REL.14.1 C Labels up to 1036 used REL.14.1 C -------------------------- REL.14.1 C C Solution with colour extinction coefficients included REL.13 C among the seasonal coefficients C C All transformation equations are in magnitudes REL.13 C C New features of rel. 13 include: REL.13 C 1. a possibility to choose cubic, bilinear or linear REL.13 C transformation equations individually for each passband REL.13 C key 12 = abcde REL.13 C a=W, b=U, c=B, d=V REL.13 C 0..cubic, 1..bilinear, 2..linear REL.13 C 2. the maximum allowed number of individual observations REL.13 C per night was increased to 350 REL.13 C REL.13 C 3. it is possible to create normal points over specific REL.13 C time interval in subroutine DATA to handle unequal number REL.13 C of observations through different passbands; the limitationREL.13 C is that these normal points with their mean times only REL.13 C are used in the main program to calculate air mass, colour REL.13 C extinction, etc. REL.13 C C 4. a minor error in extinction calculation was corrected REL.13 C C 5. input of another Table of objects is now possible REL.13 C C Rel. 13.1: REL.13.1 C 6. rms errors of the mean values for individual stars REL.13.1 C are now errors per 1 observation, not errors of REL.13.1 C the mean as in all previous versions REL.13.1 C C Rel. 13.2: C 7. Bemporad's more accurate formula for air mass is now used REL.13.2 C C Rel. 13.3: REL.13.3 C A minor inacurracy in the determination of the reference REL.13.3 C epoch for solar orbit determination was corrected REL.13.3 C and all zero points are now referred to the time centre REL.13.3 C of the observations REL.13.3 C C C New features of rel. 14: REL.14 C REL.14 C 1. An important possibility to model a time-variable REL.14 C linear extinction was introduced REL.14 C This implies a large change in controlling the run REL.14 C of the program via key 6 in the control record REL.14 C The following options are now possible: REL.14 C -------------------------------------------------------- REL.14 C K6K action REL.14 C -------------------------------------------------------- REL.14 C 0 linear extinction is derived and used as before REL.14 C 1 linear extinction is kept at fixed values REL.14 C 10 linear extinction and a linear trend of the zero REL.14 C point of the magnitude scale are derived via REL.14 C observations in passband 1 and the trend is REL.14 C then kept fixed before extinction for other REL.14 C passbands is calculated REL.14 C 11 linear extinction is kept at fixed values REL.14 C and a linear trend of the zero point of REL.14 C magnitude scale is derived via observations REL.14 C in passband 1 and kept the same for the REL.14 C observation in remaining passbands REL.14 C 20 linear extinction and a quadratic trend of REL.14 C the zero point - see K6K=10 for details REL.14 C 21 fixed linear extinction and a quadratic trend REL.14 C of the zero point - see K6K=11 for details REL.14 C 100-500 a time-variable extinction is derived and REL.14 C modelled as a polynomial of 1st to 5th degree REL.14 C Note that one should now take care how to use these REL.14 C options, considering that for the next night, all REL.14 C nightly transformation coefficients G are set to zero REL.14 C but the linear extinction G5 to G8 which keeps the values REL.14 C derived or specified in the previous night REL.14 C REL.14 C 2. A new regime K1K=3 was implemented which allows REL.14 C to reduce instrumental colour to B-V REL.14 C using (b-v)_0 = H1*(B-V)+H5*CE(B-V,X)+H6 REL.14 C (a linear relation which includes the usual REL.14 C colour extinction) REL.14 C Originally designed to allow reduction of REL.14 C colorimetric data from Zollner photometer REL.14 C REL.14 C 3. The original subroutine to derive geocentric Julian date REL.14 C was replaced by a more universal Vondrak's function GEO REL.14 C REL.14 C 4. There can be up to 900 differential as well as all-sky REL.14 C observations REL.14 C REL.14 C 5. Only data from nights denoted as suitable for all-sky REL.14 C photometry are exported to the all-sky data archive REL.14 C C 6. A graphical display of the O-C deviations for standard REL.14 C stars defining the nightly transformation in individual REL.14 C passbands if now possible when one specifies K11K>9 REL.14 C C New features of rel. 14.1: REL.14.1 C REL.14.1 C It is taken care of Fortran error that a sign of zero REL.14.1 C is always interpreted as +0 which introduced errors REL.14.1 C for declinations as -0 12 15 etc. REL.14.1 C REL.14.1 C REL.15 C New features of rel. 15: REL.15 C REL.15 C New type E data introduced for K5K=4 REL.15 C C Table of objects can contain up to 1500 objects REL.15 C In that case, one has to use |K8K|>9 REL.15 C and Table of objects with all columns shifted REL.15 C for 1 position to the right REL.15 C C Mean times of each observation in NC (1-4) filters REL.15 C are now derived as an average of the individual REL.15 C mean times in filters 1-NC (Oct.15, 2005) REL.15 C C Rel. 16 introduces an option to use the sky measured REL.16 C immediately after each observed object, not interpolated one REL.16 C So far realized for data E only, choose K5K=-4 REL.16 C Rel. 16.1: geographic coordinates of Villanova Observatory REL.16.1 C are now coordinates of Fairborn Observatory, where APT T5 REL.16.1 C is located since 1996. REL.16.1 C C Rel. 16.2: an error in subroutine MAG in the calculation REL.16.2 C of EXT(4) was corrected. All previous versions deriving REL.16.2 C a polynomial fit to extinction during the night malfunctioned REL.16.2 C for the fourth magnitude (e.g. v in Stromgren)! REL.16.2 C Improved geographic coordinates of the Danish 1.52-m REL.16.2 C La Silla telescope were also implemented REL.16.2 C Note that built-in correction of La Silla local time REL.16.2 C UT=LOCAL+5 is only valid from April to October, it must REL.16.2 C be set to 4 hours for observations from other months REL.16.2 C C C C C IMPLICIT REAL*8 (A-H,O-Z) C 101 FORMAT(12I5,3I3,1X,5A2) 102 FORMAT(5A8,2X) 103 FORMAT(F3.0,I3,I5,3I2,3X,4F10.5) REL.13 104 FORMAT(7F10.5,A8) 105 FORMAT(I3,I2,F5.0,3F4.0,F5.0,2F4.0,3F7.3,I11,3A4) 106 FORMAT(8F10.5) 107 FORMAT(3I2) 108 FORMAT(I10,4F10.3) 109 FORMAT(I3,I2,F5.0,3F3.0,F4.0,2F3.0,4F7.3,I10,3A4) 2109 FORMAT(I4,I2,F5.0,3F3.0,F4.0,2F3.0,4F7.3,I10,3A4) REL.15 110 FORMAT(80A1) REL.14.1 C 200 FORMAT(//15X,24(2H* ),1H*/15X,1H*,47X,1H*/15X,1H*,3X, 1 'H E C 2 2',8X,'IBM PC 486 / FORTRAN 77',2X,1H* 2 /15X,1H*,47X,1H*/15X,1H*,3X, 3 'R e l e a s e 16.2 22 July 2009',2X,1H* REL.16.2 4 /15X,1H*,47X,1H*/15X,24(2H* ),1H*//) 201 FORMAT(1X,I3,2X,3A4,I8,I5,I7,2(F5.0,2F7.2),4F8.3) 2201 FORMAT(1X,80A1) REL.15 22201 FORMAT(80A1) REL.15 202 FORMAT(5X,'The zero coefficients in V, B, U and W:'/ * 13X,4F10.5/) REL.14 203 FORMAT(/5X,'The extinction coefficients used:'/ 1 19X,1HV,9X,1HB,8X,1HU,8X,1HW/ 2 ' first-order:',4F10.5,2X,A8/ 4 'second-order:',4F10.5,2X,A8/) 204 FORMAT(1X,A2,1X,3A4,F5.0,F7.2,F8.4,17F8.3) 205 FORMAT(//40X,34(1H*)/43X,3A4,' (HD',I7,1H)/40X,34(1H*)// 1 5X,'Local time',6X,'JD hel',9X,1HV,8X,1HB,8X,1HU, 2 7X,3HB-V,6X,3HU-B,7X,1HX,6X,5HV dif,3X, 3 'B-V dif U-B dif DX HD comp'/ 4 8X,1Hh,6X,1Hm) 2205 FORMAT(//40X,34(1H*)/43X,3A4,' (HD',I7,1H)/40X,34(1H*)// 1 5X,'Local time',6X,'JD hel',9X,1HV,8X,1HB,8X,1HU, 2 8X,1HW,7X,3HB-V,6X,3HU-B,7X,1HX,6X,5HV dif,3X, 3 'B-V dif U-B dif W dif DX HD comp'/ 4 8X,1Hh,6X,1Hm) 206 FORMAT(3X,F5.0,F7.2,F15.4,7F9.3) 207 FORMAT(6X,2HV:,6F10.5/6X,2HB:,6F10.5/ * 6X,2HU:,6F10.5/6X,2HW:,6F10.5/) 208 FORMAT(//15X,49(1Ho),15X/27X, 1 'Date:',I6,2H -,I3,2H -,F4.0,1H/,F3.0/ 2 80(1Ho)/10A8/80(1Ho)) 209 FORMAT(35X,'Key option:'/12I5,3I3,1X,5A2/80(1H-)) 210 FORMAT(32X,'Observatory ',A8/ 1 28X,1Hh,7X,1Hm,23X,1Ho,7X,1H// 2 ' Geographic coordinates:', 3 I3,F8.3,2X,A4,' of Greenwich',I5,F8.3,A8/80(1H-)) 211 FORMAT(5X,'Corrections to the U.T.:',3X,'U.T.(hours) =', 1 ' Local time + PAS + CTIME/60;'/15X,'PAS =',F9.4, 2 ' hours CTIME =',F10.3,' minutes'/80(1H=)) 212 FORMAT(2X,3HNo.,1X,'Epoch',4X, REL.14.1 1 'R.A.',5X,'Decl.',5X,1HV,6X,3HB-V,4X, REL.14.1 2 3HU-B,5X,1HW,7X,2HHD,5X,'Star Name'/ REL.14.1 3 4X,'Type'/ REL.14.1 4 80(1H-)/ REL.14.1 5 14X,1Hh,2X,1Hm,2X,1Hs,3X,1Ho,2X,1H/,2X,2H//) REL.14.1 213 FORMAT(5X,'Gains in magnitudes:') 214 FORMAT(52X,'The standard stars used'//56X, 1 'Computed',28X,'Computed-standard'//8X,'Star name',2X, 2 'Local time',2X,'JD geo',4X,1HV,7X,1HB,7X,1HU,7X, 3 3HB-V,5X,3HU-B,5X,2HDV,6X,2HDB,6X,2HDU,4X, 4 'D(B-V)',2X,'D(U-B)',4X,1HX,7X,2HkV,6X,2HkB,6X,2HkU/ REL.14 5 20X,1Hh,4X,1Hm,I10,1H+) 2114 FORMAT(22X,'The standard stars used'//37X, REL.14 1 'Computed',1X,'Comp-std'//8X,'Star name',2X, REL.14 2 'Local time',2X,'JD geo',4X,3HB-V,3X,'D(B-V)',5X,1HX, REL.14 3 6X,2HkV/20X,1Hh,4X,1Hm,I10,1H+) REL.14 2214 FORMAT(52X,'The standard stars used'//56X, 1 'Computed',28X,'Computed-standard'//8X,'Star name',2X, 2 'Local time',2X,'JD geo',4X,1HV,7X,1HB,7X,1HU,7X,1HW,7X, 3 3HB-V,5X,3HU-B,5X,2HDV,6X,2HDB,6X,2HDU,6X,2HDW,4X, 4 'D(B-V)',2X,'D(U-B)',4X,1HX,7X,2HkV,6X,2HkB,6X,2HkU,6X, REL.14 5 2HkW/20X,1Hh,4X,1Hm,I10,1H+) REL.14 215 FORMAT (4X,4Hrms:,4F10.4/) 216 FORMAT(/80(1H-)//1X,I4,'.iteration'/) 217 FORMAT(/7X,'Mean:',F18.4,5F9.3,9X,3F9.3) 2217 FORMAT(/7X,'Mean:',F18.4,6F9.3,9X,4F9.3) 218 FORMAT (/72X,4Hrms:,6F8.3/) 2218 FORMAT (/80X,4Hrms:,6F8.3/) 2318 FORMAT (/40X,4Hrms:,F8.3/) 219 FORMAT(3X,F5.0,F7.2,F15.4,10F9.3,I8) 2219 FORMAT(3X,F5.0,F7.2,F15.4,12F9.3,I8) 221 FORMAT(4X,'rms error:',16X,5F9.3,9X,3F9.3) 2221 FORMAT(4X,'rms error:',16X,6F9.3,9X,4F9.3) 222 FORMAT(' Mean-standard:',14X,5F9.3,9X,3F9.3) 2222 FORMAT(' Mean-standard:',14X,6F9.3,9X,4F9.3) 223 FORMAT(5X,'Dead-time information:'// 1 5X,'DTK = ',1PD10.3,5X,'DTC = ',1PD10.3,5X,'TINT = ',0PF4.0// 2 5X,'DTK... dead-time coeffient specified on input,'/ 3 5X,'DTC... dead-time coeficient used in calculations'// 4 5X,'If integration time TINT is not specified (TINT=0), DTC=DTK'/ 5 5X,'(given in units of integration time used) is applied'/) 224 FORMAT(5X,'and the higher terms of nightly transformation'/ REL.14 1 7X,'G(9) through G(28) (mag per day):'/5(5X,4G15.5/)) REL.14 225 FORMAT(/1X,'Following types of objects were re-defined:'// * 2X,3HNo.,4X,'Star name',4X,2HHD,4X,'Type'/) 226 FORMAT(5X,'The colour coefficients H'/ 1 14X,3HB-V,7X,3HU-B,5X,'(B-V)^2',3X,'(B-V)^3',5X, 2 4H X /6X,2HV:,6F10.5/ 3 6X,2HB:,6F10.5/6X,2HU:,6F10.5/6X,2HW:,6F10.5/) 227 FORMAT(5X,'The colour coefficients H(1) to H(24)') 228 FORMAT(30X,'The standard stars used'//29X, 1 'Computed',10X,'Computed-standard'//11X,'Star', 2 2X,'Local time',2X,3HB-V,3X,3HU-B,4X, 3 2HDV,4X,2HDB,4X,2HDU,4X,2HDW,1X,'D(B-V)',1X, 4 'D(U-B)',2X,1HX/19X,1Hh,3X,1Hm) 229 FORMAT (/40X,4Hrms:,6F6.2/) 230 FORMAT(1X,A2,1X,3A4,F4.0,10F6.2) 231 FORMAT(5X,'Adjusted zero points:',F12.5,2F38.5/) 232 FORMAT(80(1H-)/5X,'High voltage',I6,2H V,5X, 1 'Non-linearity coefficient',F11.8/80(1H-)/) 233 FORMAT(30X,'The standard stars used'//29X, 1 'Computed',10X,'Computed-standard'//11X,'Star', 2 2X,'Local time',2X,1HV,5X, 3 3HB-V,3X,3HU-B,4X,2HDV,4X,2HDB,4X,2HDU,1X,'D(B-V)',1X, 4 'D(U-B)',2X,1HX/19X,1Hh,3X,1Hm) 234 FORMAT (/34X,4Hrms:,6F6.2/) 236 FORMAT(' uvby TABLE'/) C 300 FORMAT(57(2H ?)) 301 FORMAT(5X,'Error 1',3X,I4,' gains are requested, which is', 1 ' more than the allowed maximum 32') 302 FORMAT(5X,'Error 3',3X, * 'No comparison-star observation available') 303 FORMAT(5X,'Error 2',3X, * 'Table of stars contains objects with running numbers', * ' higher than the allowed maximum of',I4) C 401 FORMAT(10A4) C $LARGE: AEQ,DEQ,A,D,EQ,HJD,S,V,TT,VV,NK,NKK,C,NH,HD,NT,NCOMP,HVZ REL.15 C CHARACTER*1 NULA(2),DULA(80) REL.14.1 CHARACTER*12 IN1,IN2,IN3,OUT,OUT1,OUT2,OUT3 INTEGER*2 IS,IST(2),JKS(3),JES(4) INTEGER*2 KTE(5),MES(12),NCOMP(1500),J6K(4),NT INTEGER*4 HD,KOBS3(3) REAL*4 ADEL(2),VJH(5),VST(6),HVZ(1500,3),VD(900,4),O7,O8,O9 C DIMENSION RMD(8),AEQ(1500),DEQ(1500),A(1500),D(1500),EQ(1500), 1 TEX(10),POM(3),HJD(1500),RMS(4),RM(4),H(24),HH(24), 2 OBS(20),CP(20),DEL(20),SIR(20),ASIR(2),RME(6),PM(4), 3 FC(4),VEM(5),B(30),PRM(6),RV(7),RB(7),RU(7),RW(7), 4 AEV(77),AEB(77),AEU(77),AEW(77), 5 ACV(42),ACB(42),ACU(42),ACW(42),BS(77), 6 TX(2),TQ(2),X(6),Y(6),Z(6),ZW(6),DM(8),DEM(4), REL.14 7 HHH(6),VX(5),G1B(4) C COMMON /KLICE/ *K1K,K2K,K3K,K4K,K5K,K6K,K7K,K8K,K9K,K10K,K11K,K12K,K22K C COMMON /DATA/ S(900,4),V(900,4),PAS,STRED,U(32),UI(32),DIG,VEX(4),REL.13 * TT(900,4),VV(900,4),C(4,1500),E(12),G(28),VJ(4),BR(6),AVE,REL.15 * EXT(4),NM(4),NC,NS,NK(900,4),NKK(900,4),NH(1500,4), REL.15 * NMIN,NMAX,NDIG,NKAL,HD(1500),NT(1500) REL.15 C COMMON /WECKA/ W1,W2,W3,W4,W5,W6,W7,W8,W9,W10 REL.14.1 COMMON /TIME/ GEO,DAT,SS,CS,DELKA,SE,CE,DSUN,HEL, * HCAS,UHEL,AIR COMMON /DTC/ DTC,HNL,L123 C C DIMENSION HV(6),HB(6),HU(6),HW(6),G0(4),G1(4),GT(4),GT2(4), REL.14 * GT3(4),GT4(4),GT5(4) REL.14 DIMENSION HVP(5),HBP(5),HUP(5),HWP(5) EQUIVALENCE (HV(1),HVP(1),H(1)),(HB(1),HBP(1),H(7)), 1 (HU(1),HUP(1),H(13)),(HW(1),HWP(1),H(19)), 1 (G0(1),G(1)),(G1(1),G(5)),(GT(1),G(9)), 2 (GT2(1),G(13)),(GT3(1),G(17)), REL.14 2 (GT4(1),G(21)),(GT5(1),G(25)), REL.14 3 (POM(1),PM(1)),(VJH(1),VST(1)),(DEM(1),DM(3)) REL.14 C C C INITIALIZATION OF PARAMETERS AND DATA FIELDS C C C Note that built-in correction of La Silla local time REL.16.2 C UT=LOCAL+5 is only valid from April to October, it must REL.16.2 C be set to 4 hours for observations from other months REL.16.2 C DATA OBS/8H Hvar ,8H Brno ,8HSk.Pleso,8HOndrejov,8H Lowell , 1 8HKryoneri,8HMcDonald,8HXingLong,8HSarajevo,8HKPNO-0.4, 2 8HSAAO-0.5,8HLa Silla,8HMt.Kobau,8HHawaii ,8HPhoen-10, 3 8HFairborn,8H APT-Van,8HSt.Lesna,8HAbastum.,8HToronto / DATA CP/-1D0,-1D0,-1D0,-1D0,7D0,-2D0,7D0,-8D0,-1D0,7D0, 1 -2D0,5D0,8D0,10D0,7D0,7D0,7D0,-1D0,-2D0,5D0/ REL.16.2 DATA DEL/ 4.568055D-2, 4.607870D-2, 5.623611D-2, 4.106597D-2, 1 -3.102431D-1, 6.2847D-2,-2.889491D-1, 3.266D-1, 2 5.12298D-2,-3.099861D-1, 5.781100D-2,-1.964873935D-1, REL.16.2 3 -3.31944D-1,-4.318657D-1,-3.079923D-1,-3.074853D-1, 4 -3.079923D-1, 5.636420D-2, 1.1875D-1,-2.217593D-1/ DATA SIR/7.53982D-1,8.587747D-1,8.584984D-1,8.711035D-1, 1 6.145061D-1,6.57407D-1,5.3532157D-1,7.0499608D-1, 2 7.651951866D-1,5.5777814D-1,-0.5651085226,-0.5105778191, REL.16.2 3 8.57248D-1,3.46030916D-1,5.5298818D-1,0.5478006746, 4 5.5298818D-1,8.5787781D-1,7.28674962D-1,7.62127D-1/ DATA ADEL/4Heast,4Hwest/ DATA ASIR/8H north ,8H south / DATA MES/31,28,31,30,31,30,31,31,30,31,30,31/ DATA TQ/8H fixed,8Hcomputed/ DATA J6K/1,0,2,3/ DATA JKS/5,3,2/ DATA IST/2H ,2HST/ DATA NULA/1H-,1H0/ REL.14.1 C PRINT *,'Vstupni soubor ridicich udaju?' PRINT *,'Input file with control records?' READ(*,'(A)') IN1 OPEN(3,FILE=IN1,STATUS='OLD') READ(3,107) NFIL1,NFIL2,NFIL3 NFIL=NFIL1+NFIL2 READ(3,'(A)') IN2 OPEN(11,FILE=IN2,STATUS='OLD') READ(3,'(A)') IN3 OPEN(12,FILE=IN3,STATUS='OLD') READ(3,'(A)') OUT OPEN(9,FILE=OUT,STATUS='NEW') IF(NFIL1.EQ.0) GO TO 1009 READ(3,'(A)') OUT1 OPEN(1,FILE=OUT1,FORM='UNFORMATTED',STATUS='NEW') 1009 IF(NFIL2.EQ.0) GO TO 99 READ(3,'(A)') OUT2 OPEN(2,FILE=OUT2,FORM='UNFORMATTED',STATUS='NEW') 99 IF(NFIL3.EQ.0) GO TO 1010 READ(3,'(A)') OUT3 OPEN(4,FILE=OUT3,STATUS='NEW') 1010 NS=0 NC=4 NZAH=0 REL.14 NZAM=0 NKAL=32 KL2=2 K11K=3 K12K=0 DO 11 J=1,NO 11 HD(J)=0 DO 87 J=1,24 87 HH(J)=1D0 CALL NUL(24,H) DTC=0D0 G1(1)=0.25D0 G1(2)=0.40D0 G1(3)=0.70D0 G1(4)=0.50D0 U(1)=10D0 C C C RESTART AFTER COLOUR SYSTEM CONVERGED C 6 L123=0 ITER=0 CALL NUL(NC,RM) C C RESTART OF COLOUR SYSTEM ITERATION C 5 CALL NUL(42,ACV) CALL NUL(42,ACB) CALL NUL(42,ACU) IF(NC.GT.3) CALL NUL(42,ACW) CALL NUL(NC,RMS) CALL MAG(1,J,Q,Q,Q,Q,H) NUC=0 KTAB=0 REL.13 C C START OF A NEW NIGHT OF OBSERVATIONS C INPUT OF KEYS, DAY OF OBSERVATION AND AUXILIAR PARAMETERS C 1 READ(3,101,END=2) K1K,K2K,K3K,K4K,K5K,K6K,K7K,K8K,K9K,K10K, 1 KL11,KL12,KOBS3,KTE KOBS=1000000*KOBS3(1)+1000*KOBS3(2)+KOBS3(3) IF(K1K.LT.0) GO TO 2 C !!! bacha, Harmance !!! REL.14 K11T=KL11 REL.14 IF(K2K.GT.0) NZAM=0 REL.14 IF(NZAM.NE.0.OR.(KL11.EQ.0.AND.KL12.EQ.0)) GO TO 10 NZAM=1 KEY11=KL11/10 REL.14 KL11=MOD(KL11,10) REL.14 K11K=KL11 K12K=MOD(KL12,10) K=KL12-K12K K12W=K/10000 REL.13 K=K-10000*K12W REL.13 K12U=K/1000 REL.13 K=K-1000*K12U REL.13 K12B=K/100 REL.13 K=K-100*K12B REL.13 K12V=K/10 REL.13 K22K=0 REL.13 IF(K12V.NE.0.AND.K12B.NE.0.AND.K12U.NE.0) K22K=1 REL.13 10 KL1=K1K/10 KLICEK1=K1K REL.14.1 K1K=MOD(K1K,10) IF(KL1.EQ.0) MDIG=2 IF(K4K.NE.0) NKAL=IABS(K4K) IF(K1K.EQ.5) GO TO 7 IF(K7K.EQ.-1.AND.L123.EQ.0) L123=2 IF(K7K.LT.-1.AND.L123.EQ.2) L123=0 IF(KL1.GT.0) GO TO 1006 READ(11,102) TEX READ(11,103) DEN,ME,LP,NC,NOBS,I,CTIME,VN,TINT,AVE REL.13 IF(NC.EQ.0) NC=3 IF(K1K.EQ.3) NC=1 REL.14 HNL=0D0 IF(VN.GT.0D0) HNL=1D0/(37.5D0*VN) 1006 IF(NZAH.EQ.0.AND.K11K.GT.0) WRITE(9,200) REL.14 NZAH=1 REL.14 IF(L123.GT.0) K7K=-1 IF(L123.EQ.-1) L123=-2 IB=2 IF(NC.EQ.1) IB=1 IF(NKAL.LE.32) GO TO 12 WRITE(9,300) WRITE(9,301) J WRITE(9,300) NKAL=32 C 12 IF(KL1.GT.0) GO TO 14 IF(I.GT.0) MDIG=I IF(NOBS.GT.20) GO TO 13 IF(NOBS.EQ.0) NOBS=1 DD=OBS(NOBS) PCS=CP(NOBS) DELKA=DEL(NOBS) SIRKA=SIR(NOBS) GO TO 14 C 13 READ(11,104) Q,Q1,Q2,Q3,Q4,Q5,PCS,DD DELKA=(Q+DSIGN(Q1,Q)/60D0+DSIGN(Q2,Q)/3600D0)/24D0 SIRKA=(Q3+Q4/60D0+Q5/3600D0)*1.745329251D-2 C C PRINT OF HEADINGS C 14 GEO=GJD(DEN,ME,LP) IF(L123.GT.0) GO TO 41 IF(L123.LT.0.AND.K9K.LT.100) GO TO 41 Q=DEN+1D0 J=Q IF(J.GT.MES(ME)) Q=1D0 IF (K11K.GT.0) WRITE(9,208) LP,ME,DEN,Q,TEX IF (K11K.GT.0) WRITE(9,209) 1 KLICEK1,K2K,K3K,K4K,K5K,K6K,K7K,K8K,K9K,K10K, REL.14.1 2 K11T,KL12,KOBS3,KTE REL.14 J3=1 J4=1 IF(DELKA.LT.0D0) J3=2 IF(SIRKA.LT.0D0) J4=2 Q1=24D0*DABS(DELKA) J1=Q1 Q=J1 Q1=60D0*(Q1-Q) Q2=DABS(SIRKA)/1.745329251D-2 J2=Q2 Q=J2 Q2=60D0*(Q2-Q) IF(K11K.GT.1) WRITE(9,210) DD,J1,Q1,ADEL(J3),J2,Q2,ASIR(J4) IF(K11K.GT.1) WRITE(9,211) PCS,CTIME 41 PAS=PCS+CTIME/60D0 SS=DSIN(SIRKA) CS=DCOS(SIRKA) K1K=MOD(K1K,10) C C INPUT OF TABLE OF OBJECTS FOR NON-ZERO VALUES OF K8K C OF ALREADY ENTERED TABLE C NEGATIVE VALUES OF K8K SUPRESS THE PRINT OF THE TABLE ON OUTPUT C K8K=1: NEW TABLE K8K=2: CHANGES AND/OR EXPANSION C J1=K8K K8K=IABS(K8K) IF(K8K.LT.10) NO=999 REL.15 IF(K8K.GT.10) NO=1500 REL.15 IF(K8K.LT.10) K8=22 REL.15 IF(K8K.GT.10) K8=23 REL.15 IF(K8K.EQ.0) GO TO 20 IF(K8K.GT.1.OR.KTAB.EQ.0) GO TO 1034 REL.13 READ(3,'(A)') IN3 REL.13 OPEN(12,FILE=IN3,STATUS='OLD') REL.13 1034 L=0 REL.13 INX=0 KTAB=1 REL.13 IF(K8K.EQ.1) NS=0 IF(L123.EQ.0.AND.J1.GT.0.AND.K11K.GT.2) INX=1 IF(INX.NE.0) WRITE(9,212) 16 ZNAM=1D0 REL.14.1 IF(K8K.NE.1.AND.K8K.NE.11) GO TO 1035 REL.15 READ(12,110,END=71) DULA REL.14.1 IF(DULA(K8).EQ.NULA(1).AND.DULA(K8+1).EQ.NULA(2)) ZNAM=-1D0 REL.15 BACKSPACE 12 REL.14.1 IF(K8K.LT.10) REL.15 *READ(12,109,END=71) L,J,Q,Q1,Q2,Q3,Q4,Q5,Q6,PM,K,O7,O8,O9 REL.15 IF(K8K.GT.10) REL.15 *READ(12,2109,END=71) L,J,Q,Q1,Q2,Q3,Q4,Q5,Q6,PM,K,O7,O8,O9 REL.15 GO TO 1036 REL.14.1 1035 READ(3,110,END=71) DULA REL.14.1 IF(DULA(K8).EQ.NULA(1).AND.DULA(K8+1).EQ.NULA(2)) ZNAM=-1D0 REL.15 BACKSPACE 3 REL.14.1 IF(K8K.LT.10) REL.15 *READ(3,109,END=71) L,J,Q,Q1,Q2,Q3,Q4,Q5,Q6,PM,K,O7,O8,O9 REL.15 IF(K8K.GT.10) REL.15 *READ(3,2109,END=71) L,J,Q,Q1,Q2,Q3,Q4,Q5,Q6,PM,K,O7,O8,O9 REL.15 1036 IF(L.EQ.0) GO TO 71 REL.13 IF(L.LE.NO) GO TO 17 JER=1 GO TO 16 17 IF(L.EQ.0) GO TO 71 IF(L.GT.NS) NS=L M=Q IF(INX.NE.0.AND.K8K.LT.10) WRITE(9,2201) (DULA(III),III=1,79) REL.15 IF(INX.NE.0.AND.K8K.GT.10) WRITE(9,22201) (DULA(III),III=1,80) REL.15 NT(L)=J HVZ(L,1)=O7 HVZ(L,2)=O8 HVZ(L,3)=O9 HD(L)=K EQ(L)=Q-1900D0 AEQ(L)=2.617993900D-1*(Q1+Q2/60D0+Q3/3600D0) DEQ(L)=1.745329251D-2*(Q4+DSIGN(Q5,Q4)/60D0+DSIGN(Q6,Q4)/3600D0) DEQ(L)=DEQ(L)*ZNAM REL.14.1 C(1,L)=POM(1) Q7=POM(1)+POM(2) C(2,L)=Q7 C(3,L)=Q7+POM(3) IF(NC.EQ.4) C(4,L)=PM(4) GO TO 16 C 71 REWIND 12 IF(JER.NE.1) GO TO 20 WRITE(9,300) WRITE(9,303) NO WRITE(9,300) JER=0 C C EQUATOREAL COORDINATES OF THE DAY OF OBSERVATION C 20 DAT=(GEO-2415020.3135D0)/365.24219D0 DO 19 J=1,NS IF(HD(J).LE.0) GO TO 19 CALL RADEC(A(J),D(J),AEQ(J),DEQ(J),DAT,EQ(J)) 19 CONTINUE C C INPUT OF COLOUR, EXTINCTION AND OTHER COEFFICIENTS C IF(K2K.GT.99) K2K=5 IF(L123.EQ.0.OR.L123.EQ.2) GO TO 27 IF(K2K.EQ.0) GO TO 28 READ(3,106) Q,Q,Q,Q,Q,DTK READ(3,106) Q READ(3,106) Q IF(NC.EQ.4) READ(3,106) Q GO TO 28 27 IF(K2K.EQ.0) GO TO 28 READ(3,106) HVP,DTK READ(3,106) HBP READ(3,106) HUP IF(NC.EQ.4) READ(3,106) HWP DO 1011 J=1,4 IF(HVP(J).NE.0D0) GO TO 1012 IF(HBP(J).NE.0D0) GO TO 1012 IF(HUP(J).NE.0D0) GO TO 1012 IF(HWP(J).NE.0D0) GO TO 1012 1011 CONTINUE 1012 CALL MAG(1,J,Q,Q,Q,Q,H) 28 IF(K3K.NE.0) READ(3,106) G1 IF(K4K.EQ.0) GO TO 1007 READ(3,106) (U(J),J=1,NKAL) DO 1008 J=1,NKAL 1008 UI(J)=10D0**(-4D-1*U(J)) 1007 IF(DTK.NE.0D0) MDIG=9 DIG=10D0**(-MDIG) NDIG=10**MDIG DTC=DTK IF(TINT.NE.0D0) DTC=DTK/TINT IF(L123.LT.0.AND.K9K.GE.100) GO TO 72 IF(L123.NE.0) GO TO 78 IF(K11K.GT.1) WRITE(9,226) H 72 IF(DTK.EQ.0D0) GO TO 8 IF(K11K.GT.1) WRITE(9,223) DTK,DTC,TINT GO TO 78 8 IF(K11K.LE.1) GO TO 78 WRITE(9,213) WRITE(9,106) (U(J),J=1,NKAL) JVN=VN WRITE(9,232) JVN,HNL 78 IF(K10K.EQ.0) GO TO 42 IF(L123.EQ.0.AND.K11K.GT.1) WRITE(9,225) 73 READ(3,101) J,K IF(J.EQ.0) GO TO 42 NT(J)=K M=EQ(J)+1900D0 IF(L123.EQ.0.AND.K11K.GT.1) 1 WRITE(9,201) J,HVZ(J,1),HVZ(J,2),HVZ(J,3),HD(J),K GO TO 73 C C C INPUT OF OBSERVATIONS, COMPUTING MAGNITUDES C 42 CALL DATABC IF(L123.GT.0.AND.K9K.LT.100) GO TO 1 IF(L123.LT.0.AND.K9K.LT.100.AND.NFIL.EQ.0) GO TO 1 C C C HELIOCENTRIC CORRECTION OF TIME FOR STARS IN THE TABLE C Q=STRED REL.14 CALL SUN(Q) REL.14 DO 21 J=NMIN,NMAX K=NH(J,1)+NH(J,2)+NH(J,3) IF(K.LE.0) GO TO 21 IF(HD(J).GT.0) HJD(J)=HK(A(J),D(J)) 21 CONTINUE C C C DETERMINATION OF THE EXTINCTION COEFFICIENTS FOR A GIVEN NIGHT C KL5=IABS(K5K) IF(KL5.EQ.4) KL5=1 REL.14.1 KP6=K6K/100 REL.14 KL6=MOD(K6K-100*KP6,10) REL.14 KL16=(K6K-KL6)/10 KLEX=0 DO 1033 J=1,NC 1033 G1B(J)=0D0 100 CALL NUL(77,AEV) REL.14 CALL NUL(77,AEB) REL.14 CALL NUL(77,AEU) REL.14 IF(NC.EQ.4) CALL NUL(77,AEW) REL.14 CALL NUL(4,G0) CALL NUL(20,GT) REL.14 CALL NUL(6,RME) IF(NC.LT.4) CALL NUL(7,RW) REL.14 IF(NC.LT.3) CALL NUL(7,RU) REL.14 IF(NC.LT.2) CALL NUL(7,RB) REL.14 NEX=0 K=NM(1) C DO 3 J=1,K I=NK(J,1) IF(NT(I).LT.4) GO TO 3 NEX=NEX+1 Q1=A(I) Q2=D(I) CALL XYZF(I,J,KL5,Q1,Q2,H,X,Y,Z,ZW,FC) C REL.14 C K6K=0 REL.14 C REL.14 IF(K6K.NE.0) GO TO 49 REL.14 CALL SUMA(1,2,AEV,X,FC(1)) REL.14 IF(NC.GT.1) CALL SUMA(1,2,AEB,Y,FC(2)) REL.14 IF(NC.GT.2) CALL SUMA(1,2,AEU,Z,FC(3)) REL.14 IF(NC.EQ.4) CALL SUMA(1,2,AEW,ZW,FC(4)) REL.14 GO TO 3 REL.14 C REL.14 C K6K=1 REL.14 C REL.14 49 IF(K6K.NE.1) GO TO 86 REL.14 G(1)=G(1)+FC(1)-G1(1)*X(1) REL.14 IF(NC.GT.1) G(2)=G(2)+FC(2)-G1(2)*Y(1) REL.14 IF(NC.GT.2) G(3)=G(3)+FC(3)-G1(3)*Z(1) REL.14 IF(NC.GT.3) G(4)=G(4)+FC(4)-G1(4)*ZW(1) REL.14 GO TO 3 REL.14 C REL.14 C K6K=10 REL.14 C REL.14 86 IF(K6K.NE.10) GO TO 51 REL.14 CALL SUMA(2,3,AEV,X,FC(1)) REL.14 GO TO 3 REL.14 C REL.14 C K6K=11 REL.14 C REL.14 51 IF(K6K.NE.11) GO TO 1043 REL.14 FC(1)=FC(1)-G1(1)*X(1) REL.14 X(1)=X(2) REL.14 CALL SUMA(1,2,AEV,X,FC(1)) REL.14 GO TO 3 REL.14 C REL.14 C K6K=20 REL.14 C REL.14 1043 IF(K6K.NE.20) GO TO 1046 REL.14 CALL SUMA(3,4,AEV,X,FC(1)) REL.14 GO TO 3 REL.14 C REL.14 C K6K=21 REL.14 C REL.14 1046 IF(K6K.NE.21) GO TO 52 REL.14 FC(1)=FC(1)-G1(1)*X(1) REL.14 X(1)=X(2) REL.14 X(2)=X(2)*X(2) REL.14 CALL SUMA(2,3,AEV,X,FC(1)) REL.14 GO TO 3 REL.14 C REL.14 52 IF(K6K.NE.100) GO TO 53 REL.14 C REL.14 C K6K=100 REL.14 C REL.14 CALL SUMA(2,3,AEV,X,FC(1)) REL.14 IF(NC.GT.1) CALL SUMA(2,3,AEB,Y,FC(2)) REL.14 IF(NC.GT.2) CALL SUMA(2,3,AEU,Z,FC(3)) REL.14 IF(NC.GT.3) CALL SUMA(2,3,AEW,ZW,FC(4)) REL.14 GO TO 3 REL.14 C REL.14 53 IF(K6K.NE.200) GO TO 59 REL.14 C REL.14 C K6K=200 REL.14 C REL.14 CALL SUMA(3,4,AEV,X,FC(1)) REL.14 IF(NC.GT.1) CALL SUMA(3,4,AEB,Y,FC(2)) REL.14 IF(NC.GT.2) CALL SUMA(3,4,AEU,Z,FC(3)) REL.14 IF(NC.GT.3) CALL SUMA(3,4,AEW,ZW,FC(4)) REL.14 GO TO 3 REL.14 C REL.14 59 IF(K6K.NE.300) GO TO 74 REL.14 C REL.14 C K6K=300 REL.14 C REL.14 CALL SUMA(4,5,AEV,X,FC(1)) REL.14 IF(NC.GT.1) CALL SUMA(4,5,AEB,Y,FC(2)) REL.14 IF(NC.GT.2) CALL SUMA(4,5,AEU,Z,FC(3)) REL.14 IF(NC.GT.3) CALL SUMA(4,5,AEW,ZW,FC(4)) REL.14 GO TO 3 REL.14 C REL.14 74 IF(K6K.NE.400) GO TO 75 REL.14 C REL.14 C K6K=400 REL.14 C REL.14 CALL SUMA(5,6,AEV,X,FC(1)) REL.14 IF(NC.GT.1) CALL SUMA(5,6,AEB,Y,FC(2)) REL.14 IF(NC.GT.2) CALL SUMA(5,6,AEU,Z,FC(3)) REL.14 IF(NC.GT.3) CALL SUMA(5,6,AEW,ZW,FC(4)) REL.14 GO TO 3 REL.14 C REL.14 C K6K=500 REL.14 C REL.14 75 CALL SUMA(6,7,AEV,X,FC(1)) REL.14 IF(NC.GT.1) CALL SUMA(6,7,AEB,Y,FC(2)) REL.14 IF(NC.GT.2) CALL SUMA(6,7,AEU,Z,FC(3)) REL.14 IF(NC.GT.3) CALL SUMA(6,7,AEW,ZW,FC(4)) REL.14 C REL.14 3 CONTINUE REL.14 C REL.14 IF(NEX.EQ.0) GO TO 54 REL.14 C REL.14 C K6K=0 REL.14 C REL.14 IF(K6K.NE.0) GO TO 93 REL.14 K=2 REL.14 CALL RES(K,AEV,BS,RV) REL.14 IF(NC.GT.1) CALL RES(K,AEB,BS,RB) REL.14 IF(NC.GT.2) CALL RES(K,AEU,BS,RU) REL.14 IF(NC.GT.3) CALL RES(K,AEW,BS,RW) REL.14 G(1)=RV(2) REL.14 IF(NC.GT.1) G(2)=RB(2) REL.14 IF(NC.GT.2) G(3)=RU(2) REL.14 IF(NC.GT.3) G(4)=RW(2) REL.14 G(5)=RV(1) REL.14 IF(NC.GT.1) G(6)=RB(1) REL.14 IF(NC.GT.2) G(7)=RU(1) REL.14 IF(NC.GT.3) G(8)=RW(1) REL.14 GO TO 54 REL.14 C REL.14 C K6K=1 REL.14 C REL.14 C 93 IF(KL6.EQ.0) GO TO 85 REL.14 93 IF(K6K.NE.1) GO TO 34 REL.14 Q=NEX REL.14 G(1)=G(1)/Q REL.14 IF(NC.GT.1) G(2)=G(2)/Q REL.14 IF(NC.GT.2) G(3)=G(3)/Q REL.14 IF(NC.EQ.4) G(4)=G(4)/Q REL.14 GO TO 54 REL.14 C REL.14 C K6K=11 REL.14 C REL.14 34 IF(K6K.NE.11) GO TO 1040 REL.14 CALL RES(2,AEV,BS,RV) REL.14 G(9)=RV(1) REL.14 G(1)=RV(2) REL.14 IF(NC.EQ.1) GO TO 54 REL.14 G(10)=G(9) REL.14 IF(NC.GT.2) G(11)=G(9) REL.14 IF(NC.GT.3) G(12)=G(9) REL.14 K=NM(1) REL.14 DO 1041 J=1,K REL.14 I=NK(J,1) REL.14 IF(NT(I).LT.4) GO TO 1041 REL.14 Q1=A(I) REL.14 Q2=D(I) REL.14 CALL XYZF(I,J,KL5,Q1,Q2,H,X,Y,Z,ZW,FC) REL.14 G(2)=G(2)+FC(2)-G1(2)*Y(1)-G(10)*Y(2) REL.14 IF(NC.GT.2) G(3)=G(3)+FC(3)-G1(3)*Z(1)-G(11)*Z(2) REL.14 IF(NC.GT.3) G(4)=G(4)+FC(4)-G1(4)*ZW(1)-G(12)*ZW(2) REL.14 1041 CONTINUE REL.14 Q=NEX REL.14 G(2)=G(2)/Q REL.14 IF(NC.GT.2) G(3)=G(3)/Q REL.14 IF(NC.GT.3) G(4)=G(4)/Q REL.14 GO TO 54 REL.14 C REL.14 C K6K=10 REL.14 C REL.14 1040 IF(K6K.NE.10) GO TO 1045 REL.14 CALL RES(3,AEV,BS,RV) REL.14 G(5)=RV(1) REL.14 G(9)=RV(2) REL.14 G(1)=RV(3) REL.14 IF(NC.EQ.1) GO TO 54 REL.14 G(10)=G(9) REL.14 IF(NC.GT.2) G(11)=G(9) REL.14 IF(NC.GT.3) G(12)=G(9) REL.14 K=NM(1) REL.14 DO 1042 J=1,K REL.14 I=NK(J,1) REL.14 IF(NT(I).LT.4) GO TO 1042 REL.14 Q1=A(I) REL.14 Q2=D(I) REL.14 CALL XYZF(I,J,KL5,Q1,Q2,H,X,Y,Z,ZW,FC) REL.14 FC(2)=FC(2)-G(10)*Y(2) REL.14 IF(NC.GT.2) FC(3)=FC(3)-G(11)*Z(2) REL.14 IF(NC.GT.3) FC(4)=FC(4)-G(12)*ZW(2) REL.14 CALL SUMA(1,2,AEB,Y,FC(2)) REL.14 IF(NC.GT.2) CALL SUMA(1,2,AEU,Z,FC(3)) REL.14 IF(NC.GT.3) CALL SUMA(1,2,AEW,ZW,FC(4)) REL.14 1042 CONTINUE REL.14 CALL RES(2,AEB,BS,RB) REL.14 IF(NC.GT.2) CALL RES(2,AEU,BS,RU) REL.14 IF(NC.GT.3) CALL RES(2,AEW,BS,RW) REL.14 G1(2)=RB(1) REL.14 IF(NC.GT.2) G1(3)=RU(1) REL.14 IF(NC.GT.3) G1(4)=RW(1) REL.14 G0(2)=RB(2) REL.14 IF(NC.GT.2) G0(3)=RU(2) REL.14 IF(NC.GT.3) G0(4)=RW(2) REL.14 GO TO 54 REL.14 C REL.14 C K6K=20 REL.14 C REL.14 1045 IF(K6K.NE.20) GO TO 1047 REL.14 CALL RES(4,AEV,BS,RV) REL.14 G(5)=RV(1) REL.14 G(9)=RV(2) REL.14 G(13)=RV(3) REL.14 G(1)=RV(4) REL.14 IF(NC.EQ.1) GO TO 54 REL.14 G(10)=G(9) REL.14 G(14)=G(13) REL.14 IF(NC.GT.2) G(11)=G(9) REL.14 IF(NC.GT.2) G(15)=G(13) REL.14 IF(NC.GT.3) G(12)=G(9) REL.14 IF(NC.GT.3) G(16)=G(13) REL.14 K=NM(1) REL.14 DO 1044 J=1,K REL.14 I=NK(J,1) REL.14 IF(NT(I).LT.4) GO TO 1044 REL.14 Q1=A(I) REL.14 Q2=D(I) REL.14 CALL XYZF(I,J,KL5,Q1,Q2,H,X,Y,Z,ZW,FC) REL.14 FC(2)=FC(2)-G(10)*Y(2)-G(14)*Y(2)*Y(2) REL.14 IF(NC.GT.2) FC(3)=FC(3)-G(11)*Z(2)-G(15)*Z(2)*Z(2) REL.14 IF(NC.GT.3) FC(4)=FC(4)-G(12)*ZW(2)-G(16)*ZW(2)*ZW(2) REL.14 CALL SUMA(1,2,AEB,Y,FC(2)) REL.14 IF(NC.GT.2) CALL SUMA(1,2,AEU,Z,FC(3)) REL.14 IF(NC.GT.3) CALL SUMA(1,2,AEW,ZW,FC(4)) REL.14 1044 CONTINUE REL.14 CALL RES(2,AEB,BS,RB) REL.14 IF(NC.GT.2) CALL RES(2,AEU,BS,RU) REL.14 IF(NC.GT.3) CALL RES(2,AEW,BS,RW) REL.14 G1(2)=RB(1) REL.14 IF(NC.GT.2) G1(3)=RU(1) REL.14 IF(NC.GT.3) G1(4)=RW(1) REL.14 G0(2)=RB(2) REL.14 IF(NC.GT.2) G0(2)=RU(3) REL.14 IF(NC.GT.3) G0(2)=RW(3) REL.14 GO TO 54 REL.14 C REL.14 C K6K=21 REL.14 C REL.14 1047 IF(K6K.NE.21) GO TO 85 REL.14 CALL RES(3,AEV,BS,RV) REL.14 G(9)=RV(1) REL.14 G(13)=RV(2) REL.14 G(1)=RV(3) REL.14 IF(NC.EQ.1) GO TO 54 REL.14 G(10)=G(9) REL.14 G(14)=G(13) REL.14 IF(NC.GT.2) G(11)=G(9) REL.14 IF(NC.GT.2) G(15)=G(13) REL.14 IF(NC.GT.3) G(12)=G(9) REL.14 IF(NC.GT.3) G(16)=G(13) REL.14 K=NM(1) REL.14 DO 1048 J=1,K REL.14 I=NK(J,1) REL.14 IF(NT(I).LT.4) GO TO 1048 REL.14 Q1=A(I) REL.14 Q2=D(I) REL.14 CALL XYZF(I,J,KL5,Q1,Q2,H,X,Y,Z,ZW,FC) REL.14 G(2)=G(2)+FC(2)-G1(2)*Y(1)-G(10)*Y(2)-G(14)*Y(2)*Y(2) REL.14 IF(NC.GT.2) G(3)=G(3)+FC(3)-G1(3)*Z(1)-G(11)*Z(2)-G(15)*Z(2)*Z(2) REL.14 IF(NC.GT.3) REL.14 * G(4)=G(4)+FC(4)-G1(4)*ZW(1)-G(12)*ZW(2)-G(16)*ZW(2)*ZW(2) REL.14 1048 CONTINUE REL.14 Q=NEX REL.14 G(2)=G(2)/Q REL.14 IF(NC.GT.2) G(3)=G(3)/Q REL.14 IF(NC.GT.3) G(4)=G(4)/Q REL.14 GO TO 54 REL.14 C REL.14 C K6K=100, 200, 300, 400 & 500 REL.14 C REL.14 85 K=2+K6K/100 REL.14 CALL RES(K,AEV,BS,RV) REL.14 IF(NC.GT.1) CALL RES(K,AEB,BS,RB) REL.14 IF(NC.GT.2) CALL RES(K,AEU,BS,RU) REL.14 IF(NC.GT.3) CALL RES(K,AEW,BS,RW) REL.14 G1(1)=RV(1) REL.14 IF(NC.NE.1) G1(2)=RB(1) REL.14 IF(NC.GT.2) G1(3)=RU(1) REL.14 IF(NC.GT.3) G1(4)=RW(1) REL.14 GT(1)=RV(2) REL.14 IF(NC.GT.1) GT(2)=RB(2) REL.14 IF(NC.GT.2) GT(3)=RU(2) REL.14 IF(NC.GT.3) GT(4)=RW(2) REL.14 IF(K.EQ.3) GO TO 77 REL.14 GT2(1)=RV(3) REL.14 IF(NC.GT.1) GT2(2)=RB(3) REL.14 IF(NC.GT.2) GT2(3)=RU(3) REL.14 IF(NC.GT.3) GT2(4)=RW(3) REL.14 IF(K.EQ.4) GO TO 77 REL.14 GT3(1)=RV(4) REL.14 IF(NC.GT.1) GT3(2)=RB(4) REL.14 IF(NC.GT.2) GT3(3)=RU(4) REL.14 IF(NC.GT.3) GT3(4)=RW(4) REL.14 IF(K.EQ.5) GO TO 77 REL.14 GT4(1)=RV(5) REL.14 IF(NC.GT.1) GT4(2)=RB(5) REL.14 IF(NC.GT.2) GT4(3)=RU(5) REL.14 IF(NC.GT.3) GT4(4)=RW(5) REL.14 IF(K.EQ.6) GO TO 77 REL.14 GT5(1)=RV(6) REL.14 IF(NC.GT.1) GT5(2)=RB(6) REL.14 IF(NC.GT.2) GT5(3)=RU(6) REL.14 IF(NC.GT.3) GT5(4)=RW(6) REL.14 77 G0(1)=RV(K) REL.14 IF(NC.GT.1) G0(2)=RB(K) REL.14 IF(NC.GT.2) G0(3)=RU(K) REL.14 IF(NC.GT.3) G0(4)=RW(K) REL.14 GO TO 54 REL.14 C C ITERATING THE LINEAR EXTINCTION COEFFICIENTS REL.14 C 54 IF(KL6.NE.0) GO TO 1031 IF(DABS((G1(1)-G1B(1))/G1(1)).GT.1.0D-5) KLEX=1 IF(NC.GT.1.AND.DABS((G1(2)-G1B(2))/G1(2)).GT.1.0D-5) KLEX=1 IF(NC.GT.2.AND.DABS((G1(3)-G1B(3))/G1(3)).GT.1.0D-5) KLEX=1 IF(NC.GT.3.AND.DABS((G1(4)-G1B(4))/G1(4)).GT.1.0D-5) KLEX=1 IF(KLEX.EQ.0) GO TO 1031 KLEX=0 DO 1032 J=1,NC 1032 G1B(J)=G1(J) GO TO 100 C C RE-CALCULATION OF ZERO-POINT COEFFICIENTS REL.14 C USING OBJECTS OF TYPE 7 TO 9 ONLY REL.14 C 1031 K=NM(1) M=0 CALL NUL(4,AEV) DO 67 J=1,K I=NK(J,1) IF(NT(I).LT.7) GO TO 67 M=M+1 Q1=A(I) Q2=D(I) CALL XYZF(I,J,KL5,Q1,Q2,H,X,Y,Z,ZW,FC) AEV(1)=AEV(1)+FC(1)-G1(1)*X(1)-GT(1)*X(2) REL.14 IF(K6K.GT.100) AEV(1)= REL.14 *AEV(1)-GT2(1)*X(3)-GT3(1)*X(4)-GT4(1)*X(5)-GT5(1)*X(6) REL.14 IF(K6K.LT.100) AEV(1)=AEV(1)-GT2(1)*X(2)*X(2) REL.14 IF(NC.LT.2) GO TO 67 REL.14 AEV(2)=AEV(2)+FC(2)-G1(2)*Y(1)-GT(2)*Y(2) REL.14 IF(K6K.GT.100) AEV(2)= REL.14 *AEV(2)-GT2(2)*Y(3)-GT3(2)*Y(4)-GT4(2)*Y(5)-GT5(2)*Y(6) REL.14 IF(K6K.LT.100) AEV(2)=AEV(2)-GT2(2)*Y(2)*Y(2) REL.14 IF(NC.LT.3) GO TO 67 REL.14 AEV(3)=AEV(3)+FC(3)-G1(3)*Z(1)-GT(3)*Z(2) REL.14 IF(K6K.GT.100) AEV(3)= REL.14 *AEV(3)-GT2(3)*Z(3)-GT3(3)*Z(4)-GT4(3)*Z(5)-GT5(3)*Z(6) REL.14 IF(K6K.LT.100) AEV(3)=AEV(3)-GT2(3)*Z(2)*Z(2) REL.14 IF(NC.LT.4) GO TO 67 REL.14 AEV(4)=AEV(4)+FC(4)-G1(4)*ZW(1)-GT(4)*ZW(2) REL.14 IF(K6K.GT.100) AEV(4)=AEV(4)-GT2(4)*ZW(3) REL.14 *-GT3(4)*ZW(4)-GT4(4)*ZW(5)-GT5(4)*ZW(6) REL.14 IF(K6K.LT.100) AEV(4)=AEV(4)-GT2(4)*ZW(2)*ZW(2) REL.14 67 CONTINUE IF(M.LE.0) GO TO 55 Q=M G(1)=AEV(1)/Q IF(NC.GT.1) G(2)=AEV(2)/Q REL.14 IF(NC.GT.2) G(3)=AEV(3)/Q REL.14 IF(NC.GT.3) G(4)=AEV(4)/Q REL.14 C 55 IF(L123.GT.0) GO TO 43 IF(L123.LT.0.AND.K9K.LT.100) GO TO 43 TX(1)=TQ(2) IF(KL6.EQ.1) TX(1)=TQ(1) IF(K11K.EQ.0) GO TO 43 WRITE(9,203) G1,TX(1),H(5),H(11),H(17),H(23),TQ(1) WRITE(9,202) G0 WRITE(9,224) GT,GT2,GT3,GT4,GT5 C C C PRINT OF EXTINCTION-STAR OBSERVATIONS C 43 K=NM(1) IF(K.LT.1) GO TO 1 IF(NEX.EQ.0) GO TO 15 J1=S(1,1)+GEO-2400000D0 IF (NFIL3.NE.0.AND.KL6.NE.1) WRITE(4,108) J1,G1 IF(KEY11.GT.0) CALL GRAF(0,NC,S(J,1),DEM) REL.14 IF(L123.LT.0.AND.K9K.LT.100) GO TO 82 IF(L123.LE.0.AND.K11K.GE.3.AND.K1K.EQ.3) WRITE(9,2114) J1 REL.14 IF(L123.LE.0.AND.K11K.GE.3.AND.NC.LE.3.AND.K1K.NE.3) REL.14 * WRITE(9,214) J1 IF(L123.LE.0.AND.K11K.GE.3.AND.NC.EQ.4) WRITE(9,2214) J1 IF(L123.LE.0.AND.K11K.EQ.2.AND.NC.LE.3) WRITE(9,233) IF(L123.LE.0.AND.K11K.EQ.2.AND.NC.EQ.4) WRITE(9,228) C 82 NOEH=0 REL.14 DO 24 J=1,K I=NK(J,1) IF(NT(I).LT.4) GO TO 24 NOEH=NOEH+1 REL.14 Q1=A(I) Q2=D(I) Q=S(J,2)+GEO Q11=S(J,1)+GEO IF(NC.GT.1) GO TO 95 Q=Q11 GO TO 96 95 CALL HMOTA(Q1,Q2,Q) AI2=AIR IF(KL5.NE.1) GO TO 60 IF(NC.LT.3) GO TO 96 CALL HMOTA(Q1,Q2,S(J,3)+GEO) AI3=AIR IF(NC.LT.4) GO TO 96 CALL HMOTA(Q1,Q2,S(J,4)+GEO) AI4=AIR 96 CALL HMOTA(Q1,Q2,Q11) AI1=AIR GO TO 70 60 AI1=AIR AI3=AIR AI4=AIR 70 CALL MAG(0,J,AI1,AI2,AI3,AI4,H) Q11=C(1,I) Q12=C(2,I) Q13=C(3,I) Q14=C(4,I) DM(3)=VJ(1)-Q11 IF(K1K.EQ.3) DM(3)=VJ(1)-Q12+Q11 REL.14 DM(4)=VJ(2)-Q12 DM(5)=VJ(3)-Q13 DM(6)=VJ(4)-Q14 DM(7)=DM(4)-DM(3) DM(8)=DM(5)-DM(4) Q1=DM(3)*DM(3) Q2=DM(4)*DM(4) Q3=DM(5)*DM(5) Q4=DM(6)*DM(6) Q9=DM(7)*DM(7) Q10=DM(8)*DM(8) IF(K9K.LT.100.OR.NT(I).LT.7) GO TO 31 VEM(1)=Q12-Q11 VEM(2)=Q13-Q12 VEM(3)=VEM(1)*VEM(1) VEM(4)=VEM(1)*VEM(3) Q16=G(6)-G(5) IF(K1K.EQ.3) Q16=G(5) REL.14 Q15=Q16*AI1 VEM(5)=Q15*(VEM(1)+5D-1*Q15) JES(1)=JKS(K12V+1)-K12K DO 1013 JN=1,4 1013 VX(JN)=VEM(JN) JN=JES(1) JN1=JN+1 PS=VEX(1) REL.14 IF(K1K.NE.3) PS=PS-Q11 REL.14 IF(K12K.NE.0) PS=PS-H(5)*VEM(5) IF(K12K.EQ.0) VX(JN)=VEM(5) CALL SUMA(JN,JN1,ACV,VX,PS) C Q15=Q16*AI2 VEM(5)=Q15*(VEM(1)+5D-1*Q15) JES(2)=JKS(K12B+1)-K12K DO 1014 JN=1,4 1014 VX(JN)=VEM(JN) JN=JES(2) JN1=JN+1 PS=VEX(2)-Q12 IF(K12K.NE.0) PS=PS-H(11)*VEM(5) IF(K12K.EQ.0) VX(JN)=VEM(5) CALL SUMA(JN,JN1,ACB,VX,PS) C Q16=G(7)-G(6) Q15=AI3*Q16 VEM(5)=Q15*(VEM(2)+5D-1*Q15) JES(3)=JKS(K12U+1)-K12K DO 1015 JN=1,4 1015 VX(JN)=VEM(JN) JN=JES(3) JN1=JN+1 PS=VEX(3)-Q13 IF(K12K.NE.0) PS=PS-H(17)*VEM(5) IF(K12K.EQ.0) VX(JN)=VEM(5) CALL SUMA(JN,JN1,ACU,VX,PS) C IF(NC.LT.4) GO TO 1001 Q15=AI4*Q16 VEM(5)=Q15*(VEM(2)+5D-1*Q15) JES(4)=JKS(K12W+1)-K12K DO 1030 JN=1,4 1030 VX(JN)=VEM(JN) JN=JES(4) JN1=JN+1 PS=VEX(4)-Q14 IF(K12K.NE.0) PS=PS-H(23)*VEM(5) IF(K12K.EQ.0) VX(JN)=VEM(5) CALL SUMA(JN,JN1,ACW,VX,PS) 1001 NUC=NUC+1 RMS(1)=RMS(1)+Q1 RMS(2)=RMS(2)+Q2 RMS(3)=RMS(3)+Q3 IF(NC.EQ.4) RMS(4)=RMS(4)+Q4 31 IF(L123.GT.0) GO TO 24 RME(1)=RME(1)+Q1 IF(NC.GT.1) RME(2)=RME(2)+Q2 IF(NC.GT.2) RME(3)=RME(3)+Q3 IF(NC.EQ.4) RME(4)=RME(4)+Q4 IF(NC.GT.1) RME(5)=RME(5)+Q9 IF(NC.GT.2) RME(6)=RME(6)+Q10 Q10=24D0*S(J,IB)-PAS J1=Q10 Q9=J1 Q10=60D0*(Q10-Q9) DM(1)=VJ(2)-VJ(1) DM(2)=VJ(3)-VJ(2) IS=IST(1) IF(NT(I).GE.7) IS=IST(2) Q=0D0 REL.15 DO 1037 IJ=1,NC REL.15 1037 Q=Q+S(J,IJ) REL.15 QNC=NC REL.15 Q=Q/QNC+GEO REL.15 IF(NOEH.EQ.1) JZN=Q REL.14 Q=Q-JZN REL.14 AIR=AI2 IF(NC.EQ.1) AIR=AI1 IF(KEY11.GT.0) CALL GRAF(1,NC,Q,DEM) REL.14 IF(L123.LT.0.AND.K9K.LT.100) GO TO 24 IF(K11K.GE.3.AND.NC.EQ.4) 1 WRITE(9,204) IS,HVZ(I,1),HVZ(I,2),HVZ(I,3),Q9,Q10,Q, 2 VJ,DM,AIR,EXT REL.14 IF(K11K.GE.3.AND.NC.LT.4.AND.K1K.NE.3) REL.14 * WRITE(9,204) IS,HVZ(I,1),HVZ(I,2), * HVZ(I,3),Q9,Q10,Q,(VJ(J1),J1=1,3),(DM(J1),J1=1,5), * DM(7),DM(8),AIR,(EXT(J1),J1=1,3) REL.14 IF(K11K.GE.3.AND.K1K.EQ.3) WRITE(9,204) IS,HVZ(I,1),HVZ(I,2), REL.14 * HVZ(I,3),Q9,Q10,Q,VJ(1),DM(3),AIR,EXT(1) REL.14 IF(K11K.EQ.2.AND.NC.LT.4) * WRITE(9,230) IS,HVZ(I,1),HVZ(I,2),HVZ(I,3),Q9,Q10, * VJ(1),(DM(J1),J1=1,5),DM(7),DM(8),AIR IF(K11K.EQ.2.AND.NC.EQ.4) *WRITE(9,230) IS,HVZ(I,1),HVZ(I,2),HVZ(I,3),Q9,Q10,DM,AIR 24 CONTINUE C 83 IF(L123.GT.0) GO TO 1 IF(NEX.LE.1.OR.(L123.LT.0.AND.K9K.LT.100)) GO TO 15 Q=NEX-1 Q=1D0/Q DO 35 J=1,6 35 RME(J)=DSQRT(Q*RME(J)) IF(K11K.GE.3.AND.NC.EQ.4) WRITE(9,2218) RME IF(K11K.GE.3.AND.NC.LT.4.AND.K1K.NE.3) REL.14 * WRITE(9,218) (RME(J),J=1,3),RME(5),RME(6) IF(K11K.GE.3.AND.K1K.EQ.3) REL.14 * WRITE(9,2318) RME(1) REL.14 IF(K11K.EQ.2.AND.NC.EQ.4) WRITE(9,234) RME IF(K11K.EQ.2.AND.NC.LT.4) * WRITE(9,229) (RME(J),J=1,3),RME(5),RME(6) 15 IF(KEY11.GT.0) CALL GRAF(2,NC,S(J,1),DEM) REL.14 IF(NFIL.EQ.0.AND.K11K.LT.3) GO TO 1 IF(L123.LT.0.AND.NFIL.EQ.0) GO TO 1 C C C COMPUTING JOHNSON'S MAGNITUDES FOR TYPE 1-3 OBJECTS C K=NM(1) DO 63 I=1,K J=NK(I,1) IF(NT(J).GT.3) GO TO 63 Q1=A(J) Q2=D(J) IF(NC.EQ.1) GO TO 97 CALL HMOTA(Q1,Q2,S(I,2)+GEO) AI2=AIR IF(KL5.NE.1) GO TO 68 CALL HMOTA(Q1,Q2,S(I,3)+GEO) AI3=AIR IF(NC.LT.4) GO TO 97 CALL HMOTA(Q1,Q2,S(I,4)+GEO) AI4=AIR 97 CALL HMOTA(Q1,Q2,S(I,1)+GEO) AI1=AIR GO TO 69 68 AI1=AIR AI3=AIR AI4=AIR 69 CALL MAG(0,I,AI1,AI2,AI3,AI4,H) 63 CONTINUE IF(K1K.EQ.2) GO TO 30 C C C K1K=0: COMPUTING MAGNITUDE DIFFERENCES VAR-COMP C N=NM(1) DO 45 J=1,N 45 NCOMP(J)=0 CALL INDX(1,J1,J3) IF(J1.EQ.1) GO TO 22 IF(J1.GT.1) GO TO 46 WRITE(9,302) K1K=2 GO TO 30 46 K=J1-1 DO 23 I=1,K NCOMP(I)=J3 DO 23 J=1,NC 23 VD(I,J)=V(I,J)-V(J1,J) 22 K=J1+1 IF(K.GT.N) GO TO 30 CALL INDX(K,J2,J4) IF(J2.LT.0) GO TO 61 IF(J2.EQ.K) GO TO 9 L=J2-1 IF(J3.EQ.J4) GO TO 90 DO 89 I=K,L Q1=S(J1,IB) Q2=S(J2,IB) M=J3 M1=J1 Q3=S(I,IB) IF(DABS(Q3-Q1).LE.DABS(Q3-Q2)) GO TO 88 M=J4 M1=J2 88 NCOMP(I)=M DO 89 J=1,NC 89 VD(I,J)=V(I,J)-V(M1,J) GO TO 9 90 DO 32 J=1,NC Q1=S(J1,J) Q11=V(J1,J) Q=(V(J2,J)-Q11)/(S(J2,J)-Q1) DO 32 I=K,L 32 VD(I,J)=V(I,J)-Q*(S(I,J)-Q1)-Q11 DO 33 I=K,L 33 NCOMP(I)=J3 9 J1=J2 J3=J4 GO TO 22 61 DO 62 I=K,N NCOMP(I)=J3 DO 62 J=1,NC 62 VD(I,J)=V(I,J)-V(J1,J) C C C PRINT OF MAGNITUDES AND INDICES OF INDIVIDUAL STARS C 30 KL9=K9K REL.14 IF(K9K.GE.100) KL9=K9K-100 REL.14 K9K=K9K+1000*J6K(KL6+1)+10000*NOBS DO 25 I=NMIN,NMAX IF(NH(I,1).EQ.0) GO TO 25 J1=NM(1) IF(K11K.GT.2.AND.NC.LT.4) * WRITE(9,205) HVZ(I,1),HVZ(I,2),HVZ(I,3),HD(I) IF(K11K.GT.2.AND.NC.EQ.4) * WRITE(9,2205) HVZ(I,1),HVZ(I,2),HVZ(I,3),HD(I) NEX=0 NED=0 CALL NUL(13,B) CALL NUL(8,RMD) DO 26 J=1,J1 K=NK(J,1) IF(K.NE.I) GO TO 26 NEX=NEX+1 Q=0D0 REL.15 DO 1038 IJ=1,NC REL.15 1038 Q=Q+S(J,IJ) REL.15 QNC=NC REL.15 Q=Q/QNC REL.15 Q3=24D0*Q-PAS L=Q3 Q8=L Q5=60D0*(Q3-Q8) CALL HMOTA(A(K),D(K),Q+GEO) Q7=Q+HJD(K) VJ(1)=V(J,1) VJ(2)=V(J,2) VJ(3)=V(J,3) VJ(4)=V(J,4) Q1=VJ(2)-VJ(1) Q2=VJ(3)-VJ(2) DO 56 L=1,4 M=L+6 Q3=VJ(L) B(L)=B(L)+Q3 IF(L.GT.NC) GO TO 56 B(M)=B(M)+Q3*Q3 56 CONTINUE B(5)=B(5)+Q1 B(6)=B(6)+Q2 IF(NC.GT.1) B(11)=B(11)+Q1*Q1 IF(NC.GT.2) B(12)=B(12)+Q2*Q2 B(13)=B(13)+Q7 Q111=Q1 Q222=Q2 KPR=NCOMP(J) IF((K1K.EQ.2.OR.KPR.EQ.0).AND.K11K.GT.2.AND.NC.LT.4) * WRITE(9,206) Q8,Q5,Q7,(VJ(L),L=1,3),Q1,Q2,AIR IF((K1K.EQ.2.OR.KPR.EQ.0).AND.K11K.GT.2.AND.NC.EQ.4) * WRITE(9,206) Q8,Q5,Q7,VJ,Q1,Q2,AIR IF(NFIL.EQ.0.AND.K11K.LT.3) GO TO 26 C C OUTPUT OF DATA FOR ARCHIVES C M=4 IF(NC.EQ.4) M=5 JD=IDNINT(1D4*(Q7-2400000D0)) VJH(1)=VJ(1) VJH(2)=VJ(2) VJH(3)=VJ(3) IF(NC.EQ.4) VJH(4)=VJ(4) VJH(M)=AIR IF(KL9.LT.10) GO TO 76 REL.14 K=0 IF(NFIL2.NE.0.AND.NC.LT.4) WRITE(2) HD(I),JD,KOBS,K9K,VJH,K IF(NFIL2.NE.0.AND.NC.EQ.4) WRITE(2) HD(I),JD,KOBS,K9K,VST,K 76 IF(K1K.EQ.2) GO TO 26 REL.14 IF(NFIL1.EQ.0.AND.K11K.LT.3) GO TO 26 K=NCOMP(J) IF(K.LE.0) GO TO 26 NED=NED+1 CALL HMOTA(A(K),D(K),Q+GEO) Q1=VD(J,1) Q2=VD(J,2) Q3=VD(J,3) Q4=VD(J,4) IF(NC.LT.4) Q4=1D9 IF(NC.LT.3) Q3=4D9 IF(NC.LT.2) Q2=2D20 VJH(1)=Q1 VJH(2)=Q2 VJH(3)=Q3 IF(NC.EQ.4) VJH(4)=Q4 VJH(M+1)=VJH(M)-AIR IF(NFIL1.NE.0.AND.NC.LT.4) WRITE(1) HD(I),JD,KOBS,K9K,VJH,HD(K) IF(NFIL1.NE.0.AND.NC.EQ.4) WRITE(1) HD(I),JD,KOBS,K9K,VST,HD(K) C C C PRINT OF DIFFERENTIAL MAGNITUDE AND INDICES C Q1=Q1+C(1,K) Q2=Q2+C(2,K) Q3=Q3+C(3,K)-Q2 Q4=Q4+C(4,K) Q2=Q2-Q1 RMD(1)=RMD(1)+Q1 IF(NC.GT.1) RMD(2)=RMD(2)+Q2 IF(NC.GT.2) RMD(3)=RMD(3)+Q3 IF(NC.GT.3) RMD(4)=RMD(4)+Q4 RMD(5)=RMD(5)+Q1*Q1 IF(NC.GT.1) RMD(6)=RMD(6)+Q2*Q2 IF(NC.GT.2) RMD(7)=RMD(7)+Q3*Q3 IF(NC.GT.3) RMD(8)=RMD(8)+Q4*Q4 IF(K11K.GT.2.AND.NC.LT.4) WRITE(9,219) Q8,Q5,Q7,(VJ(J1),J1=1,3), * Q111,Q222,VJH(M),Q1,Q2,Q3,VJH(M+1),HD(K) IF(K11K.GT.2.AND.NC.EQ.4) WRITE(9,2219) Q8,Q5,Q7,VJ,Q111,Q222, * VJH(M),Q1,Q2,Q3,Q4,VJH(M+1),HD(K) 26 CONTINUE C C C COMPUTATION AND PRINT OF MEAN VALUES AND RMS ERRORS C KPR=1 J=NT(I) IF(J.EQ.2.OR.J.EQ.5.OR.J.EQ.8) KPR=0 IF((K1K.EQ.2.OR.KPR.EQ.0).AND.K11K.GT.2) KPR=2 Q1=NEX Q2=NEX-1 Q1=1D0/Q1 DO 57 L=1,6 M=L+6 Q3=B(L) Q4=Q1*Q3 B(L)=Q4 IF(L.LE.4) PRM(L)=Q4-C(L,I) IF(NEX.LT.2) GO TO 66 Q3=(B(M)-Q1*Q3*Q3)/Q2 REL.13.1 IF(Q3.LE.0D0) GO TO 66 B(M)=DSQRT(Q3) GO TO 57 66 B(M)=0D0 57 CONTINUE B(13)=B(13)*Q1 PRM(5)=B(5)-C(2,I)+C(1,I) PRM(6)=B(6)-C(3,I)+C(2,I) IF(KPR.EQ.2.AND.NEX.GT.1.AND.NC.LT.4) * WRITE(9,217) B(13),(B(L),L=1,3),B(5),B(6) IF(KPR.EQ.2.AND.NEX.GT.1.AND.NC.EQ.4) * WRITE(9,2217) B(13),(B(L),L=1,6) IF(NED.LE.0) GO TO 64 Q1=NED Q2=NED-1 Q1=1D0/Q1 DO 50 L=1,4 M=L+4 Q3=RMD(L) Q4=Q1*Q3 RMD(L)=Q4 PM(L)=Q4-C(L,I) IF(NED.GE.2.AND.L.LE.NC) GO TO 65 RMD(M)=0D0 GO TO 50 65 RMD(M)=DSQRT((RMD(M)-Q1*Q3*Q3)/Q2) REL.13.1 50 CONTINUE PM(2)=PM(2)+C(1,I) PM(3)=PM(3)+C(2,I) IF(NC.EQ.1) PM(2)=0D0 IF(NC.LT.3) PM(3)=0D0 IF(K11K.LT.3) GO TO 25 IF(NED.GT.1.AND.NC.LT.4) * WRITE(9,217) B(13),(B(L),L=1,3),B(5),B(6),(RMD(L),L=1,3) IF(NED.GT.1.AND.NC.EQ.4) * WRITE(9,2217) B(13),(B(L),L=1,6),(RMD(L),L=1,4) 64 IF(K11K.LT.3) GO TO 25 IF(KPR.EQ.2) GO TO 98 IF(NED.GT.1.AND.NC.LT.4) * WRITE(9,221) (B(L),L=7,9),B(11),B(12),(RMD(L),L=5,7) IF(NED.GT.1.AND.NC.EQ.4) * WRITE(9,2221) (B(L),L=7,12),(RMD(L),L=5,8) IF(NC.LT.4) * WRITE(9,222) (PRM(L),L=1,3),PRM(5),PRM(6),(PM(L),L=1,3) IF(NC.EQ.4) WRITE(9,2222) PRM,PM GO TO 25 98 IF(NEX.GT.1.AND.NC.LT.4) WRITE(9,221) (B(L),L=7,9),B(11),B(12) IF(NEX.GT.1.AND.NC.EQ.4) WRITE(9,2221) (B(L),L=7,12) IF(NC.LT.4) WRITE(9,222) (PRM(L),L=1,3),PRM(5),PRM(6) IF(NC.EQ.4) WRITE(9,2222) PRM 25 CONTINUE GO TO 1 C C C COMPUTING THE COLOUR COEFFICIENTS C 7 IF(L123.LT.0) GO TO 2 JN=JES(1)+1 CALL RES(JN,ACV,BS,HHH) IF(K12V.LT.2) GO TO 1003 JN1=1 GO TO 1016 1003 IF(K12V.LT.1) GO TO 1005 JN1=2 GO TO 1016 1005 JN1=4 1016 DO 1017 J=1,JN1 1017 HV(J)=HHH(J) IF(K12K.EQ.0) HV(5)=HHH(JN-1) HV(6)=HHH(JN) C IF(NC.LT.2) GO TO 1004 REL.14 JN=JES(2)+1 CALL RES(JN,ACB,BS,HHH) IF(K12B.LT.2) GO TO 1018 JN1=1 GO TO 1019 1018 IF(K12B.LT.1) GO TO 1020 JN1=2 GO TO 1019 1020 JN1=4 1019 DO 1021 J=1,JN1 1021 HB(J)=HHH(J) IF(K12K.EQ.0) HB(5)=HHH(JN-1) HB(6)=HHH(JN) C IF(NC.LT.3) GO TO 1004 REL.14 JN=JES(3)+1 CALL RES(JN,ACU,BS,HHH) IF(K12U.LT.2) GO TO 1022 JN1=1 GO TO 1023 1022 IF(K12U.LT.1) GO TO 1024 JN1=2 GO TO 1023 1024 JN1=4 1023 DO 1025 J=1,JN1 1025 HU(J)=HHH(J) IF(K12K.EQ.0) HU(5)=HHH(JN-1) HU(6)=HHH(JN) C IF(NC.LT.4) GO TO 1004 JN=JES(4)+1 CALL RES(JN,ACW,BS,HHH) IF(K12W.LT.2) GO TO 1026 JN1=1 GO TO 1027 1026 IF(K12W.LT.1) GO TO 1028 JN1=2 GO TO 1027 1028 JN1=4 1027 DO 1029 J=1,JN1 1029 HW(J)=HHH(J) IF(K12K.EQ.0) HW(5)=HHH(JN-1) HW(6)=HHH(JN) 1004 DO 1002 J=5,23,6 IF(H(J).GT.0D0) H(J)=0D0 1002 CONTINUE ITER=ITER+1 Q=NUC-1 Q=1D0/Q DO 36 J=1,NC 36 RMS(J)=DSQRT(Q*RMS(J)) WRITE(6,216) ITER WRITE(6,227) WRITE(6,207) H IF(K11K.EQ.0) GO TO 18 WRITE(9,216) ITER WRITE(9,227) WRITE(9,207) H 18 DO 37 J=1,NC IF(DABS(RMS(J)-RM(J)).GT.7D-5) GO TO 38 37 CONTINUE DO 29 J=1,24 IF(DABS(H(J)-HH(J)).GT.7D-4) GO TO 38 29 CONTINUE L123=-1 GO TO 39 38 L123=1 RM(1)=RMS(1) RM(2)=RMS(2) RM(3)=RMS(3) RM(4)=RMS(4) C DO 44 J=1,24 HH(J)=H(J) 44 CONTINUE 39 REWIND 3 REWIND 11 WRITE(6,215) RMS IF(K11K.GT.0) WRITE(9,215) RMS READ(3,107) I,J,K M=3 IF(I.NE.0) M=M+1 IF(J.NE.0) M=M+1 IF(K.NE.0) M=M+1 DO 40 J=1,M 40 READ(3,102) Q GO TO 5 C 2 CONTINUE IF(NFIL1.NE.0) ENDFILE 1 IF(NFIL2.NE.0) ENDFILE 2 STOP 7 END