SUBROUTINE COMPOB (KIND,OBS0,B,OBSB,ISN,JSN,IAUX,ITIME) *** COMPUTE THE OBSERVATION FROM THE PARAMETERS IMPLICIT DOUBLE PRECISION (A-H,O-Z) IMPLICIT INTEGER (I-N) PARAMETER (TINY = 1.D-30) DIMENSION B(*),RI(3,3),RJ(3,3) COMMON /CONST/ PI,PI2,RAD,RADSEC,TWOPI COMMON /FAULT/ STRK COMMON /STRUCT/ NSTA,NAUX,NUNK,IDIM,NSTAS,NOBS,NCON,NZ,NCD COMMON /OPT/ AX,E2,DMSL,DGH,VM,VP,CTOL,ITMAX,ITMIN,IMODE, & LMSL,LSS,LUP SAVE XIT,YIT,ZIT,XJT,YJT,ZJT,XKT,YKT,ZKT *** KIND = 0 IS AN AUXILIARY PARAMETER CONSTRAINT IF (KIND.EQ.0) THEN IAUX = ISN CALL GETAUX (AUX,IAUX,B) OBS0 = AUX *** KIND = 1 IS LATITUDE CONSTRAINT (OBSB = GEOD. LAT) ELSEIF (KIND.EQ.1) THEN CALL GETGLA (GLAT0,ISN,B) OBS0 = GLAT0 *** KIND = 2 IS LONGITUDE CONSTRAINT (OBSB = GEOD. LONG.) ELSEIF (KIND.EQ.2) THEN CALL GETGLO (GLON0,ISN,B) OBS0 = GLON0 *** KIND = 3 IS HEIGHT CONSTRAINT ELSEIF (KIND.EQ.3) THEN CALL GETMSL (GMSL0,ISN,B) CALL GETGH (GHT0,ISN,B) EHT0 = GMSL0 + GHT0 OBS0 = EHT0 *** KIND = 4 IS DIFFERENTIAL X (GPS) ELSEIF (KIND.EQ.4) THEN CALL GETXIT (XIT,YIT,ZIT,B,ISN,ITIME) CALL GETXJT (XJT,YJT,ZJT,B,JSN,ITIME) OBS0 = XJT - XIT IF (IAUX.GT.0) THEN CALL GETAUX (VAL,IAUX,B) OBS0 = OBS0 - OBS0 * VAL ENDIF *** KIND = 5 IS DIFFERENTIAL Y (GPS) ELSEIF (KIND.EQ.5) THEN CALL GETXIT (XIT,YIT,ZIT,B,ISN,ITIME) CALL GETXJT (XJT,YJT,ZJT,B,JSN,ITIME) OBS0 = YJT - YIT IF (IAUX.GT.0) THEN CALL GETAUX (VAL,IAUX,B) OBS0 = OBS0 - OBS0 * VAL ENDIF *** KIND = 6 IS DIFFERENTIAL Z (GPS) ELSEIF (KIND.EQ.6) THEN CALL GETXIT (XIT,YIT,ZIT,B,ISN,ITIME) CALL GETXJT (XJT,YJT,ZJT,B,JSN,ITIME) OBS0 = ZJT - ZIT IF (IAUX.GT.0) THEN CALL GETAUX (VAL,IAUX,B) OBS0 = OBS0 - OBS0 * VAL ENDIF *** KIND = 7 IS MARK TO MARK DISTANCE ELSEIF (KIND.EQ.7) THEN CALL GETXIT (XIT,YIT,ZIT,B,ISN,ITIME) CALL GETXJT (XJT,YJT,ZJT,B,JSN,ITIME) DX = XJT - XIT DY = YJT - YIT DZ = ZJT - ZIT OBS0 = DSQRT ( DX * DX + DY * DY + DZ * DZ ) IF (IAUX.GT.0) THEN CALL GETAUX (VAL,IAUX,B) OBS0 = OBS0 - OBS0 * VAL ENDIF *** KIND = 8 IS AN ASTRONOMIC AZIMUTH ELSEIF (KIND.EQ.8) THEN CALL GETALA (ALAI,ISN,B) SLAI = DSIN(ALAI) CLAI = DCOS(ALAI) CALL GETALO (ALOI,ISN,B) SLOI = DSIN(ALOI) CLOI = DCOS(ALOI) CALL GETXIT (XIT,YIT,ZIT,B,ISN,ITIME) CALL GETXJT (XJT,YJT,ZJT,B,JSN,ITIME) DX = XJT - XIT DY = YJT - YIT DZ = ZJT - ZIT U = -SLOI * DX + CLOI * DY V = -SLAI * CLOI * DX - SLAI * SLOI * DY + CLAI * DZ OBS0 = DATAN2(U,V) IF (OBS0.LT.0.D0) OBS0 = OBS0 + TWOPI *** KIND = 9 IS A ZENITH DISTANCE ELSEIF (KIND.EQ.9) THEN CALL GETALA (ALAI,ISN,B) SLAI = DSIN(ALAI) CLAI = DCOS(ALAI) CALL GETALO (ALOI,ISN,B) SLOI = DSIN(ALOI) CLOI = DCOS(ALOI) CALL GETXIT (XIT,YIT,ZIT,B,ISN,ITIME) CALL GETXJT (XJT,YJT,ZJT,B,JSN,ITIME) DX = XJT - XIT DY = YJT - YIT DZ = ZJT - ZIT S = DSQRT ( DX * DX + DY * DY + DZ * DZ ) W = CLAI * CLOI * DX + CLAI * SLOI * DY + SLAI * DZ OBS0 = DACOS( W / S ) IF (IAUX.GT.0) THEN CALL GETAUX ( VAL, IAUX, B ) CALL GETGLB ( DX,DY,DZ, RI,RJ, P1,Q1,R1,T1, P2,Q2,R2,T2, S ) OBS0 = OBS0 - VAL * R1 ENDIF *** KIND = 10 IS A HORIZONTAL ANGLE ELSEIF (KIND.EQ.10) THEN KSN = IAUX CALL GETALA (ALAI,ISN,B) SLAI = DSIN(ALAI) CLAI = DCOS(ALAI) CALL GETALO (ALOI,ISN,B) SLOI = DSIN(ALOI) CLOI = DCOS(ALOI) CALL GETXIT (XIT,YIT,ZIT,B,ISN,ITIME) CALL GETXJT (XJT,YJT,ZJT,B,JSN,ITIME) CALL GETXKT (XKT,YKT,ZKT,B,KSN,ITIME) DXL = XJT - XIT DYL = YJT - YIT DZL = ZJT - ZIT DXR = XKT - XIT DYR = YKT - YIT DZR = ZKT - ZIT UL = -SLOI * DXL + CLOI * DYL VL = -SLAI * CLOI * DXL - SLAI * SLOI * DYL + CLAI * DZL UR = -SLOI * DXR + CLOI * DYR VR = -SLAI * CLOI * DXR - SLAI * SLOI * DYR + CLAI * DZR DIRL = DATAN2(UL,VL) DIRR = DATAN2(UR,VR) OBS0 = DIRR - DIRL 18 IF (OBS0.GE.TWOPI) THEN OBS0 = OBS0 - TWOPI GO TO 18 ENDIF 19 IF (OBS0.LT.0.D0) THEN OBS0 = OBS0 + TWOPI GO TO 19 ENDIF *** KIND = 11 IS A HORIZONTAL DIRECTION ELSEIF (KIND.EQ.11) THEN CALL GETALA (ALAI,ISN,B) SLAI = DSIN(ALAI) CLAI = DCOS(ALAI) CALL GETALO (ALOI,ISN,B) SLOI = DSIN(ALOI) CLOI = DCOS(ALOI) CALL GETXIT (XIT,YIT,ZIT,B,ISN,ITIME) CALL GETXJT (XJT,YJT,ZJT,B,JSN,ITIME) DX = XJT - XIT DY = YJT - YIT DZ = ZJT - ZIT U = -SLOI * DX + CLOI * DY V = -SLAI * CLOI * DX - SLAI * SLOI * DY + CLAI * DZ CALL GETROT (ROT,IAUX,B) OBS0 = DATAN2(U,V) - ROT 21 IF (OBS0.GE.TWOPI) THEN OBS0 = OBS0 - TWOPI GO TO 21 ENDIF 23 IF (OBS0.LT.0.D0) THEN OBS0 = OBS0 + TWOPI GO TO 23 ENDIF *** KIND = 12 IS A CONSTRAINED AZIMUTH ELSEIF (KIND.EQ.12) THEN CALL GETALA (ALAI,ISN,B) SLAI = DSIN(ALAI) CLAI = DCOS(ALAI) CALL GETALO (ALOI,ISN,B) SLOI = DSIN(ALOI) CLOI = DCOS(ALOI) CALL GETXIT (XIT,YIT,ZIT,B,ISN,ITIME) CALL GETXJT (XJT,YJT,ZJT,B,JSN,ITIME) DX = XJT - XIT DY = YJT - YIT DZ = ZJT - ZIT U = -SLOI * DX + CLOI * DY V = -SLAI * CLOI * DX - SLAI * SLOI * DY + CLAI * DZ OBS0 = DATAN2(U,V) IF (OBS0.LT.0.D0) OBS0 = OBS0 + TWOPI *** KIND = 13 IS CONSTRAINED MARK TO MARK DISTANCE ELSEIF (KIND.EQ.13) THEN CALL GETXIT (XIT,YIT,ZIT,B,ISN,ITIME) CALL GETXJT (XJT,YJT,ZJT,B,JSN,ITIME) DX = XJT - XIT DY = YJT - YIT DZ = ZJT - ZIT OBS0 = DSQRT ( DX * DX + DY * DY + DZ * DZ ) *** KIND = 14 IS A CONSTRAINED ZENITH DISTANCE ELSEIF (KIND.EQ.14) THEN CALL GETALA (ALAI,ISN,B) SLAI = DSIN(ALAI) CLAI = DCOS(ALAI) CALL GETALO (ALOI,ISN,B) SLOI = DSIN(ALOI) CLOI = DCOS(ALOI) CALL GETXIT (XIT,YIT,ZIT,B,ISN,ITIME) CALL GETXJT (XJT,YJT,ZJT,B,JSN,ITIME) DX = XJT - XIT DY = YJT - YIT DZ = ZJT - ZIT S = DSQRT( DX * DX + DY * DY + DZ * DZ ) W = CLAI * CLOI * DX + CLAI * SLOI * DY + SLAI * DZ OBS0 = DACOS( W / S ) *** KIND = 15 IS A CONSTRAINED GEOID HEIGHT DIFFERENCE ELSEIF (KIND.EQ.15) THEN CALL GETGH (DGH1,ISN,B) CALL GETGH (DGH2,JSN,B) OBS0 = DGH2 - DGH1 *** KIND = 16 IS A CONSTRAINED ORTHOMETRIC HEIGHT DIFFERENCE ELSEIF (KIND.EQ.16) THEN CALL GETMSL (GMSL1,ISN,B) CALL GETMSL (GMSL2,JSN,B) OBS0 = GMSL2 - GMSL1 *** KIND = 17 IS A CONSTRAINED ELLIPSOIDAL HEIGHT DIFFERENCE ELSEIF (KIND.EQ.17) THEN CALL GETMSL (GMSL1,ISN,B) CALL GETGH (DGH1,ISN,B) CALL GETMSL (GMSL2,JSN,B) CALL GETGH (DGH2,JSN,B) OBS0 = ( GMSL2 + DGH2 ) - ( GMSL1 + DGH1 ) *** KIND = 18 IS A CONSTRAINED MINIMAL DISTANCE PERPENDICULAR TO A FAULT ELSEIF (KIND.EQ.18) THEN CALL GETGLA (GLAI,ISN,B) CALL GETGLO (GLOI,ISN,B) CALL GETGLA (GLAJ,JSN,B) CALL GETGLO (GLOJ,JSN,B) CALL RADCUR (GLAI,RMER,RPV) OBS0 = DCOS(STRK) * RPV * (GLOJ - GLOI) * DCOS(GLAI) - & DSIN(STRK) * RMER * (GLAJ - GLAI) *** ILLEGAL KIND ELSE WRITE (6,1) KIND 1 FORMAT ('0ERROR - ILLEGAL KIND IN COMPOB = ',I5) CALL ABORT2 ENDIF RETURN END