C
C Program COORCHG to transform the coordinates of lines or points C from Cartesian coordinates to polar spherical or geographic spherical C coordinates and vice versa C C Version: 6.70 C Date: 2012, November 7 C C Coded by Petr Bulant C Department of Geophysics, Charles University Prague, C Ke Karlovu 3, 121 16 Praha 2, Czech Republic, C http://sw3d.cz/staff/bulant.htm C C Program COORCHG reads the line(s) specified in the form C LIN, or the point(s) specified in the C form PTS, and transforms the C coordinates of the lines or points from Cartesian coordinates C to polar spherical or geographic spherical coordinates and vice versa C according to the input parameters MODEL and TOCART. C C....................................................................... C C Description of data files: C C Input data read from the standard input device (*): C The data are read by the list directed input (free format) and C consist of a single string 'SEP': C 'SEP'... String in apostrophes containing the name of the input C SEP parameter or history file with the input data. C No default, 'SEP' must be specified and cannot be blank. C C C Input data file 'SEP': C File 'SEP' has the form of the SEP C parameter file. The parameters, which do not differ from their C defaults, need not be specified in file 'SEP'. C Names of input and output files: C Just one input file and one corresponding output file must be C specified. C LIN='string'... Name of the input file with the input line(s). C Description of file LIN C Default: LIN=' ' (no file given) C LINOUT='string'... Name of the output file with the transformed C line(s). Description of file LINOUT C Default: LINOUT=' ' (no file given) C PTS='string'... Name of the input file with the input point(s). C Description of file PTS C Default: PTS=' ' (no file given) C PTSOUT='string'... Name of the output file with the transformed C point(s). Description of file PTSOUT C Default: PTSOUT=' ' (no file given) C Specification of the non-Cartesian coordinate system (one coordinate C system (input or output) is always Cartesian): C MODEL='string'... Name of the input formatted file with the input C data for the model. C Only integer KOORS specifying the type of the coordinate C system and additional data (2A) for the coordinate system C are read from data file MODEL. C Default: MODEL='model.dat' C Parameter describing the transformation: C TOCART=integer... Specifies the transformation to be performed. C TOCART=0... From Cartesian coordinates to coordinates C given by MODEL. C TOCART=1... From coordinate system given by MODEL to C Cartesian coordinates. C Default: TOCART=0 C Optional parameters specifying the form of the real quantities C written in the output formatted files: C MINDIG,MAXDIG=positive integers... See the description in file C forms.for. C C C Input file LIN with the lines: C (1) None to several strings terminated by / (a slash). Only first C 20 strings are read by COORCHG. The strings must not begin by $ C (dolar). If the string begins by $, the string is not read and C reading of the succesive strings is terminated. C (2) For each line data (2.1), (2.2) and (2.3): C (2.1) 'NAME',X1,X2,X3,/ C 'NAME'... Name of the line. May be blank but must be different C from $. C X1,X2,X3... Optional coordinates of the reference point of the C line. Need not be defined, but must be different from C the value of UNDEF, for value of UNDEF see function UARRAY C of file forms.for. C If X1 is defined, than X2 and X3 need not be defined C and their default is 0. (zero). C /... List of values must be terminated by a slash. In place C of the terminating slash, several additional numbers C terminated by a slash may be written. These numbers are C read and written to the output file LINOUT. At most 17 C additional numbers are read, the numbers must be different C from UNDEF. C (2.2) For each point of the line data (2.2.1): C (2.2.1) X1,X2,X3,/ C X1,X2,X3... Coordinates of the point of the line. C X1 must be different from the value of UNDEF. C Default for X2 and X3 is 0. C /... List of values must be terminated by a slash. In place C of the terminating slash, several additional numbers C terminated by a slash may be written. These numbers are C read and written to the output file LINOUT. At most 17 C additional numbers are read, the numbers must be different C from UNDEF. C (2.3) / C (3) / or end of file. C C C Output file LINOUT with the transformed lines: C (1) Strings as in file LIN terminated by / (a slash). Only the C first 20 strings from file LIN are written to file LINOUT. Each C line contains only one string or the final /. Spaces at the ends C of the strings are not written. C (2) For each line data (2.1), (2.2) and (2.3): C (2.1) 'NAME',X1,X2,X3,/ C 'NAME'... Name of the line. C X1,X2,X3... Optional coordinates of the reference point C transformed according to the input parameter TOCART. C /... Terminating slash or 17 unchanged additional numbers C terminated by slash. C (2.2) For each point of the line data (2.2.1): C (2.2.1) X1,X2,X3,/ C X1,X2,X3... Coordinates of the point of the line transformed C according to the input parameter TOCART. C /... Terminating slash or 17 unchanged additional numbers C terminated by slash. C (2.3) / (a slash) C (3) / (a slash) at the end of file. C C C Input file PTS with the points: C (1) None to several strings terminated by / (a slash). Only first C 20 strings are read by COORCHG. The strings must not begin by $ C (dolar). If the string begins by $, the string is not read and C reading of the succesive strings is terminated. C (2) For each point data (2.1): C (2.1) 'NAME',X1,X2,X3,/ C 'NAME'... Name of the point. May be blank but must be different C from $. C X1,X2,X3... Coordinates of the point. Must be different from C the value of UNDEF, for value of UNDEF see function UARRAY C of file forms.for. C If X1 is defined, than X2 and X3 need not be defined C and their default is 0. (zero). C /... List of values must be terminated by a slash. In place C of the terminating slash, several additional numbers C terminated by a slash may be written. These numbers are C read and written to the output file PTSOUT. At most 17 C additional numbers are read, the numbers must be different C from UNDEF. C (3) / or end of file. C C C Output file PTSOUT with the transformed points: C (1) Strings as in file PTS terminated by / (a slash). Only the C first 20 strings from file PTS are written to file PTSOUT. Each C line contains only one string or the final /. Spaces at the ends C of the strings are not written. C (2) For each point data (2.1): C (2.1) 'NAME',X1,X2,X3,/ C 'NAME'... Name of the point. C X1,X2,X3... Coordinates of the point transformed according to the C input parameter TOCART. C /... Terminating slash or 17 unchanged additional numbers C terminated by slash. C (3) / (a slash) at the end of file. C C----------------------------------------------------------------------- C Subroutines and external functions required: EXTERNAL ERROR,RSEP1,RSEP3T,RSEP3I,FORM1,LENGTH,METR1,CARTES EXTERNAL UARRAY REAL UARRAY INTEGER LENGTH C ERROR... File error.for. C RSEP1,RSEP3T,RSEP3I... File sep.for. C FORM1... File forms.for. C LENGTH... File length.for. C METR1,CARTES... File metric.for. C C C Filenames and parameters: CHARACTER*80 FSEP,FMOD,FIN,FOUT,FINL,FOUTL,FINP,FOUTP INTEGER LU1,LU2 REAL UNDEF PARAMETER (LU1=1,LU2=2) C C Other variables: CHARACTER*(24) FORMAT INTEGER I1,I2,I,ITO REAL R(20),R1,R2,R3,S(3),S1,S2,S3,DER(9),OUTMIN,OUTMAX CHARACTER*1 TEXTM CHARACTER*255 TEXT(20) LOGICAL TOCAR EQUIVALENCE (R(1),R1),(R(2),R2),(R(3),R3) EQUIVALENCE (S(1),S1),(S(2),S2),(S(3),S3) DATA TEXT/20*'$'/ C UNDEF=UARRAY() C C....................................................................... C C Reading a name of the file with the input data: FSEP=' ' WRITE(*,'(A)') '+COORCHG: Enter input filename: ' READ(*,*) FSEP IF (FSEP.EQ.' ') THEN C COORCHG-01 CALL ERROR('COORCHG-01: No input file specified') C Input file in the form of the SEP (Stanford Exploration Project) C parameter or history file must be specified. C There is no default filename. ENDIF WRITE(*,'(A)') '+COORCHG: Working ... ' C C Reading all the data from the SEP file into the memory: CALL RSEP1(LU1,FSEP) C C Reading input and output filenames: CALL RSEP3T('LIN' ,FINL ,' ') CALL RSEP3T('LINOUT',FOUTL,' ') CALL RSEP3T('PTS' ,FINP ,' ') CALL RSEP3T('PTSOUT',FOUTP,' ') IF ((FINL.EQ.' ').OR.(FOUTL.EQ.' ')) FINL=' ' IF ((FINP.EQ.' ').OR.(FOUTP.EQ.' ')) FINP=' ' IF (((FINL.EQ.' ').AND.(FINP.EQ.' ')).OR. * ((FINL.NE.' ').AND.(FINP.NE.' '))) THEN C COORCHG-02 CALL ERROR * ('COORCHG-02: Wrong specification of input and output files') C Just one input file and one corresponding output file must be C specified. There is no default. It is not allowed to specify C both LIN, LINOUT and PTS, PTSOUT. If LIN is specified, then C LINOUT must be specified and PTS and PTSOUT must not be C specified. ENDIF C Storing the names of input and output files to FIN and FOUT: IF (FINL.NE.' ') THEN FIN=FINL FOUT=FOUTL ELSE FIN=FINP FOUT=FOUTP ENDIF C CALL RSEP3T('MODEL',FMOD,'model.dat') OPEN(LU1,FILE=FMOD,STATUS='OLD') READ(LU1,*) TEXTM I=0 READ(LU1,*) I CALL METR1(I,LU1) CLOSE(LU1) C CALL RSEP3I('TOCART',ITO,0) IF ((ITO.NE.0).AND.(ITO.NE.1)) THEN C COORCHG-04 CALL ERROR('COORCHG-04: Wrong value of TOCART') C See the description of input data. ENDIF IF (ITO.EQ.0) THEN TOCAR=.FALSE. ELSEIF (ITO.EQ.1) THEN TOCAR=.TRUE. ENDIF C C Beginning of the output file: OPEN(LU2,FILE=FOUT) C C Reading input file: OPEN(LU1,FILE=FIN,STATUS='OLD') READ(LU1,*) TEXT I2=0 DO 10, I1=20,1,-1 IF (TEXT(I1).NE.'$') THEN I2=I1 GOTO 11 ENDIF 10 CONTINUE 11 CONTINUE DO 20, I1=1,I2 WRITE(LU2,'(3A)') '''',TEXT(I1)(1:LENGTH(TEXT(I1))),'''' 20 CONTINUE WRITE(LU2,'(A)') ' /' C Loop over lines or points: 60 CONTINUE TEXT(1)='$' DO 62, I1=1,20 R(I1)=UNDEF 62 CONTINUE R2=0. R3=0. READ(LU1,*,END=90) TEXT(1),R IF (TEXT(1).EQ.'$') GOTO 90 FORMAT(1:7)='(3A,20(' FORMAT(16:17)='))' IF (R1.EQ.UNDEF) THEN WRITE(LU2,'(3A)') * '''',TEXT(1)(1:LENGTH(TEXT(1))),''' /' ELSE IF (TOCAR) THEN CALL CARTES(R,TOCAR,S,DER) ELSE CALL CARTES(S,TOCAR,R,DER) ENDIF I2=3 DO 63, I1=20,4,-1 IF (R(I1).NE.UNDEF) THEN I2=I1 GOTO 64 ENDIF 63 CONTINUE 64 CONTINUE OUTMIN=AMIN1(S1,S2,S3) OUTMAX=AMAX1(S1,S2,S3) DO 645, I1=4,I2 OUTMIN=AMIN1(OUTMIN,R(I1)) OUTMAX=AMAX1(OUTMAX,R(I1)) 645 CONTINUE CALL FORM1(OUTMIN,OUTMAX,FORMAT(8:15)) WRITE(LU2,FORMAT) * '''',TEXT(1)(1:LENGTH(TEXT(1))),''' ',S1,' ',S2,' ',S3, * (' ',R(I1),I1=4,I2),' /' ENDIF C IF (FINL.NE.' ') THEN C Reading the line points 65 CONTINUE DO 66, I1=1,20 R(I1)=UNDEF 66 CONTINUE R2=0. R3=0. READ(LU1,*,END=80) R IF (R1.EQ.UNDEF) GOTO 80 FORMAT(1:4)='(20(' FORMAT(13:14)='))' IF (TOCAR) THEN CALL CARTES(R,TOCAR,S,DER) ELSE CALL CARTES(S,TOCAR,R,DER) ENDIF I2=3 DO 67, I1=20,4,-1 IF (R(I1).NE.UNDEF) THEN I2=I1 GOTO 68 ENDIF 67 CONTINUE 68 CONTINUE OUTMIN=AMIN1(S1,S2,S3) OUTMAX=AMAX1(S1,S2,S3) DO 685, I1=4,I2 OUTMIN=AMIN1(OUTMIN,R(I1)) OUTMAX=AMAX1(OUTMAX,R(I1)) 685 CONTINUE CALL FORM1(OUTMIN,OUTMAX,FORMAT(5:12)) WRITE(LU2,FORMAT) * S1,' ',S2,' ',S3,(' ',R(I1),I1=4,I2),' /' GOTO 65 80 CONTINUE C End of line. WRITE(LU2,'(A)') ' /' ENDIF GOTO 60 90 CONTINUE C End of file. WRITE(LU2,'(A)') ' /' CLOSE(LU1) CLOSE(LU2) WRITE(*,'(A)') '+COORCHG: Done. ' STOP END C C======================================================================= C INCLUDE 'error.for' C error.for INCLUDE 'sep.for' C sep.for INCLUDE 'forms.for' C forms.for INCLUDE 'length.for' C length.for INCLUDE 'metric.for' C metric.for C C======================================================================= C