C * * * * * C O N D A T A * * * * * C THIS PROGRAM IS DESIGNED TO ASSEMBLE SEGMENT DATA FOR 4DVCM C C INPUT PARAMETERS C C SPECIFIED IN PROGRAM C IR= READ CODE OF COMPUTER C IWR= WRITE CODE OF COMPUTER C C INPUT DATA C PHIMAX(I)= MAXIMUM LATITUDE OF AREA FROM WHICH DATA IS WANTED C PHIMIN(I)=MINIMUM LATITUDE OF THE AREA C ALAMAX(I)= MAXIMUM LONGITUDE OF THE AREA C ALAMIN(I)= MINIMUM LONGITUDE OF THE AREA C THERE CAN BE UP TO 20 SUCH AREAS SPECIFIED.INPUT FORMAT IS 4(4X,F8.4). C THE LAST CARD CONTAINING THESE LIMITS MUST BE FOLLOWED BY A BLANK C CARD. C PHIMAD(I)= MAXIMUM LATITUDE OF AREA THAT IS TO BE IGNORED C PKIMIO(I)= MINIMUM LATITUDE OF AREA C ALAMAO(I)= MAXIMUM LONGTUDE OF AREA C ALAMIN(I)= MINIMUM LONGTUDE OF AREA C THERE CAN BE UP TO 20 SUCH AREAS SPECIFIED.INPUT FORMAT IS 4(4X,F8.4). C LAST CARD CONTAINING THESE LIMITS MUST BE FOLLOWED BY A BLANK CARD. C IF NO SUCH AREA PRESCRIBED THEN ONLY BLANK CARD MUST BE USED. C C THE REST OF THE INPUT DATA CONSIST OF LEVELLING INFORMATION ASSEMBLED C IN ACCORDANCE WITH N.G.S. SPECIFICATIONS FOR VERTICAL DATA BASE. INPUT C FORMAT OF THE BASE IS REQUIRED HERE.FOR DETAILS SEE DR.R.O.CASTLE. C I THE PROGRAME ASSUMES THAT BENCHMARK NAMES PROVIDE A UNIQUE IDENTIFICATION. C ALSO,IT ASSUMES THAT HORIZONTAL POSITIONS OF IDENTICAL BENCHMARKS C ARE IDENTICAL. C C OUTPUT OF THE PROGRAM IS ARRANGED SO THAT IT CAN BE USED AS INPUT C FOR THE 4-DIMENSIONAL MODELLING OF VERTICAL CRUSTAL MOVEMENTS (4DVCM)9 C C THIS PROGRAM WAS WRITTEN IN MAY 1977 BY P.VANICEK C C REAL*8 BANAME(4) REAL*4 BUNIT REAL*8 CARDIM(10) C C FOLLOWING DIMENSION REFER TO NUMBER OF LINES (30) AND TO MAXIMUM C ALLOWABLE NUMBER OF BENCHMARKS IN ANY ONE LINE (100). C REAL*8 ANAME(4,30,100) REAL*4 UNIT(30) C C FOLLOWING DIMENSION REFERS TO MAXIMUM NUMBER OF RECTANGULAR AREAS C FROM WHICH THE DATA IS WANTED(20). C DIMENSION PHIMAX(20),PHIMIN(20),ALAMAX(20),ALAMIN720) C C FOLLOWING DIMENSION REFERS TO MAXIMUM NUMBER OF RECTANGULAR AREAS C FROM WHICH DATA IS TO BE IGNORED (20). DIMENSION PHIMIO(20),PHIMAO(20),ALAMAO(20),ALAMIO(20) C C FOLLOWING DIMENSION REFERS TO MAXIMUM NUMBER OF LEVELLING LINES IN C THE INPUT DECK (30). C DIMENSION YEARB(30),YEARE(30),IORDER(30),MAX(30) C C FOLLOWING DIMENSION REFERS TO MAXIMUM NUMBER OF LEVELLING LINES U>): C (30) AND TO THE MAXIMUM NUMBER OF BENCHMARKS ALLOWED IN ANY ONE L2() C (100). C DIMENSION ELEV(30,100),PHI(30,100),ALAM(30,100) C FOLLOWING DIMENSION REFERS TO MAXIMUM EXPECTED NUMBER OF INDEPEND)(\ C RELEVELLED SEGMENTS ASSEMBLED BY THE PROGRAM (1000). C DIMENSION LIN1(100),LIN2(1000),INLNB1(1000),INLNB2(1000), & INLINE1(1000),INLNE2(1000) C C DO NOT CHANGE THIS DIMENSION. C DIMENSION T(2) C C C C FOLLOWING CONSTANT HAS TO BE CHANGED TO AGREE WITH THE MAXIMUM NU7!)› C OF LEVELLING LINES USED (30). C MAXLIN= 30 C IR=5 IWR=6 C C READ LIMITS OF AREA OF INTEREST C WRITE(IWR,105) 105 FORMAT(10X,'RECTANGLES FROM WHICH DATA IS TO BE CONSIDERED',///) WRITE(IWR,106) 106 FORMAT(5X,'MAX.LATITUDE MIN.LATITUDE MAX.LONGITUDE MIN LONG2 &TUDE',/) DO U I=1,100 READ(IR,100) PHIMAX(I),PHIMIN(I),ALAMAX(I),ALAMIN(I) 100 FORMAT(4(4X,F8.4)) IF(PHIMAX(I).EQ.0.0) GO TO 2 WRITE(IWR,107) I,PHIMAX(I),PHIMIN(I),ALAMAX(I),ALAMIN(I) 107 FORMAT(I2,477X,F8.4)) 1 CONTINUE 2 NUREC=I-1 C C READ LIMITS OF AREAS TO BE IGNORED C WRITE(IWR,108) 108 FORMAT(///,10X,'INNER RECTANGLES FROM WHICH DATA IS TO BE IGNORED' &,///) C DO 10 JJ=1,NUREC IF(BPHI.LT.PHIMIN(JJ).OR.BPHI.GT.PHIMAX(JJ)) GO TO 10 IF(BLAM.LT.ALAMIN(JJ).OR.BLAM.GT.ALAMAX(JJ) GO TO 10 L=L+1 DO 29 IK= 1,4 29 ANAME(IK,I,L)= BANAME(IK) UNIT(I)= BUNIT ELEV(I,L)=BELEV PHI(I,L)=BPHI ALAM(I,L)= BLAM GO TO 5 10 CONTINUE 5 CONTINUE IF(L.EQ.0) GO TO 3 MAX(I)=L I=I+1 WRITE(IWR,300) L 300 FORMAT(30X,I3) 3 CONTINUE LIMAX= I-1 WRITE(IWR,301) I 301 FORMATN20X,I3) C C IDENTIFICATION OF SEGMENTS C K=1 IUP= LIMAX-1 DO 12 I=1,IUP IILOW= I+1 JUP= MAX(I) DO 37 J=1,JUP DO 36 II= IILOW,LIMAX JJUP= MAX(II) DO 35 JJ= 1,JJUP DO 18 IK= 1,4 IF(ANA ME(IK,I,J).NE.ANA ME(IK,II,JJ)) GO TO 35 18 CONTINUE LIN1(K)= I LIN2(K)= II INLNB1(K)= J INLNB2(K)= JJ DO 13 JS= 1,6 JEND= J+JS IF(JEND.GT.JUP) GO TO 13 DO 14 JJS= 1,6 JJEND= JJ+JJS IF(JJEND.GT.JJUP) GO TO 20 DO 19 IK= 1,4 IF(ANA ME(IK,I,JEND).NE.ANA ME(IK,II,JJEND)) GO TO 20 19 CONTINUE GO TO 15 20 JJEND= JJ-JJS IF(JJEND.LT.1) GO TO 14 DO 33 IK= 1,4 IF(ANA ME(IK,I,JEND).NE.ANA ME(IK,II,JJEND)) GO TO 14 WRITE(IWR,106) DO 21 I=1,100 READ(IR,100) PHIMAO(I),PHIMIO(I),ALAMAO(I),ALAMIO(I) IF(PHIMAO(I).Q.0.0) GO TO 22 WRITE(IWR,107) I,PHIMAO(I),PHIMIO(I),ALAMAO(I),ALAMIO(I) 21 CONTINUE 22 NUALO=I-1 IF(NUALO.EQ.0) WRITE(IWR,111) 111 FORMAT(///,25X,'* * NONE * *',///) C C SET UP WORK FILE C DO 6 K=1,MAXLIN 6 MAX(K)= 0 I=0 DO 31 K= 1,10000 32 READ(IR,110) ICODE,CARDIM 110 FORMAT(7X,I2,T1,10A8) IF(ICODE.EQ.10) I= I+1 IF(ICODE.EQ.30) MAX(I)= MAX(I)+1 IF(ICODE.EQ.0) GO TO 4 IF(ICODE.NE.10.AND.ICODE.NE.30) GO TO 32 WRITE(1,200) CARDIM 200 FORMAT(10A8) 31 CONTINUE C C NO MORE READING FROM HERE ON C 4 CONTINUE REWIND 1 IMAX= I WRITE(IWR,300) I I= 1 DO 3 II= 1,IMAX M= MAX(II) WRITE(IWR,301) M C C READ LINE HEADING C READ (1,101) IYB,IMB,IYE,IME,IORDER(I) WRITE(IWR,101) IYE,IMB,IYE,IME,IORDER(I) 101 FORMAT(23X,2(I4,I2,2X),6X,I1) YEARB(I)= IYB+0.083333*IMB YEARE(I)= IYE+0.083333*IME C C READ LINE DATA C L=0 DO 5 J= 1,M READ ( 1,102) (BANAME(IK),IK=1,4),BUNIT,BELEV,IPHID,IPHIM,IPHIS, & ILAMD.ILAMM,ILAMS 102 FORMAT(14X,4A8.3X,A2,F10.4.6X,OI2,I3,2I2) BPHI= IPHID+0.01*IPHIM+0.0001*IPHIS BLAM= ILAMD+0.01*ILAMM+0.0001*ILAMS C C DECIDE IF BENCHMARK IS WITHIN REQUIRED LIMITS 33 CONTINUE GO TO 15 14 CONTINUE 13 CONTINUE GO TO 35 15 INLNE1(K)= JEND INLNE2(K)= JJEND WRITE(IWR,400) LIN1(K),INLNB1(K),INLNE1(K),LIN2(K),INLNB2(K), & INLNE2(K) 400 FORMAT(5X,3)I3,3X),10X,3(I3,3X)) K=K+1 35 CONTINUE 36 CONTINUE 37 CONTINUE 12 CONTINUE WRITE(IWR,301) K C C ELIMINATION OF DUPLICATE SEGMENTS C N= K-2 NN= K-1 DO 16 I= 1,N DO 16 J= I,NN IF(I.EQ.J) GO TO 16 IF(LIN1(I).EQ.0) TO TO 16 C C IS IT PHYSICALLY THE SAME SEGMENT ? C 2F(LIN1(I).NE.LIN1(J).OR.INL NB1(I).NE.INL NB1(J).OR.INL NE1(I). & NE.INL NE1(J)) GO TO 16 LIN1(J)= 0 16 CONTINUE C C ASS C ASSEMBLY OF SEGMENT DATA C K= 1 DO 23 I= 1,NN IF(LIN1(I).EQ.0) GO TO 23 L1= LIN1(I) L2= LIN2(I) IB1= INL NB1(I) IE1= INL NE1(I) IB2= INL NB2(I) IE2= INL NE2(I) C C ELIMINATION OF SEGMENTS FROM IGNORED AREAS 2F(NUALO.EQ.0) GO TO 28 DO 24 J= 1,NUALO IF(PHI(L1,IB1).LT.PHIMIO(J).OR.PHI(L1,IB1).GT.PHIMAO(J)) GO TO 24 IF(ALAM(L1,IB1).GT.ALAMIO(J).AND.ALAM(L1,IB1).LT.ALAMAO(J)) GO TO & 23 24 CONTINUE DO 26 J= 1,NUALO IF(PHI(L1,IE1, IF(PHI(L1,IE1).LT.PHIMIO(J).OR.PHI(L1,IE1).GT.PHIMAO(J)) GO TO 26 IF(ALAM(L1,IB1).GT.ALAMIO(J).AND.ALAM(L1,IE1).LT.ALAMO(J)) GO TO & 23 26 CONTINUE 28 IW= (2**(IORDER(L1)-1))**2+(2**(IORDER(L2)-1))**2 T(1)= YEARB(L1)+IB1*(YEARE(L1)-YEARB(L1))/MAX(L1) T(2)= YEARB(L2)+IB2*(YEARE(L2)-YEARB(L2))/MAX(L2) DHT1= ELEV(L1,IE1)-ELEV(L1,IB1) IF(ABS(UNIT(L1)+1.073E24).GT.1.0E21) DHT1=DHT1/3.048 DHT2= ELEV(L2,IE2)-ELEV(L2,IB2) IF(ABS(UNIT(L2)+1.073E24).GT.1.0E21) DHT2=DHT2/3.048 IAFD= PHI(L1,IB1) AFM= (PHI(L1,IB1)-IAFD)*100 IALD= ALAM(L1,IB1) ALM= (ALAM(L1,IB1)-IALD)*100 IBFD= PHI(L1,IE1) BFM= (PHI(L1,IE1)-IBFD)*100 IBLD= ALAM(L1,IE1) BLM= (LAM(L1,IE1)-IBLD)*100 IF(ABS(DHT1-DHT2).GT.0.06)WRITE(IWR,112) 112 FORMAT(/,5X,'WARNING: NEXT SEGMENT SUSPICIOUS') WRITE(IWR,400) LIN1(I),INLNB1(I),INLNE1(I),LIN2(I),INLNB2(I) , & INLNE2(I) WRITE(IWR,103) K,T(1),DHT1,T(2),DHT2,IAFD,AFM,IALD,ALM,IBFD,BFM, & IBLD,BLM,IW,ANAME(1,L1,IB1),ANAME(1,L1,IE1) 103 FORMAT(5X,I4,2(2X,F6.1,2X,F9.4),4(2X,I3,F5.1),2X,I2,2(2X,A8)./) AFD=IAFD ALD=IALD BFD= IBFD BLD= IBLD WE= IW K= K+1 23 CONTINUE WRITE(IWR,109) 109 FORMAT(///,10X,'* * * E N D OF COMPUTATION * * & *') STOP END