SUBROUTINE WRITEMDL C Writes the predicted positions for a set of orbital elements to the C output file OUTFILE (device PR), along with the elements. C 1 May 1991 Original version J.T. Armstrong IMPLICIT UNDEFINED (A-Z) INCLUDE 'PARAMETR.INC' INCLUDE 'ELLIPSE.INC' CHARACTER*1 CHOICE CHARACTER*80 INS REAL*8 RMOD,THMOD,RAMOD,DECMOD,RADIFF,DECDIFF REAL*8 A(7),DYDA(7) INTEGER*4 I WRITE(PR,*) 'WRITEMDL: Writes predicted positions' WRITE(PR,100) WRITE(PR,101) C ASK FOR THE ELEMENTS WRITE(INS,1001) A_TRUE, VALS(53) CALL LOCATE(0,2) CALL EGA_RESTORE_DEFAULT CALL WRITE_STRING( INS ) CALL PGCURSE(XR,YR,CHOICE) CALL CAPS(CHOICE) IF (CHOICE.EQ.'C') THEN A(1) = A_TRUE ELSE IF (CHOICE.EQ.'K') THEN A(1) = VALS(53) ELSE CALL LOCATE(0,2) CALL WRITE_STRING(' ') CALL LOCATE(0,2) CALL WRITE_STRING('Value for semimajor axis: ') READ(INC,*) A(1) END IF WRITE(INS,1002) E_TRUE, VALS(54) CALL LOCATE(0,2) CALL EGA_RESTORE_DEFAULT CALL WRITE_STRING( INS ) CALL PGCURSE(XR,YR,CHOICE) CALL CAPS(CHOICE) IF (CHOICE.EQ.'C') THEN A(2) = E_TRUE ELSE IF (CHOICE.EQ.'K') THEN A(2) = VALS(54) ELSE CALL LOCATE(0,2) CALL WRITE_STRING(' ') CALL LOCATE(0,2) CALL WRITE_STRING('Value for ellipticity: ') READ(INC,*) A(2) END IF WRITE(INS,1003) PERIOD, VALS(55) CALL LOCATE(0,2) CALL EGA_RESTORE_DEFAULT CALL WRITE_STRING( INS ) CALL PGCURSE(XR,YR,CHOICE) CALL CAPS(CHOICE) IF (CHOICE.EQ.'C') THEN A(3) = PERIOD ELSE IF (CHOICE.EQ.'K') THEN A(3) = VALS(55) ELSE CALL LOCATE(0,2) CALL WRITE_STRING(' ') CALL LOCATE(0,2) CALL WRITE_STRING('Value for period: ') READ(INC,*) A(3) END IF WRITE(INS,1004) EPOCH, VALS(49) CALL LOCATE(0,2) CALL EGA_RESTORE_DEFAULT CALL WRITE_STRING( INS ) CALL PGCURSE(XR,YR,CHOICE) CALL CAPS(CHOICE) IF (CHOICE.EQ.'C') THEN A(4) = EPOCH ELSE IF (CHOICE.EQ.'K') THEN A(4) = VALS(49) ELSE CALL LOCATE(0,2) CALL WRITE_STRING(' ') CALL LOCATE(0,2) CALL WRITE_STRING('Value for epoch: ') READ(INC,*) A(4) END IF WRITE(INS,1005) INCLIN/RPDEG, VALS(50) CALL LOCATE(0,2) CALL EGA_RESTORE_DEFAULT CALL WRITE_STRING( INS ) CALL PGCURSE(XR,YR,CHOICE) CALL CAPS(CHOICE) IF (CHOICE.EQ.'C') THEN A(5) = INCLIN ELSE IF (CHOICE.EQ.'K') THEN A(5) = VALS(50)*RPDEG ELSE CALL LOCATE(0,2) CALL WRITE_STRING(' ') CALL LOCATE(0,2) CALL WRITE_STRING('Value for inclination (deg): ') READ(INC,*) A(5) A(5) = A(5)*RPDEG END IF WRITE(INS,1006) ASC_NODE/RPDEG, VALS(52) CALL LOCATE(0,2) CALL EGA_RESTORE_DEFAULT CALL WRITE_STRING( INS ) CALL PGCURSE(XR,YR,CHOICE) CALL CAPS(CHOICE) IF (CHOICE.EQ.'C') THEN A(6) = ASC_NODE ELSE IF (CHOICE.EQ.'K') THEN A(6) = VALS(52)*RPDEG ELSE CALL LOCATE(0,2) CALL WRITE_STRING(' ') CALL LOCATE(0,2) CALL WRITE_STRING('Value for ascending node (deg): ') READ(INC,*) A(6) A(6) = A(6)*RPDEG END IF WRITE(INS,1007) ARG_PERI/RPDEG, VALS(51) CALL LOCATE(0,2) CALL EGA_RESTORE_DEFAULT CALL WRITE_STRING( INS ) CALL PGCURSE(XR,YR,CHOICE) CALL CAPS(CHOICE) IF (CHOICE.EQ.'C') THEN A(7) = ARG_PERI ELSE IF (CHOICE.EQ.'K') THEN A(7) = VALS(51)*RPDEG ELSE CALL LOCATE(0,2) CALL WRITE_STRING(' ') CALL LOCATE(0,2) CALL WRITE_STRING('Value for arg. of periastron (deg): ') READ(INC,*) A(7) A(7) = A(7)*RPDEG END IF C CALCULATE APPARENT PLACES AND WRITE TO FILE DO I=1,NPTS IF(.NOT.DELETE(I)) THEN CALL TRUE2APP(TOBS(I),A,RMOD,THMOD,RAMOD,DECMOD,DYDA,PR) RADIFF = ROBS(I)*SIN(THETAOBS(I)) - RAMOD DECDIFF = ROBS(I)*COS(THETAOBS(I)) - DECMOD WRITE(PR,102) I,TSTRING(I),R_EST(I),THETA_EST(I)/RPDEG, 1 RAMOD,DECMOD,DELRA(I),DELDEC(I),RADIFF,DECDIFF ELSE WRITE(PR,103) I,TSTRING(I) END IF END DO RETURN C FORMAT statements: 100 FORMAT(1X,' ', 1 '"RA" "Dec" RA Dec') 101 FORMAT(1X,' I DATE Sep(mas) P.A.(deg) RA(mas) Dec(mas) ', 1 ' O-C O-C O-C O-C') 102 FORMAT(1X,I2,1X,A,4(F9.3),2(F7.3),1X,2(F7.3)) 103 FORMAT( 1X,I2,1X,I6': This point deleted from fit.') 1001 FORMAT(1X,'SEMIMAJ: [C]alculated (',F9.4,'), [K]EYIN (', 1 F9.4,') or [O]ther value? [O] ') ! 78 characters 1002 FORMAT(1X,'ELLIPTICITY: [C]alc. (',F9.4,'), [K]EYIN (', 1 F9.4,') or [O]ther value? [O] ') ! 78 characters 1003 FORMAT(1X,'PERIOD: [C]alculated (',F9.4,'), [K]EYIN (', 1 F9.4,') or [O]ther value? [O] ') ! 78 characters 1004 FORMAT(1X,'EPOCH: [C]alculated (',F11.3,'), [K]EYIN (', 1 F11.3,') or [O]ther value? [O]') ! 78 characters 1005 FORMAT(1X,'INCLIN: [C]alculated (',F7.2,'), [K]EYIN (', 1 F7.2,') or [O]ther value? [O] ') ! 78 characters 1006 FORMAT(1X,'ASC. NODE: [C]alculated (',F7.2,'), [K]EYIN (', 1 F7.2,') or [O]ther value? [O] ') ! 78 characters 1007 FORMAT(1X,'ARG. PERI: [C]alculated (',F7.2,'), [K]EYIN (', 1 F7.2,') or [O]ther value? [O] ') ! 78 characters C Templates for FORMAT statements 100, 101, 102: C "RA" "Dec" RA Dec C I DATE Sep(mas) P.A.(deg) RA(mas) Dec(mas) O-C O-C O-C O-C C 99 890618 121.234 303.215 121.234 121.234 1.234 1.234 1.234 1.234 END