C* SUBROUTINE GEGRAP(D24HPN,D24JSK,MAXRAP,NANT ,RECNAM,ANTNAM, 1 ANTNUM,OPTRAP,NRAP ,RANRAP,ANURAP,SIGRAP, 2 IRCODE) CC CC NAME : GEGRAP CC CC PURPOSE : GET DEFINITIONS FOR RECEIVER ANTENNA PATTERN CC PARAMETER ESTIMATION CC (PGM GPSEST_P) CC CC PARAMETERS : CC IN : D24HPN : DATA PANEL FILENAME (REC.ANT.PAT) CH*80 CC D24JSK : DATA PANEL SKELETON (REC.ANT.PAT) CH*80 CC MAXRAP : MAXIMUM NUMBER OF REC.ANT. PATTERNS I*4 CC NANT : NUMBER OF DIFFERENT RECEIVER/ANT. I*4 CC PAIRS CC RECNAM(I),I=1,..,NANT: RECEIVER NAMES CH*16(*) CC ANTNAM(I),I=1,..,NANT: ANTENNA NAMES CH*16(*) CC ANTNUM(I),I=1,..,NANT: ANTENNA NUMBERS I*4(*) CC OPTRAP(I),I=1,..,3: OPTIONS FOR RECEIVER I*4 CC ANTENNA PATTERN ESTIMATION CC (1): MODEL TO BE USED CC =1: PIECE-WISE LINEAR CC =2: SPHERICAL HARMONICS CC (2): FREQUENCIES TO BE ESTIMATED CC =1: OFFSETS FOR L1 ONLY CC =2: OFFSETS FOR L2 ONLY CC =3: OFFSETS FOR L1 AND L2 CC (3): NUMBER OF POINTS OR DEGREE OF CC DEVELOP. IN ELEVATION CC (4): NUMBER OF POINTS OR DEGREE OF CC DEVELOP. IN AZIMUTH CC NRAP : NUMBER OF RECEIVER/ANTENNA PAIRS I*4 CC WITH PATTERN ESTIMATION CC RANRAP(2,I),I=1,..,NRAP: RECEIVER AND CH*16 CC ANTENNA NAMES CC ANURAP(2,I),I=1,..,NRAP: ANTENNA NUMBERS I*4 CC TO BE ESTIMATED (FROM-TO) CC SIGRAP(I),I=1,..,NRAP: A PRIORI SIGMAS FOR R*8 CC REC.ANT. PATTERN CC IRCODE : RETURN CODE I*4 CC 1: QUIT CC 2: ERROR DETECTED, EXIT CC CC SR CALLED : CC CC REMARKS : --- CC CC AUTHOR : M. ROTHACHER CC CC VERSION : 4.1 CC CC CREATED : 24-SEP-98 LAST MODIFIED : 24-JAN-00 CC CC CHANGES : 15-AUT-99 : JJ: RM UNUSED VAR D214ISK CC 24-JAN-00 : HU: D24JSK DECLARED CC CC COPYRIGHT : ASTRONOMICAL INSTITUTE CC 1998 UNIVERSITY OF BERNE CC SWITZERLAND CC C* C IMPLICIT REAL*8(A-H,O-Z) C C GLOBAL PARAMETERS CHARACTER*80 D24HPN,D24JSK CHARACTER*16 RECNAM(*),ANTNAM(*) CHARACTER*16 RANRAP(2,*) C INTEGER*4 ANTNUM(*),OPTRAP(*),ANURAP(2,*) C REAL*8 SIGRAP(*) C C LOCAL DECLARATIONS PARAMETER (MAXKEY=20, MAXFLD=4*100) C CHARACTER*80 VALKEY(MAXKEY),PANLOC CHARACTER*16 FIELDS(MAXFLD) CHARACTER*16 RECREF,ANTREF CHARACTER*8 KEYWRD(MAXKEY) CHARACTER*1 CHR1 C INTEGER*4 IFLAG(MAXFLD),NUMANT(2) C INCLUDE 'I:INCL_P' C C GET INTERACTION MODE CALL GTINTM(NOINTR) C IRCODE=0 C C GET MAIN OPTIONS 10 NKEY=0 CALL DSPDPN(D24HPN,IRC) IF(IRC.NE.0) GOTO 920 CALL GTKEYW(' ',' ',' ',IRC) LUN=-80 C NKEY=NKEY+1 KEYWRD(NKEY)='RAPGRP ' CALL GTKEYW(D24HPN,KEYWRD(NKEY),VALKEY(NKEY),IRC) IF(IRC.NE.0) GOTO 11 IF(VALKEY(NKEY)(1:1).EQ.'I ') THEN ITYPE=1 VALKEY(NKEY)='INDIVIDUAL' ELSEIF(VALKEY(NKEY)(1:1).EQ.'G') THEN ITYPE=2 VALKEY(NKEY)='GROUP' ELSE GOTO 800 END IF C NKEY=NKEY+1 KEYWRD(NKEY)='RAPFRQ ' CALL GTKEYW(D24HPN,KEYWRD(NKEY),VALKEY(NKEY),IRC) IF(IRC.NE.0) GOTO 11 IF(VALKEY(NKEY)(1:2).EQ.'L1') THEN OPTRAP(2)=1 ELSEIF(VALKEY(NKEY)(1:2).EQ.'L2') THEN OPTRAP(2)=2 ELSEIF(VALKEY(NKEY)(1:1).EQ.'B') THEN OPTRAP(2)=3 VALKEY(NKEY)='BOTH' ELSE GOTO 800 END IF C NKEY=NKEY+1 KEYWRD(NKEY)='RAPMOD ' CALL GTKEYW(D24HPN,KEYWRD(NKEY),VALKEY(NKEY),IRC) IF(IRC.NE.0) GOTO 11 IF(VALKEY(NKEY)(1:1).EQ.'L') THEN OPTRAP(1)=1 VALKEY(NKEY)='LINEAR' ELSEIF(VALKEY(NKEY)(1:1).EQ.'S') THEN OPTRAP(1)=2 VALKEY(NKEY)='SPHERIC' ELSE GOTO 800 END IF C KEYWRD(NKEY+1)='DEGELV' KEYWRD(NKEY+2)='DEGAZI' DO I=1,2 NKEY=NKEY+1 CALL GTKEYW(D24HPN,KEYWRD(NKEY),VALKEY(NKEY),IRC) IF(IRC.NE.0) GOTO 11 ISTA=INPCI4(LUN,1,1,VALKEY(NKEY),NPOINT,CHR1,NRMENU,IRC) GOTO (800,800,800,11,11,800,800,800) IRC IF(NPOINT.LT.0) GOTO 800 OPTRAP(I+2)=NPOINT ENDDO C NKEY=NKEY+1 KEYWRD(NKEY)='RECREF ' CALL GTKEYW(D24HPN,KEYWRD(NKEY),VALKEY(NKEY),IRC) IF(IRC.NE.0) GOTO 11 IF(VALKEY(NKEY).EQ.'NONE') THEN IREF=0 ELSE IREF=1 RECREF=VALKEY(NKEY) ENDIF C NKEY=NKEY+1 KEYWRD(NKEY)='ANTREF ' CALL GTKEYW(D24HPN,KEYWRD(NKEY),VALKEY(NKEY),IRC) IF(IRC.NE.0) GOTO 11 ANTREF=VALKEY(NKEY) C IF (ITYPE.EQ.1) THEN NKEY=NKEY+1 KEYWRD(NKEY)='NUMREF ' CALL GTKEYW(D24HPN,KEYWRD(NKEY),VALKEY(NKEY),IRC) IF(IRC.NE.0) GOTO 11 IF (VALKEY(NKEY).EQ.' ') THEN NUMREF=-1 ELSE ISTA=INPCI4(LUN,1,1,VALKEY(NKEY),NUMREF,CHR1,NRMENU,IRC) GOTO (800,800,800,11,11,800,800,800) IRC IF(NUMREF.LT.0) GOTO 800 ENDIF ELSE NUMREF=-1 ENDIF C C CHECK IF REFERENCE REC/ANT PAIR AVAILABLE IF (IREF.EQ.1) THEN DO IANT=1,NANT IF (((RECNAM(IANT).EQ.RECREF) .OR. RECREF.EQ.' ') .AND. 1 ((ANTNAM(IANT).EQ.ANTREF) .OR. ANTREF.EQ.' ') .AND. 2 ((ANTNUM(IANT).EQ.NUMREF) .OR. NUMREF.EQ.-1 )) GOTO 20 ENDDO C NOT FOUND IF (NUMREF.EQ.-1) THEN WRITE(*,951) RECREF,ANTREF,D24HPN(1:LENGT1(D24HPN)) 951 FORMAT(/,' *** SR GEGRAP: REFERENCE RECEIVER/ANTENNA PAIR ', 1 'NOT FOUND', 2 /,16X,'IN OBSERVATION FILES', 3 /,16X,'REFERENCE RECEIVER: ',A, 4 /,16X,'REFERENCE ANTENNA : ',A, 5 /,16X,'PANEL NAME : ',A,/) ELSE WRITE(*,952) RECREF,ANTREF,NUMREF,D24HPN(1:LENGT1(D24HPN)) 952 FORMAT(/,' *** SR GEGRAP: REFERENCE RECEIVER/ANTENNA PAIR ', 1 'NOT FOUND', 2 /,16X,'IN OBSERVATION FILES', 3 /,16X,'REFERENCE RECEIVER: ',A, 4 /,16X,'REFERENCE ANTENNA : ',A, 5 /,16X,'REFERENCE ANT. NO : ',I6, 6 /,16X,'PANEL NAME : ',A,/) ENDIF IF (NOINTR.NE.1) THEN CALL PROMP1(1,'PRESS TO CONTINUE') READ(*,'(A)') CHR1 GOTO 11 ELSE GOTO 920 ENDIF C 20 CONTINUE IF (RECREF.EQ.' ') RECREF=RECNAM(IANT) IF (ANTREF.EQ.' ') ANTREF=ANTNAM(IANT) IF (NUMREF.EQ. -1) NUMREF=ANTNUM(IANT) ENDIF C C A PRIORI SIGMAS NKEY=NKEY+1 KEYWRD(NKEY)='SIGAPR' CALL GTKEYW(D24HPN,KEYWRD(NKEY),VALKEY(NKEY),IRC) IF(IRC.NE.0) GOTO 11 ISTA=INPCR8(LUN,1,1,VALKEY(NKEY),SIGAPR,CHR1,NRMENU,IRC) GOTO (800,800,800,11,11,800,800,800) IRC IF(SIGAPR.LT.0) GOTO 800 C C GENERATE LIST OF RECEIVER/ANTENNA PAIRS TO BE ESTIMATED C ------------------------------------------------------- NRAP=0 DO 40 IANT=1,NANT C C REFERENCE PAIR ? IF (IREF.EQ.1) THEN IF (RECREF.EQ.RECNAM(IANT) .AND. 1 ANTREF.EQ.ANTNAM(IANT)) THEN IF (ITYPE.EQ.1 .AND. NUMREF.EQ.ANTNUM(IANT)) THEN GOTO 40 ELSE IF (ITYPE.EQ.2) THEN GOTO 40 ENDIF ENDIF ENDIF C C ALREADY IN LIST ? DO 30 IRAP=1,NRAP IF (RANRAP(1,IRAP).EQ.RECNAM(IANT) .AND. 1 RANRAP(2,IRAP).EQ.ANTNAM(IANT)) THEN IF (ITYPE.EQ.1 .AND. ANURAP(1,IRAP).EQ.ANTNUM(IANT)) THEN GOTO 40 ELSE IF (ITYPE.EQ.2) THEN GOTO 40 ENDIF ENDIF 30 CONTINUE C C NEW REQUEST NRAP=NRAP+1 RANRAP(1,NRAP)=RECNAM(IANT) RANRAP(2,NRAP)=ANTNAM(IANT) IF (ITYPE.EQ.1) THEN ANURAP(1,NRAP)=ANTNUM(IANT) ANURAP(2,NRAP)=ANTNUM(IANT) ELSE ANURAP(1,NRAP)=0 ANURAP(2,NRAP)=999999 ENDIF SIGRAP(NRAP)=SIGAPR C 40 CONTINUE C C CHECK MAXIMUM DIMENSION C ----------------------- IF (4*NRAP.GT.MAXFLD) THEN WRITE(*,171) NRAP,MAXFLD/4 171 FORMAT(/,' *** SR GEGRAP: TOO MANY RECEIVER/ANTENNA PAIRS', 1 /,16X,'NUMBER OF RECEIVER/ANTENNA PAIRS:',I4, 2 /,16X,'MAXIMUM NUMBER ALLOWED :',I4, 3 /,16X,'INCREASE "MAXFLD" IN SR GEGRAP',/) IF (NOINTR.NE.1) THEN CALL PROMP1(1,'PRESS TO CONTINUE') READ(*,'(A)') CHR1 GOTO 10 ELSE GOTO 920 ENDIF ENDIF C C CREATE NEW PANEL FILE WITH LIST OF RECEIVER/ANTENNA PAIRS C --------------------------------------------------------- N=0 IFLAG(N+1)=NRAP C DO IRAP=1,NRAP N=N+1 WRITE(FIELDS(N),'(A16)') RANRAP(1,IRAP) N=N+1 WRITE(FIELDS(N),'(A16)') RANRAP(2,IRAP) N=N+1 WRITE(FIELDS(N),'(I6,1X,I6)') (ANURAP(II,IRAP),II=1,2) N=N+1 IF (SIGRAP(IRAP).GE.0.00001 .OR. 1 SIGRAP(IRAP).EQ.0.D0) THEN WRITE(FIELDS(N),'(F8.5)') SIGRAP(IRAP) ELSE WRITE(FIELDS(N),'(D8.2)') SIGRAP(IRAP) ENDIF ENDDO C CALL FILSKL(D24JSK,FILPAN,FIELDS,IFLAG,IRC) IF(IRC.NE.0) GOTO 920 C DO 200 I1=1,MAXFLD FIELDS(I1)= ' ' 200 CONTINUE C C DISPLAY PANEL 160 CALL DSPUPN(FILPAN,IRC) IF(IRC.EQ.1) GOTO 910 IF(IRC.NE.0) GOTO 920 C CALL GTKEYW(' ',' ',' ',IRC) C PANLOC=FILPAN LUN=-80 NRAP=0 DO 170 I=1,32000 C CALL GTKEYW(PANLOC,'RECNAM ',VALKEY,IRC) IF(IRC.EQ.3) GOTO 110 IF(IRC.EQ.1) GOTO 910 IF(IRC.NE.0) GOTO 920 C NRAP=NRAP+1 C IF(NRAP.GT.MAXRAP) THEN WRITE(*,172) NRAP,MAXRAP 172 FORMAT(/,' *** SR GEGRAP: TOO MANY RECEIVER/ANTENNA PAIRS', 1 /,16X,'NUMBER OF RECEIVER/ANTENNA PAIRS:',I4, 2 /,16X,'MAXIMUM NUMBER ALLOWED :',I4, 3 /,16X,'INCREASE "MAXRAP" IN PGM GPSEST_P',/) IF (NOINTR.NE.1) THEN CALL PROMP1(1,'PRESS TO CONTINUE') READ(*,'(A)') CHR1 GOTO 160 ELSE GOTO 920 ENDIF END IF C RANRAP(1,NRAP)=VALKEY(1)(1:16) C CALL GTKEYW(PANLOC,'ANTNAM ',VALKEY,IRC) IF(IRC.EQ.1) GOTO 910 IF(IRC.NE.0) GOTO 920 RANRAP(2,NRAP)=VALKEY(1)(1:16) C CALL GTKEYW(PANLOC,'ANTNUM ',VALKEY,IRC) IF(IRC.EQ.1) GOTO 910 IF(IRC.NE.0) GOTO 920 NUMANT(1)=0 NUMANT(2)=999999 ISTA=INPCI4(LUN,2,0,VALKEY,ANURAP(1,NRAP),CHR1,NRMENU,IRC) GOTO (900,900,900,11,11,900,900,900) IRC C CALL GTKEYW(PANLOC,'SIGAPR ',VALKEY,IRC) IF(IRC.EQ.1) GOTO 910 IF(IRC.NE.0) GOTO 920 SIGRAP(NRAP)=0.D0 ISTA=INPCR8(LUN,1,0,VALKEY,SIGRAP(NRAP),CHR1,NRMENU,IRC) GOTO (900,900,900,11,11,900,900,900) IRC C PANLOC='FOLLOW-UP' C 170 CONTINUE C 110 IRCODE=0 GOTO 999 C 900 IRCODE=IRC IF (NOINTR.NE.1) THEN WRITE(*,901) VALKEY(1)(1:LENGT1(VALKEY(1))) 901 FORMAT(/,' ILLEGAL INPUT IN ONE OF THE FIELDS', 1 /,' INPUT: "',A,'"') CALL PROMP1(1,'PRESS TO CONTINUE') READ(*,'(A)') CHR1 GOTO 160 ELSE WRITE(*,911) VALKEY(1)(1:LENGT1(VALKEY(1))), 1 PANLOC(1:LENGT1(PANLOC)) 911 FORMAT(/,' *** SR GEGRAP: ILLEGAL INPUT IN ONE OF THE FIELDS',/, 1 16X,'INPUT: ',A,/, 2 16X,'PANEL: ',A,/) GOTO 920 ENDIF C 800 IRCODE=IRC IF (NOINTR.NE.1) THEN WRITE(*,901) VALKEY(NKEY)(1:LENGT1(VALKEY(NKEY))) CALL PROMP1(1,'PRESS TO CONTINUE') READ(*,'(A)') CHR1 GOTO 10 ELSE WRITE(*,911) VALKEY(NKEY)(1:LENGT1(VALKEY(NKEY))), 1 D24HPN(1:LENGT1(D24HPN)) GOTO 920 ENDIF C C STORE BACK VALUES INTO PANEL 11 IF(IRC.NE.0) VALKEY(NKEY)=' ' CALL PTKEYW(D24HPN,NKEY,KEYWRD,VALKEY,IRC1) GOTO (910,920) IRC IF(IRC1.NE.0) GOTO 920 C 910 IRCODE=1 GOTO 999 C 920 IRCODE=2 GOTO 999 C 999 RETURN END