SEDCODE: a FORTRAN 77 program for decoding sedimentological field data

Computers d GeoscwncesVol. 12, No. 1, pp. 47-79, 1986 Printed in Great Britain.

0098-3004/86 $3.00 + .00 © 1986 Pe~iamon Prets Ltd.

SEDCODE: A F O R T R A N 77 P R O G R A M FOR DECODING SEDIMENTOLOGICAL FIELD DATA R. GOLDBERY Department of Geology and Mineralogy, Ben Gurion University of the Negev, Beer Sheba, Israel

and K. wINIKOFF Department of Mechanical Engineering, Ben Gut'ion University of the Negev (Received 9 November 1984; Revised 17 September 1985)

Abstract--SEDCODE is a program designed for the transformation of coded sedimemological field data into textual descriptions. Although the program is concerned specifically with description of iithofacies within elastic sedimentary sequences, the use of external files to describe the coded variable descriptors and their textual translations, makes this a versatile program, which can be adapted readily for other purposes. The main program and its subroutines were written in FORTRAN 77. Key Wordy..Ciastic sequences, Coded data systems, Displaydescriptive langnja~, Field data coding, Lithofacies, Sedimentary structures, Scdimentology

INTRODUCTION

Lithofacies, which are the rock record of any sedimentary environment are defined by three categories of variables: (a) lithology, (b) sedimentary structure, and (c) biogenic and organic features. The coded field data card of SEDCODE (Fig. IA) contains 96 variables arranged in this manner. Whereas the lithoiogical variables are in conformance with any of the standard textbooks of sedimentology, those of the remaining categories (sedimentary structures and biogenic features) have been compiled from the following sources: Conybeare and Crook (1968), Harms and others (1975), Reinick and Singh (1975), Collinson and Thompson (1982), and Allen (1982).

The application of coded data systems for the systematic recording of information from both the field and laboratory has been in use by research scientists for a considerable time, in particular in the field of geology which demands such a large amount of description and measurement of variables. SEDCODE is a coded data system developed specifically for field use to describe the characteristic features of lithofacies defined within elastic sedimentary sequences. This program was developed and imeractively modified through a period of three years of field work on the blanket cratonic sandstones of the "Nubian Facies" of the Negev (Israel). The repetitious nature of the descriptive and sampling activities within these massive blanket sandstones, necessitates the use of a coded data system; in addition, the transformation by the computer of the coded data into textual descriptions, circumvents the time-consuming task of transcribing field notes into expanded text. An essential ingredient for the successful recognition and subsequent mapping of lithofacies, is that the descriptive data be as objective as humanly possible. Within cratonic blanket sandstone sequences, where units apparently are "featureless", this necessity is even greater. The advantage of SEDCODE is that the researcher is forced to make a decision on each and every one of the variables listed on the field card. This obviates the subjective recording of only those features which are displayed prominantly on the outcrop at the expense of the less obvious ones. Furthermore, use of SEDCODE by researchers on other blanket sands related to cratonic areas in other parts of the world will ensure a high level of standardization ofdata, to such an extent that a global databank can be established.

DATA INPUT FORMAT A sample input and output is shown in Figures IA and lB. The following points are important to outline for the potential user of SEDCODE. (1) All coded entries within the variable data field have blanks removed by the program. (2) All numerical values for variables are in centimeters. The input format of these variables allows for the use of the decimal point in the position indicated on the field card, or for the recording of larger values, the decimal point can be ignored. (3) Absences of cross bedding, simple bedding, rbeotropic structures, surface marks, organic material, and biogenic features must be noted by an 'X' in the 'none' position" this forces the researcher to search for this information in the field even on outcrops where the features are not so obvious or arc obscurezl. (4) Comment entries, as indicated on the field card always must commence with an asterisk ','. The 47

R.C.,-OLDBERYand K. WIN1KOFF

48

I~=l,.,lol,,,I,,Vlttol~ ttsl~lol ol~lzlz] ~l~l~.lllal I~lal I ~IIIL~I I ~[1~1~.1 I l l l J MAP

GRID N.

GRID. E

AERIAL PHOTO

PHOTO No

I Itloi61llalol~tlt 31al~dal~,~lrl.IGL~~;ol~.l~b,IvltlRl^l SAMPLENoI

D,

LOCATION

I

S>

I

FORMATION

I~'lld~dl~lll~l~'l'~l~r'l~dl.loMd¢lddl =

SECT

I WELL

I I II..[.I¢~JEIN.IG olLI=l~l¢ ~ SAMPLED

I IIIIIIIIIlllllll

~. =-

~

]61Sl°loioltl~zlll5

By

II11111111111 S=

~

~

S~l

-~

=11 [tl~,~'rl,l~ll~l la, lsl t-d~l,4dr.,l~tldddd'd~ldolrd,~l I I I I II II I'1 I ~=

~~

,~l~lllllllllll

e~

II1.1

oo,=',,

o~

-.~1o.~1 ~ = ®

~-

ll.lllM

~

I~1111

i" I Idol 1[ I ~11 n I I I I

~-

~ i~,.,I.,.p.~ o~,~I

I1o1111°1

~.

IIIIII

il

i 'i

i Mold~Id I I I I I

=~ol4dd¢l~ Ig~ld I~1 I~l~l I~ldd IMd I~IGIslMIdd~Ebl Idoi,~lPKI,~ t ~ I~ I ~ ~1 I~g h ~ , l d ~ I l l =oH~tl ~lol,&l~l~R~l~l I~lddQ I~d~=~l=~ I~ld^lit Iddd.t ~l=l EIo~l I~ld~ I I I I I I t I o~ddddol, l ~ h M ~ l l l l l l l l l l l l l l l l l l l l l l l l l l l l t IIII11111111 I111111111111 0-$h~dtlttb_lt.~lll~lv~d~l~olt~gdl~oll I I I I I • II I l l • 1 1 1 II • l l l l l l l ~l*lllllllllllltlllllllllllllllllllllll IIIIlllllll llllllll. ISlllllltlllllllllllllllllllllllllllll

[llllllllll

IIit1111

Figure I A. Sample field card including input.

termination of each comment by a '#' forces the following comment to be printed on a new line on the output from the SEDCODE program. There is no limitation on the number of comment lines which can be entered even though the field card lists only three. (S) Sample entries, starting with a dollar '$' comprise two fields of entry; the first four spaces are for the (alphanumeric) sample number whereas the adjacent three spaces records the depth from the top ofthe unit in centimeters. The program currently caters for up to 12 and 5 spaces respectively if an expanded field of entry is required. THE PROGRAM Two major features of the program that contribute to its versatility are: the use of (1) external files to describe the codes used and their expanded descriptions, and (2) a simple 'Display Description Language' to define what and how descriptive text is to be printed. These external files can be updated constantly in response to field work, and there is no need to make any modifications to the program. Both of these features are described in more detail following an overall description of the system and the main program. It is to be emphasized that a user wishing to set up another application would need to write the main program wherein the input and printing formats for specific ap-

plication needs to be defined. All the other information required about his encoding system is stored in the two simple text files CODES (coded variable descriptions) and DESCS (textual translations of the codes).

OVERALL SYSTEM The program is divided into three main sections for convenience, stored in three different files---MAIN, SUB 1 and SUB2 (Fig. 2). Before compiling the main program (overall logic shown in Figure 3) from the file MAIN it must be converted into standard FORTRAN. Statements in our Display Description Language (DDL) are interspersed with the F O R T R A N of the main program. Lines containing these statements are identified by a 'D' (for Display) in position 1 of the line. The program CONVERT then reads MAIN and translates the statements in DDL to sets of subroutine calls. All these called subroutines are stored in the file SUB2, whereas other required subroutines are stored in the file SUB1. FILES CODES: This file specifies the positions of codes in each line of the user's standardized field card. Reference within the program to a particular variable from the field card, is by its unique variable number: for ex-

Decoding ~dimentoloDcal field data .

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

49 .

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

M A P S O U R C E * G R I D R E F ( N ) * G R I D R E F (E)* A R E A L P H O T O * PHOTONO* SN ID ............................................................................ DIMONA/IO0 1510 0422 3 3 2 / B 53 F/LS MIM2 ============================================================================

.

.

.

* WELL

S A M P NO * D A T E * L O C A T I O N *FORMATION * AGE * THICK * REG. DIP * SAMPLED ............................................................................

BY

I06/B 0910814 M A K T . G A D O L HATIRA L. C R E 65.00 16 315 R.GOLDBERY .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. . .

LITHOLOGY SANDSTONE MEDIUM PALE HEMATITE CEMENTED AND

YELLOW/BROWN W I T H PALE P U R P L E / G R E Y VERTICAL BEARING 10% C L A Y F R A G M E N T S , 5% G L A U C O N I T E .

MOTTLES;

SEDIMENTARY STRUCTURES I06/B ............................ C ROSSBEDDING 1 0 . 0 0 CM S E T S OF T R O U G H C R O S S B E D D I N G DIPPING DEGREES (MIN). FORESETS A R E .50 CM T H I C K , A R E G R A D E D , HAVE A IRON OXIDES ARE WEDGE SHAPED IN L O N G T I T U D I N A L CONTACT WITH THE UNDERLYING S E T . THE F E S T O O N S T R O U G H W I D T H IS 1 0 6 . 0 0 CM. RHEOTROPIC

STRUCTURES

RHEOTROPIC

STRUCTURES

ORGANIC

COMPRISE:

22

DEGREES

(MAX)

AND

17

COARSE SAND COMPONENT, HAVE SECTION AND HAVE A TANGENTIAL COMPRISE S C O O P U N I T S A N D THE

BEDDING

(CROSS).

CONTENT

ORGANIC CONTENT COMPRISES: (IRREGULAR) WOOD. ADDITIONAL

SPARCE

ID

CONCENTRATIONS

OF

OXIDISED

FRAGMENTED

COMMENTS

FORESET DIP IS 22 D E G T O 165. COSET COMPRISES 6 SETS. FE O X I D E S A R E C O N C E N T R A T E D ALONG COMPONENT.

SAMPLE

CONVOLUTE

(TRUE)

CM

FROM

106BI I06B2 I 06B 3 I06B~

FORESET

LAMINAE

WITH

THE

COARSE

SAND

TOP

10 15 30 50

Figure 1B. Sample output. ample, L(4) refers to coded variable number 4 which, in this situation, is 'grainsize (A)'. It is assumed that (apart from comment cards which are identified by an asterisk ' , ' or a dollar '$' in the first position of the line) each data set consists of the same number of lines. The data in each line of the file CODES are as folIOWS:

position

FORTRAN type

1-3

INTEGER

4-6

INTEGER

7-9

INTEGER

10-12

INTEGER

description sequence number within CODES. line number in which code is entered on field card. starting column in which code is entered on field card. ending column in

14-17 19--45

CHARACTER*4 CHARACTER*27

46-114

CHARACTER*70

which code is entered on field card. variable name. Abbreviated description of the variable Enlarged definition of the variable (not used by the program).

The subroutine INCODES (from file SUB 1) reads the file CODES and validates it while setting up an inmemory table which is used by the program to interpret the encoded data. DESCS: For each code in the file CODES there needs to be a list of possible values of the codes and their

50

R. GOLDBERY and K. WINIKOFF

J--I

COMPILATION

L

[

Figure 2. Overall system. corresponding textual descriptions. This is provided by the file DESCS which is read, validated, and set up as in-memory tables by the subroutine INDESCS (again in file SUB 1). These tables can be largewin our present application about 30,000 characters of information. This presents no problem on a main frame computer such as the CDC CYBER 170-825, that we have used. The format of the DESCS file is as follows:

MAIN

position

FOR TRAN type

description

1-4 6-9 11-60

CHARACTER*4 CHARACTER*4 CHARACTER*50

code name value of code description corresponding to particular value of the code.

PROGRAM

Figure 3A. Structure chart of SEDCODE.

Decoding sedimentological field data read, validate CODF~, DFECS set up decodin~ tables ,,

51

]

&

read, validate & list user's field data

@

yes

read next data set to be decoded

I proeese

stop )

I

I

di,pay text

I

F

line

J

yea

Comment card

no no

Figure 3B. Flowchart of main program.

The order of the records in this file are unimportant to the program, but the user usually will group each code together.

previously set up to the textual output, for example ** INVALID COLOUR CODE ** TEXT PROCESSING

VALIDATION AND ERROR DETECTION Validation of source files, CODES, and DESCS, to check conformity with the original format of the field card, redundancy or ommission of required reference code numbers is carried out by the subroutines INCODES and INDESCS. The error messages printed are self-explanatory. Error detection of the coded field data, after entry into the computer, is carried out by subroutines LISTDAT and VALIDAT. Incorrect entries of alphanumeric data into a numeric field generates an error flag at the beginning of the line of code and prints a zero underneath the incorrect entry. Another source of error occurs when a coded entry is used that is not on the DESCS file. This results in a string of asterisks ' , ' in the appropriate position within the data field, which will be translated by an appropriate entry in the tables

The original version of SEDCODE, written in FORTRAN 66, required many cumbersome FORMAT statements to handle the verbal descriptions. For a program of this nature, where the emphasis is upon text processing, it was determined that FORTRAN 66 with its limited flexibility FORMAT statements was unsatisfactory. This was true especially for text longer than 10 characters (for the CDC computer) which must be stored using Hollerith codes in an array. A far more suitable language for this purpose is FORTRAN 77 (Control Data Corporation, 1982) which does have constants and variables of type CHARACTER to handle more conveniently the processing of textual information. To further add flexibility in the formatting of our textual descriptions, a set of subroutines were written to build up the text as lines o f a specified length. As

R. CrOLDBERY and K. WINIKOFF

52

yes

j~ "k. return

extract next word I I from input stringJ

no

~I

-I

display line J

I initialize new line

C add word

to end of line

I -|~

I

yes

Figure 4. Flowchart of display string subroutine 'DS'. soon as a line is full, a new line is started. The basic subroutine is DS (Display String) its overall logic is shown in Figure 4. Additional subroutines to print an integer number (NMINT), a real number (NMREAL)

or a percentage (PERCNT) convert the number concerned to a string (using the internal file feature of FORTRAN 77) which then is passed to DS. The use of multiple entries into the subroutine DS

Table 1. Meaning of special tokens tokens

translated to

meanin 6

CALL NEWLN

/

new l i n e

!

add f u l l

\

print current line with underlining

CALL HEADING

%

following token to be printed as an integer percent

CALL PERCNT(token)

following token to be printed

CALL NMINT(token)

stop,

t h e n new l i n e

CALL DSI('.') CALL NEWLN

as an i n t e g e r

IF(vat) ;

following token to be printed as a real number

CALL NMREAL(token)

following token to be printed w/o blank space

CALL D S l ( t o k e n )

if vat not equal blank close IF

IFfvar.ne.'

') THEN

ENDIF

IFfvar.xx. ) THEN IF(var.xx ..... ) [program checks for . within () of IF statement]

53

Decoding sedimentological field data

and how it is to be printed. A program, 'CONVERT', was written to translate this Display Descriptive Language to the appropriate set of subroutine calls.

is utilized to create three more facilities for the user: DS 1 to print a text string suppressing the blank which usually is prefixed to the text string by DS (useful for adding commas and other punctuation marks); NEWLN for forcing a new line (even if previous line not full); and HEADING which prints the current line followed by a line of minus signs as underlining (this should be modified easily to produce proper underlining if available on the printer being used). A program using these subroutines can become extremely lengthy, for example our program has about 600 subroutine calls and related IF statements. A shorthand method was developed to define what is required

(a) D i s p l a y .

D D D D D D D D

.

.

.

.

.

.

.

.

.

.

THE DISPLAY DESCRIPTIVE LANGUAGE (DDL) As previously mentioned, the display descriptions in SEDCODE are written using a simple language which then is translated by the program CONVERT to a set of subroutine calls. Each line to be translated has a 'D' (for Display) in position 1. The CONVERT program scans the line extracting what is termed herein as 'tokens': each token is handled as indicated in Table

Descriptive .

.

.

.

.

.

.

.

.

.

.

.

.

'L I T H O L O G Y ' \ L(2) I F ( P E R C A . NE.O)' (' ~ P E R C A -')' L(4) L(15) IF(L(16))-'/' -L(16) ; IF(L(17)) 'WITH' L(17) IF(L(18))-'/' -L(18) ; L(19) ; (b) T r a n s l a t i o n

CD

CD

CD

Language .

.

.

.

.

.

.

.

.

.

(DDL) .

.

.

.

.

.

.

;

of above

DDL s t a t e m e n t s

to

FORTRAN

'LITHOLOGY' \ CALL CALL

DS ( ' L I T H O L O G Y ' ) HEADING

CALL

DS (L (R))

L(2)

IF(PERCA. NE.O)' (' %PERCA -')'

;

IF(PERCA. NE. O) T H E N CALL CALL CALL ENDIF CD

L(4)

L(15) CALL CALL

CD

DS(' (') PERC NT (PERC A) DSI (')' )

DS ( L ( 4 ) ) DS ( L ( 1 5 ) )

IF(L(16))-'/'

-L(16)

;

IF(L(16).NE.' ') THEN CALL DSI('/' ) CALL D$1(L(16)) ENDIF CD

IF(L(17))

'WITH'

L(17)

IF(L(17).NE.' ') T H E N C A L L D$ ( ' W I T H ' ) C A L L DS ( L ( 1 7 ) ) CD

IF(L(18))-'/'

-L(18)

;

IF(L(18).NE.' ' ) THEN CALL D$I('/' ) C A L L DSI ( L ( 1 8 ) ) EN DIF CD

L(19)

;

CALL ENDIF

DS ( L ( 1 9 ) )

Figure 5. Sample of conversion from D D L to F O R T R A N

77.

77

R. GOLDBERY and K. WINIKOFF

54

1. Tokens are separated by a comma or a blank. Extra blanks may be added between tokens to improve readability. All tokens not in Table 1, if unaffected by '%', '#' or '.', are recognized as text strings; a literal string is written 'string'. If the string is to contain a single quote, it must be written with two quotes, for example 'JOE"S PROGRAM' will be extracted correctly and translated by CONVERT to CALL DS('JOE"S PROGRAM') and print as JOE'S PROGRAM. Figure 5 shows a section of our program after translation by the CONVERT program.

SUMMARY

SEDCODE has been developed as a coded field data system, with the specific use of describing elastic sedimentary sequences. The descriptions used in the program can be altered readily through the use of external files, in addition, adaptation of this program for other purposes only involves rewriting those parts of the main

program concerning input and output formats of codes and text respectively. The complex processing of textual data carried out through a 'Display Descriptive Language' developed specifically for use within SEDCODE is greatly facilitated by use of the FORTRAN 77 language. REFERENCES Allen, J. R. L., 1982, Sedimentary structures their character and physical basis, in Developments in sedimentoiogy: v. 30A-30B: Elsevier Scientific Publ. Co., Amsterdam, 1256 p. Coilinson, J. D., and Thompson, D. B., 1982, Sedimentary structures: Allen & Unwin, London, 194 p. Conybeare, C. E. B., and Crook, K. A. W., 1968, Manual for sedimentary structures: Bureau Mineral Resources (Canberra), Bull. 102, 327 p. Control Data Corporation, 1982, FORTRAN, Version 5 reference manual, Control Data Corporation, Pubi. Graphics Div., Sunnyville, California. Harms, J. C., Southard, J. R., Spearing, D. R., and Walker, R. G., 1975, Depositional environments as interpreted from primary sedimentary structures and stratification sequences: Soc. Econ. Paleontologists and Mineralogists, Lecture Notes for Short Course No. 2, 161 p. Reineck, H., and Singh, I. B., 1975, Depositional sedimentary environments, with reference to terriginous elastics: Soringer-Verlag, Berlin, 439 p.

APPENDIX

File CODES: Table of coded variables with details of location within field card I 2 3 4 5 6 ? 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40

41

4 3 3 3 5 5 5 5 5 5 5 5 3 3 j 3 3 3 3 3 3 3 3 3 3 4 4 ~ ~ 4 ~ 5 5 5 5 5 3 3 3 3 3

28 I 33 14 25 27 29 45 46 39 ~1 43 46 27 16 18 20 22 24 48 50 59 56 52 54 22 2~ 26 20 17 35 11 9 3 5 7 5 8 11 37 qo

29 4 36 15 26 28 30 45 47 qO 42 44 47 30 17 19 21 23 26 49 51 62 58 53 55 23 25 27 21 19 36 12 10 4 6 8 5 8 11 37 40

CBED CBEDTYPE LIT L I T H O L O G Y (A) LIT LITHOLOGY (B) GS G R A I N S I Z E (A) CHAR CHARACTER CHAR CHARACTER(A) CHAR CHARACTER(A) TYPE BEDTYPE REG REGUL CHAR CHARACTER ( B ) CHAR CHARACTER (B) CHAR CHARACTER ( B ) GS GRAINSIZE (B) IND I N D U R A T I O N (A) COL COLOUR BACKGROUND (A1) COL COLOUR BACKGROUND ( A 2 ) COL COLOUR VARIABLE ( A 1 ) COL COLOUR VARIABLE ( A 2 ) PAT C O L O U R P A T T E R N (A) COL COLOUR BACKGROUND (At) COL COLOUR BACKGROUND ( A 2 ) IND I N D U R A T I O N (B) PAT COLOUR PATTERN (B) COL C O L O U R V A R I A B L E (BI) COL COLOUR VARIABLE (B2) FORE FORESET CHAR ( A ) FORE FORESET CHAR (B) FORE FORESET CHAR (C) SHAP LONGITUD SHAP CONT LOWER CONT FEST FEST SHAPE OEOM GEOM SIMP B E D B E D P BEDPLANE CHAR C H A R A C T S I M P (I) CHAR C H A R A C T S I M P (2) C H A R C H A R A C T S I M P (3) CLAS CLSTIC CONSTIT (I) CLAS CLASTIC CONSTIT (2) CLAS CLASTIC CONSTIT (3) CLAS CLASTIC CONSTIT (4) CLAS CLASTIC CONSTIT (5)

42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82

3 4 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 4 4 5 6 6 6 6 5 1 1 1 2 2 2 3 3 3 3 3 3 3

43 37 2 4 6 9 11 13 16 21 18 23 19 24 20 25 27 29 31 33 ? I 1 I 8 15 26 2 11 16 31 52 58 60 6 9 12 31 38 41 D,4

43 39 3 5 7 10 12 14 17 22 18 23 19 24 20 25 28 30 32 34 7 I 1 I 8 15 26 2 15 20 36 57 59 62 ? 10 13 32 39 42 ~5

CLAS CLIM RHEO RHEO RHEO SURF SURF SURF COMP COMP CONC CONC ORSH ORSH PRES PRES BIOG BIOG BIOG BIOG TRUE NONE NONE NONE NONE NONE NONE GRAD $ $ $ • $ $ $ $ $ $ $ $

CLASTIC CONSTIT (6) CLIM R I P P L E R H E O T R O P I C 5 T R U C (I) R H E O T R O P I C S T R U C (2) R H E O T R O P I C S T R U C (3) SURF M A R K S (I) S U R F M A R K S (2) SURF M A R K S (3) ORGANIC COMPONENT (I) ORGANIC COMPINENT (2) C O N C E N O R G A N I C (I) C O N C E N O R G A N I C (2) SHAPE ORGANIC(1) SHAPE ORGANIC (2) PRES O R G A N I C (1) PRES O R G A N I C (2) B I O G E N IC F E A T U R E B I O G E NIC F E A T U R E B I O G E N IC F E A T U R E BIOGENIC FEATURE TRUE/APP FOREDI P NO C R O S S B E D D I N G NO B E D D I N G NO R H E O T R O P I C NO S U R F A C E M A R K S NO O R G A N I C M A T T E R NO B I O G E N IC GRADED BEDDING GR I DN GR IDE FOTONO THIC K DI PROG DIPDIR PERC I PERC 2 PERC 3 PERCA PERC 4 PERC 5 PE RC 6

Decoding sedimentological field data 83 84 85 86 B7 88 89

3 63 64 % 4 2 6 . 4 8 9 # 4

10 11 #

4 12 16 . 4 30 34 . 4 4o 41 #

PERCB SETTHI K FORMAX FORMIN FORTHIK TROUGHW RIPDIP

90 91 92 93 94 95

4 4 5 5 5 5

42 44 13 17 21 31

43 # 47 16 20 24 34

96

5 35 38

55 LE E DI P RIPTHIK TH IC KN THIC KA I THIC KA2 THIC KB I THIC KB2

Definition of coded variablesfor the file CODES I 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72

CB~D

TYPE OF C R O S S - S T R A T I F I E D UNIT L I T H O L O G Y OF THE M A J O R C O M P O N E N T L I T H O L O G Y OF THE MINOR C O M P O N E N T (2 C O M P O N E N T SYSTEM) W E N T W O R T H - U D D E N S I Z E C L A S S I F I C A T I O N OF (A) F A B R I C , I N T E R N A L S T R U C T U R E , AND M I N E R A L O G Y OF (A) FABRIC, I N T E R N A L S T R U C T U R E , A N D M I N E R A L O G Y OF (A) F A B R I C , I N T E R N A L S T R U C T U R E , AND M I N E R A L O G Y OF (A) T Y P E OF C O M P O U N D B E D D I N G R E G U L A R I T Y OF S P A C I N G OF COMP. (A) & (B) IN C O M P O U N D B E D D I N G F A B R I C , I N T E R N A L S T R U C T U R E , A N D M I N E R A L O G Y OF (B) FABRIC, I N T E R N A L S T R U C T U R E , AND M I N E R A L O G Y OF (B) F A B R I C , I N T E R N A L S T R U C T U R E , A N D M I N E R A L O G Y OF (B) W E N T W O R T H - U D D E N S I Z E C L A S S I F I C A T I O N OF (B) D E G R E E A N D NATURE OF L I T H I F I C A T I O N BY M A T R I X & CEMENT (A) COL P R E D O M I N A N T C O L O R A T I O N OF (A) U P O N A F R E S H S U R F A C E COL C O L O R M O D I F I E R OF THE M A I N C O L O R D E S C R I P T O R ABOVE (A) COL S E C O N D A R Y C O L O R O V E R P R I N T UPON P R E D O M I N A N T C O L O R A T I O N (A) C O L O R M O D I F I E R OF THE S E C O N D A R Y C O L O R O V E R P R I N T OF (A) cOL D I S P E R S A L P A T T E R N OF S E C O N D A R Y C O L O R O V E R P R I N T (A) P T P R E D O M I N A N T C O L O R A T I O N OF (B) U P O N A F R E S H S U R F A C E C~L COL C O L O R M O D I F I E R OF THE MAIN C O L O R D E S C R I P T O R ABOVE (B) D E G R E E A N D NATURE OF L I T H I F I C A T I O N BY M A T R I X & C E M E N T (B) IND D I S P E R S A L P A T T E R N OF S E C O N D A R Y C O L O R O V E R P R I N T OF (B) PAT COL S E C O N D A R Y C O L O R O V E R P R I N T UPON P R E D O M I N A N T C O L O R A T I O N (B) COL C O L O R M O D I F I E R OF THE S E C O N D A R Y C O L O R O V E R P R I N T OF (B) FORE F A B R I C , TEXTURE, I N T E R N A L S T R U C T . , M I N E R . & C O M P O S I T I O N OF F O R E S E T S FORE F A B R I C , TEXTURE, I N T E R N A L S T R U C T . , MINER. & C O M P O S I T I O N OF F O R E S E T S FORE F A B R I C , TEXTURE; I N T E R N A L S T R U C T . , M I N E R . & C O M P O S I T I O N OF F O R E S E T S SHAP S E T G E O M E T R Y ON S E C T I O N P A R A L L E L TO F O R E S E T DIP G E O M E T R I C RELN. B E T W E E N BASE OF F O R E S E T & UPPER SURF. OF UNDERLY. SET CONT 3-D G E O M E T R Y OF I N D I V I D U A L T R O U G H S FEST G E O M E T R Y OF S I M P L E B E D D I N G AS DEFD. BY U P P E R & LOWER B O U N D I N G S U R F A C S GEOM T E X T U R A L , FABRIC OR C O M P O S I T I O N A L E L E M E N T ( S ) D E F I N I N G B E D D I N G PLANE BEDP F A B R I C , TEXTURE, I N T E R N A L S T R U C T . , M I N E R . & C O M P O S I T I O N OF BEDS CHAR F A B R I C , TEXTURE, I N T E R N A L S T R U C T . , MINER. & C O M P O S I T I O N OF BEDS CHAR F A B R I C , TEXTURE, I N T E R N A L S T R O C T . , M I N E R . & C O M P O S I T I O N OF BEDS CHAR A C C E S S O R Y M I N E R A L S OR C O M P O N E N T S W I T H I N L I T H O L O G Y (A) CLAS A C C E S S O R Y M I N E R A L S OR C O M P O N E N T S W I T H I N L I T H O L O G Y (A) CLAS A C C E S S O R Y M I N E R A L S OR C O M P O N E N T S W I T H I N L I T H O L O G Y (A) CLAS A C C E S S O R Y M I N E R A L S OR C O M P O N E N T S W I T H I N L I T H O L O G Y (B) CLAS CLAS A C C E S S O R Y M I N E R A L S OR C O M P O N E N T S W I T H I N L I T H O L O G Y (B) C LAS A C C E S S O R Y M I N E R A L S OR C O M P O N E N T S W I T H I N L I T H O L O G Y (B) CLIM TYPE OF C L I M B I N G RIPPLE L A M I N A T I O N RHEO D E F O R M A T I O N S T R U C T U R E S OF C O H E S I V E S E D I M E N T D E F O R M A T I O N S T R U C T U R E S OF C O H E S I V E S E D I M E N T RHEO RHEO D E F O R M A T I O N S T R U C T U R E S OF C O H E S I V E S E D I M E N T SURFACE MARKINGS & IMPRINTS (NON-RHEOTROPIC) SURF SURF SURFACE MARKINGS & IMPRINTS (NON-RHEOTROPIC) SURFACE MARKINGS & IMPRINTS (NON-RHEOTROPIC) SURF T Y P E OF O R G A N I C M A T E R I A L W I T H I N THE ROCK COMP COMP TYPE OF ORGANIC M A T E R I A L W I T H I N THE R O C K R E L A T I V E C O N C E N T R A T I O N OF O R G A N I C C O M P O N E N T (I) CONC R E L A T I V E C O N C E N T R A T I O N OF ORGANIC C O M P O N E N T (2) C ONC ORSH D E G R E E OF F R A G M E N T A T I O N OF O R G A N I C C O M P O N E N T (I) ORSH D E G R E E OF F R A G M E N T A T I O N OF ORGANIC C O M P O N E N T (2) PRES THE D E G R E E OF A L T E R A T I O N OF ORGANIC C O M P O N E N T (I) PRES THE D E G R E E OF A L T E R A T I O N OF ORGANIC C O M P O N E N T (2) BIOG B I O G E N I C S T R U C T U R E S (ORGANIC F E A T U R E S & T R A C E F O S S I L S ) B I O G E N I C S T R U C T U R E S (ORGANIC F E A T U R E S & T R A C E F O S S I L S ) BIOG B I O G E N I C S T R U C T U R E S (ORGANIC F E A T U R E S & T R A C E F O S S I L S ) BIOG B I O G E N I C S T R U C T U R E S (ORGANIC F E A T U R E S & T R A C E F O S S I L S ) BIOG DIP OF F O R E S E T B E D D I N G TRUE CROSS BEDDING ABSENT NONE SIMPLE BEDDING ABSENT NONE RHEOTROPIC SEDIMENTARY STRUCTURES ABSENT NONE SURFACE (HYDRODYNAMIC) MARKINGS ABSENT NONE ORGANIC M A T E R I A L A B S E N T NONE BIOGENIC STRUCTURES ABSENT NONE GRAD S I M P L E B E D D I N G IS G R A D E D M A P G R I D R E F E R E N C E OF S A M P L E L O C A L I T Y (N) $ M A P G R I D R E F E R E N C E OF S A M P L E L O C A L I T Y (E) $ AERIAL PHOTOGRAPH IDENTIFICATION NUMBER $ LIT LIT GS CHAR CHAR CHAR TYPE REG CHAR CHAR CHAR GS IND

R. GOLDBERY and K. WINIKOFF

56

89

;

TOTAL THICKNESS OF UNIT D E S C R I B E D REGIONAL DIP ( A M O U N T ) REGIONAL DIP ( A Z I M U T H ) PERCENTAGE OF A C C E S S O R Y M I N E R A L / C O M P O N E N T I WIT'HIN (A) PERCENTAGE OF A C C E S S O R Y M I N E R A L / C O M P O N E N T 2 W I T H I N (A) PERCENTAGE OF A C C E S S O R Y M I N E R A L / C O M P O N E N T 3 WITHIN (A) PERCENTAGE-OF LITHOLOGY (A) IN A C O M P O S I T E B E D D E D UNIT PERCENTAGE OF A C C E S S O R Y M I N E R A L / C O M P O N E N T I WITHIN (B) PERCENTAGE OF A C C E S S O R Y M I N E R A L / C O M P O N E N T 2 W I T H I N (B) PERCENTAGE OF A C C E S S O R Y M I N E R A L / C O M P O N E N T 3 WITHIN (B) PERCENTAGE OF L I T H O L O G Y (B) IN A C O M P O S I T E B E D D E D UNIT THICKNESS OF I N D I V I D U A L S E T W I T H I N A C R O S S S T R A T I F I E D COSET MAXIMUM F O R E S E T DIP MINIMUM F O R E S E T DIP FORESET THICKNESS W I D T H OF T R O U G H OR C H A N N E L IN C R O S S S T R A T I F I E D UNITS D I P OF P A R A L L E L S U R F A C E S BETWEEN CLIMBING RIPPLES

90 91 92 93 94 95 96

#

DIP OF LEE SIDE

73 75 T6 T7

$ $ I

T8 79 8O 81 82 83 84 85 86 87 88

$ $

I I # #

OF CLIMBING RIPPLES

TRUE THICKNESS OF I N D I V I D U A L C L I M B I N G RIPPLES THICKNESS OF I N D I V I D U A L S I M P L E B E D S MINIMUM THICKNESS OF L I T H O L O G Y (A) W I T H I N A COMPOSITE MAXIMUM THICKNESS OF L I T H O L O G Y (A) W I T H I N A C O M P O S I T E MINIMUM THICKNESS OF L I T H O L O G Y (B) W I T H I N A COMPOSITE MAXIMUM THICKNESS OF L I T H O L O G Y (B) W I T H I N A C O M P O S I T E

File DESCS: Expanded translation of coded variables L I T

H 0 LO

G Y

LIT

CGL

LIT LIT LIT LIT LIT LIT LIT LIT LIT LIT LIT LIT LIT LIT LIT LIT LIT

CGLP CGLH

CONGLOMERATE

POLYMICTIC CONGLOMERATE MONOMICTIC CONGLOMERATE SST SANDSTONE QAR QUA RTZ A R E N I T E ARK ARKOSE SUBA SUBARKOS E L I T H L I T H A R E N ITE VOAR VOLCANIC ARENITE PHAR PH Y L L A R E N ITE CALC CALC ARENITE SED SEDARENITE TUFF TUFF SIS SILTSTONE MR MUDS TONE CST C LA Y S T O N E ,,tl

mm

CLAS CLAS

G P

GLA U C O N ITE PHOSPHATE

INVALID

LITHOLOGY

CLAS B

B IOC LAST ICS

CLAS CLAS CLAS CLAS CLAS CLAS C LAS CLAS

E

FELDSPAR GYPSUM CHERT CLAY FRAGMENTS IRON OOLITES F E R R U G I N O US

*emm

**

F Y C L I

INVALID

GS

BO

BOULDER

GS GS GS GS

CO P G VC

COBBLE PEBBLE GRANULE V E R Y COARSE

GS GS GS C~ GS GS

C M F VF

COARSE MEDIUM FINE VERY FINE

*I**

**

COL COL COL COL COL COL COL COL

RE BL YL PY 8R W GR PG

RED BLACK YELLOW PALE YELLOW BROWN WHITE GREEN PALE G R E E N

IN y A L I D

CLASTIC

CODE

CONST

GRAINSIZE

CODE

•I

CODE

*e

m*

BED BED BED BED

Decoding sedimentological field data COL COL COL COL COL COL COL COL COL

P PP 0 G V BU PI

PURPLE PALE PURPLE ORANGE GREY V IO LET BUFF PIN K

****

**

PAT PAT PAT PAT PAT PAT PA T PAT

HOM ST SD MO M OH MOV

HOMOGENEOUS DISPERSIONS S TR EA KS S POTS M OTT LES HORIZONTAL MOTTLES VERTICAL MOTTLES

****

**

IND IND IND IND IND IND IN D IND IN D IND IND IND IND IND IND

M MM MC MF MCCA MCPH MCS I MCHE MC LI MCMN FR I F

MASSIVE MASSIVE (MATRIX) MASSIVE (CEMENT) FRIABLE MATRIX CALCITE CEMENTED PHOSPHATE CEMENTED SILICA CEMENTED HEMATITE CEMENTED LIMONITE CEMENTED MANGANESE CEMENTED FR IAB LE I N DURA T E D F ISS I LE

****

m*

INVALID

INVALID

INVALID

COLOUR

CODE

COLOUR

I*

DISPERSAL

DURATION

CODE

CODE

**

C R O S S B E D D I N G .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. . . TR UE T TR UE A TRUE TRUE ****

(TRUE) ( A P P A RENT )

CONT C ONT CONT CONT CONT CONT

TAN AB CON ERO

TANGENTIAL ABRUPT " S EM 1-4 0 NC OR DA NT EROSIONAL

****

**

SHAP SHAP SHAP SHA P SHAP

WE TA ND

WEDGE SHAPED TAB ULA R NOT D E T E R M I N E D

****

**

FORE FORE FORE FORE FORE FORE FORE FORE F ORE FORE FORE FORE FORE FORE FORE FORE F ORE FORE

HO GR RE HM FE G IN CV OH PB SH SF CF MN CS GP

ARE HOMOGENEOUS ARE GRADED HAVE REVERSE GRADING HAVE H E A V Y M I N E R A L C O N C E N T R A T I O N S HAVE IRON OXIDES HAVE GRAVELLY COMPONENT HAVE I NTRASETS HAVE DOWNWARD CURVATURE HAVE ORGANIC MATTER HAVE P E B B L E S HAVE SHELL FRAGMENTS HAVE S A N D F L O W LAMINATION HAVE CLAY FRAGMENTS HAVE MANGANESE DIOXIDES HAVE A COARSE SAND COMPONENT HAVE GYPSUM/HALITE CONCENTRATIONS

****

**

CBED CBED CBED CBED CBED CBED CBED CBED

CH TA TR ?T ?F EP CO AN

CHANNEL FILL TAB ULA R TROUGH POSSIBLE TABULAR POSSIBLE TROUGH E PS ILO N C OM PO UN D ANTIDUNE

**

INVALID

INVALID

INVALID

INVALID

FORESET

CONTACT

SHAPE

DIP C O D E

CODE

CODE

FORESET

**

*'

**

HOMOG

CODE

**

*a

57

R. CaOLDBERY a n d K . WINIKOFF

58 CBED CBED CBED CBED CBED

HB UN HU

HERRINGBONE UNDEFINED HUMMOCKY

****

**

FEST FEST FEST FEST FEST

SC CY ND

SCOOP CYLINDRICAL NOT D E T E R M I N E D

****

**

C

GLIM C LIM CLIM C LIM CLIM

INVALID

INVALID

IN IN IN

PHASE DRIFT DRIFT

****

**

INVALID

GRAD X GRAD GRA D m * I m

I M

GRADED i*

CODE

FESTOON

L I M B

IPH IDL IDS

S

BEDTYPE

SHAPE

I N G

(LEE (LEE

R I

**

P P L ES

ONLY) AND STOSS)

GEOMETRY

P L E

CODE

B E

CODE D D

**

I N G

BEDDING

INVALID

GRADED

BEDDING

CODE

**

C HAR CHAR C HAR CHA N C HAR CHAR CHAR CHAR C HAR CHAR

HO HM FE G ST SL WE GR

WITH HOMOGENEOUS COMPOSITION WITH HEAVY MINERAL CONCENTRATIONS WITH IRON OXIDES WITH GRAVELLY COMPONENT WITH SILTY COMPONENT WITH SLUMPING WITH WATER ESCAPE STRUCTURES GRADING

****

**

BEDP BEDP BEDP BEDP BEDP BEDP BEDP BEDP BEDP BEDP BEDP

CF MC FM HM FE PO DW HO PD

DEFINED BY A COARSE TO FINE SANDSTONE TRANSITION D E F I N E D B Y A M E D I U M TO C O A R S E S A N D S T O N E TRANSITION DEFINED BY A FINE TO MEDIUM SANDSTONE TRANSITION DEFINED BY HEAVY MINERAL CONCENTRATIONS DEFINED BY IRON OXIDES DEFINED BY PREFERRED ORIENTATION OF C L A S T I C M A T E R I A L DEFINED BY DIFFERENTIAL WEATHERING NOT D E V E L O P E D I N T E R N A L L Y POORLY DEFINED

***1

1*

GE OH GE OM GEOM GE OH GE OM

TP TN W

TABULAR(PARALLEL) TABULAR(NON PARALLEL) WA VY

****

**

C

INVALID

INVALID

INVALID

OM

P OS

TY PE P TYPE L TYPE W TYPE F TYPE TYPE ****

PLA HA R LENTIC ULAR WAVY FLASER

REG REG REG REG

RE IR

REGULAR IRREGULAR

****

**

**

R

RHEO RHEO RHEO RHEO RHEO

SU CD CS FS CB

INVALID

INVALID H E

CHARACTER

BEDPLAN

GEOMETRY

CODE

CODE

**

CODE

I T E

B E

BEDTYPE CODE

REGULARITY

0 T R 0

P I C

*~

**

D D I N G

**

CODE S

T R

SAND/MUD VOLCANOES C LASTIC DYKES C L A S T IC S I L L S FLAME STRUCTURES CONVOLUTE BEDDING (PLANAR)

U C T

U R E S

59

D e c o d i n g s e d i m e n t o i o g i c a l field d a t a RHEO RHEO RHEO RHEO RHEO RHEO RHEO RHEO RHEO RHEO

CX CU BP LC LR BU RP DC

CONVOLUTE BEDDING (CROSS) CUSP STRUCTURES BALL AND PILLOW LOAD CASTS LOADED RIPPLES BUBBLES/GAS PITS RAIN PRINTS DESSICATION CRACKS

***w

*w

S

INVALID

U R F .....

AC

= ¢ z ¢

S URF S URF S URF SURF SURF SURF SURF SURF SURF

RHEOTROPIC

E

-" n - - - -

M A ¢----.~.~

R

z ~-°

P SW RM OS RF FL R

P A R T I N G L I N E A T ION WAVE AND SWASH MARKS RILL MARKS OBSTACLE SCOUR RIDGE AND FURROW FLUTES RI P P L E S

****

~'

INVALID

CODE

*w

K I N

GS

¢- - ¢ .- -- ¢ z z r. = ~

SURF.MARKS

CODE

lw

O R G A N I C F E A T U R E S ================================ COMP COMP COMP COMP COMP COMP COMP

L WO R CO PE

LEA VES WOOD ROOTS COAL PE D O G E NIC

FEATURES

****

wwINVALID

ORG.

CONC CONC CONC CONC CONC

S M H

SPARCE CONCENTRATIONS MEDIUM CONCENTRATIONS HIGH CONCENTRATIONS

'***

• * INVALID

CONCENTRATION

ORSH ORSH ORSH ORSH ORSH

W F I

WHOLE FRAGMENTED FRAGMENTED

(REGULAR) (IRREGULAR)

PR ES PRES PRES PR ES PR ES PRES

P C 0 R

WELL PRESERVED CARBONACIOUS OXIDISED POORLY DEFINED

****

wm

*omw • w I N V A L I D

B

BIOG BIOG BIOG BIOG BIOG BIOG BIOG BIOG BIOG BIOG BIOG BIOG

INVALID

I 0

G E N

ORG.

ORG.

COMPONENTS

SHAPE

CODES

CODE

CODE

F

EA

ww

ml

PRESERVATION

I C

ms

T

CODE

U R

ml

ES

BI SK TS TI TB C TR AD AL FC

B IOT U R B A T ION S KO LIT HES W O R M T U B E S (ON B E D D I N G S U R F A C E ) WORM TUBES (VERTICAL) INDIVIDL WORM TUBES (VERTICAL) BRANCHING C R U/IA NA TRACKS AND TRAILS ALGAL STRUCTURES (PARALLEL LAMINAE) ALGAL STRUCTURES (CONCENTRIC LAMINAE) FAECAL PELLETS

****

**

NONE X NONE NONE w ~ l J

INVALID

BIOGENIC

CODE

NO NE mw

INVALID

NONE

CODE

ww

mm

R. GOLDBERY and K. WINIKOFF

60

File MAIN PROGRAM SEDCODE( O U T P U T

)

Ci i l i l l l l l l t l l i l l l l l l l l l l l l l l t l l i l i l l l l * l l i l i t l t i

C C C C C C C C C C C

INTERPRET

LITHOLOGICAL

REVISED:

AUTHORS:

SEPTEMBER

RON BEN

PARAMETER

( MXCRDNO

LOGICAL

LISTI,

COMMON COMMON

/PI/ /P2/

*****

TABLES

TO

( MXCDCDS

LOCATE -" 99

CODES

IN

INPUT

COMMON / C 1 / COMMON / C 2 /

NCODES,

CRDCOD1 CRDCOD2

STORED

IN

C HARACTER*90 CHARACTER*500

LINE(6) C OMENT

COMMON

LINE

/L

/

N S A H PLS,

**i

*****

'LINE'

CARDNO

L AGE SECTNH, WELLNM DATE SAMPNO LOC, F O R M N , N A M E MAPSRC

CHARACTER*5 CHARACTER*t2 INTEGER I PERC5, 2 FORMAX

FOTONO*6

DEPTH SAMPID PERCI, P E R C 2 , PERC3, PERC4, PERC6, PERCA, P E R C B , , FORHIN , RIPDIP , LEEDIP SETTHIK,

*****

ARRAY

GRIDN*5, GRIDE*5 , FOTONH*IO, DIPREG*2, DIPDIR*3

REAL

lttt**l*

)

CRDCODI(MXCDC DS, 3) CR DCOD2(MXC ~ DS)

DATA

**

6)

NC ODES,

CHARACTER CHARACTER

° o .

Itliil

LIST2

USED

CHARACTER*50 CHARAC TER*5 C HARACTER*5 CHARAC TER*6 CHARAC TER*7 CNARACTER*IO CHARACTER*tO

111

=

ilil

INTEGER C HARACTER*~

INPUT

ll

!!

It

DATA

LISTI LIST2

INTEGER

C/

STRUCTURE

* ! llll

1985

i l t l l l l l l l l l i l l * t l * l t l l i l l *

PARAMETER

C ...

it*

GOLDBERY & KINGSLEY WINIKOFF GURION UNIVERSITY OF T H E N E G E V

C l i , l t l l l i l l l l i l l

C

& SEDIMENTARY

ittlll

START

CALL

PARAHS(

CALL CALL

INC O D E S IN D E S C S

CALL

LISTDAT(

OF

FORTHIK, EXECUTABLE

LISTI,

LIST2

NSAMPLS

OPEN(2,FILE='GTEMP' G O T O 222 ERROR DURING OPEN CONTINUE PRINT*,' E R R O R ON STOP

TROUGHW, CODE

FOR

MAIN

THICK PROG

)

)

,STATUS:'OLD'

OPEN

RIPTHIK,

''GTEMP'':

,ERR=It I, I O S T A T : I O S )

IOS

=

',

IOS

*****

lit

Decoding sedimentological field data 222

6

CONTINUE REWIND 2 W R I T E ( * , ' (' 'A'')' ) READ(2,7000) DO

100

CARDNO,

LINE(1)

N=I, NS.A M P L S

READ(LINE(1),7100) MAPSRC, FOTONO, SECTNM, WELLNM

GRIDN,

GRIDE,

READ(2,7000) CARDNO, LINE(2) READ(LINE(2),7200) SAMPNO, DATE AGE , NAME, T H I C K , D I P R E G ,

. LOC DIPDIR

FOTONM,

, FORMN

,

LEFT J U S T I F Y ' S A M P N O ' J = 0 DO 101 I=I, 10 IF(SAMPNO(I:I).NE.' ') T H E N J = J+l SAMPNO(J:j) .- S A M P N O ( I : I ) ENDIF CONTINUE

101

DO

102 I = J + 1 , I0 SAMPNO(I:I) : CONTINUE

102

I

' '

READ(2,7000) CARDNO, LINE(3) READ(LINE(3),7300) PERCI , PERC2 , PERC3 PERC4 , PERC5 , PERC6 , PERCB READ(2,7000) READ(LINE(4)

I

CARDNO, LINE(4) ,7400) SETTHIK,

TROUGHW,

RIPDIP

,

LEEDIP

FORMAX , FORMIN , RIPTHIK

READ(2,7000) C A R D N O , L I N E (5) READ(LINE(5),7500) THICKN , THICKAI, THIC KB2 READ(2,7000) C/

*****

START

CARDNO, OF

, PERCA

, FORTHIK,

THICKA2,

LINE(6)

PRINTING

*****

IIIII

W R I T E ( * , ' ('' I '')' ) PRINT PRINT PRINT PRINT I

I

D

D D D D D D D D D D D D C C C CAGEO 12:l-E

8000, 8101 8000, 8111, FOTONO, PRINT 8000, PRINT*

('-',I--I,76) ('-',I=I,76) M A P S R C , G R I D N , GRIDE, SECTNM, WELLNM ('--',I--I,76)

PRINT* P R I N T 8000, '-', I = I , 7 6 P R I N T 8100 P R I N T 8000, '-', I = I , 7 6 P R I N T 8110, S A M P N O , DATE, DIPREG, DIPDIR, NAME P R I N T 8 0 0 0 , ( '=', I = I , 7 6 PRINT*

FORMN,

)

/

'LITHOLOGY' \ L(2) IF(PERCA.NE.O)'(' ~ P E R C A -')' ; L(4) L ( 1 5 ) IF(L(16))-'/' -L(16) ; IF(L(17)) 'WITH' L(17) IF(L(18))-'/' -L(18) ; L(19) ; -';' L(14) I F ( L ( 3 7 ) ) 'AND S E A R I N G ' % P E R C I L(37) I F ( L ( 3 8 ) ) - ' ,' % P E R C 2 L ( 3 8 ) ; IF(L(39))-',', ~PERC3, L(39) ; ! .............................

FOTONM,

) ) LOC,

;

,

AGE,THICK,

THICKBI,

R. GOLDBERYand K. WINIKOFF

62

D IF(PERCA.NE.O) ' I N T E ~ B E D D E D W I T H ' L(3) S P E R C B L(13) L ( 2 0 ) D IF(L(21))-'/' -L(21) ; D I F ( L ( 2 4 ) ) 'WITH' L ( 2 4 ) D IF(L(25))-'/' -L(25) ; ; D L(23) -';' L(22) D I F ( L ( 4 0 ) ) ' A N D B E A R I N G ' ~PERC4 L ( 4 O ) ; D I F ( L ( 4 1 ) ) - ' , ' %PERC5 L ( ~ I ) ; D IF(L(~2))-',' %PERC6 L(42); ! ; C /'SEDIMENTARY STRUCTURES', SAMPNO \ D D IF(L(63).NE.'NONE') 'CROSSBEDDING' \ I F ( L ( 1 ) ) . S E T T H I K 'CH S E T S OF' L(1) ' C R O S S B E D D I N G D I P P I N G ' D D L(62) #FORMAX 'DEGREES' D I F ( F O R M I N . E Q ° O ) - ' .' ; IF(FORMIN.NE.O) ' ( M A X ) AND' # F O R M I N ' D E G R E E S (MIN)' ! ; D D ' F O R E S E T S ARE' . F O R T H I K 'CM T H I C K , ' L ( 2 6 ) D IF(L(2?))-',' L(27) ; D IF(L(28))-',' L(28) ; D 'ARE' L ( 2 9 ) 'IN L O N G T I T U D I N A L S E C T I O N A N D H A V E A' D L ( 3 0 ) ' C O N T A C T W I T H THE U N D E R L Y I N G S E T . ' D I F ( L ( 3 1 ) ) 'THE F E S T O O N S C O M P R I S E ' L ( 3 1 ) ' U N I T S ' D 'AND THE T R O U G H W I D T H ' D IF(TROUGHW.NE.O.O) 'IS' . T R O U G H W 'CM' ; D IF(TROUGHW.EQ.O.O) ' C O U L D NOT BE D E T E R M I N E D ' ; ! ; ; C C . . . . . . . - . . . . . . . . . -- . . . . . . . . . C D IF(L(43)) '(CLIMBING RIPPLES)' \ D ' C L I M B I N G R I P P L E S D I P P I N G AT' # L E E D I P ' D E G R E E S ' D 'ON A N I N C L I N E D S U R F A C E OF' # R I P D I P ' D E G R E E S . ' D 'TRUE T H I C K N E S S OF S E T IS' . R I P T H I K 'CM' i ; ; C C ........................... C D IF(L(64).NE. 'NONE') D IF(L(33)) /'SIMPLE BEDDING' D I F ( L ( 6 9 ) ) '(' - L ( 6 9 ) - ' ) ' ; \ D . T H I C K N 'OH' L ( 3 2 ) 'BEDS, W I T H A B E D D I N G PLANE' L ( 3 3 ) ! D 'BEDS ARE' L ( 3 4 ) D IF(L(35)) -',' L(35) ; D IF(L(36))-',' L(36) ; ! ; C D IF(L(8)) /'coMpoSITE BEDDING' \ D IF(L(4)) L(4), 'GRAINED' ; D 'BEDS OF' L ( 2 ) D '(' . T H I C K A I 'CM TO' . T H I C K A 2 'CM T H I C K ' L ( 5 ) D I F ( L ( 6 ) ) -',' L(6) ; D I F ( L ( 7 ) ) -',' L ( 7 ) ; D -' ,' D ' I N T E R B E D D E D W I T H ' L ( 8 ) -',' L(9) ' S P A C E D , ' D IF(L(13)) L(13); L(3) D '(' . T H I C K B I 'CM TO' . T H I C K B 2 'CH T H I C K ' L ( I O ) D I F ( L ( 1 1 ) ) -' ,' L ( 1 1 ) ; D IF(L(.12)) -',' L ( 1 2 ) ; I " ; ; C D IF(L(65).NE.'NONE') /'RHEOTROPIC STRUCTURES' \ D 'RHEOTROPIC STRUCTURES COMPRISE:' L(44) D I F ( L ( 4 5 ) ) -';' L ( 4 5 ) ; I F ( L ( 4 6 ) ) -';' L ( ~ 6 ) ; ! ; C D IF(L(66).NE.'NONE') /'HYDRODYNAMIC SURFACE MARKING' \ D ' H Y D R O D Y N A M I C S U R F A C E M A R K I N G S COMPRISE:' L ( 4 7 ) D IF(L(48)) -';' L(48); IF(L(49)) -';' L(49) ; ! ; C D IF(L(67).NE.'NONE') /'ORGANIC CONTENT' k D 'ORGANIC CONTENT COMPRISES:' L ( 5 2 ) 'OF' L ( 5 6 ) L ( 5 4 ) L ( 5 O ) D I F ( L ( 5 3 ) ) 'AND' L ( 5 3 ) 'OF' L ( 5 7 ) L ( 5 5 ) L ( 5 1 ) ; ! ; C D IF(L(68).NE.'NONE') /'BIOGENIC FEATURES' \ D ' B I O G E N I C F E A T U R E S C O M P R I S E : ' L(58) D I F ( L ( 5 9 ) ) -';' L ( 5 9 ) ; I F ( L ( 6 0 ) ) -';' L ( 6 0 ) ; D I F ( L ( 6 1 ) ) -';' L ( 6 1 ) ; ! ;

C

...

SKIP

COMMENT

CARDS

( COLUMN

I : ASTERISK

'*'

)

READ(2,7OOO,END = 100 ) C A R D N O , L I N E ( 1 ) IF(LINE(1)(I: I).NE.'*'.AND. LINE(1)(I: I).NE.'$') I GOTO 100 IF(LINE(1)(I: I).EQ.'$') G O T O 40 IF(LINE(1)(I:I).EQ.'*') /'ADDITIONAL COMMENTS' \ ; C

IC

OM ENT : I

=

'

'

Decodingsedimentological field I0

20

dam

63

CONTINUE II = 2 CONTINUE I2 = I N D E X ( L I N E ( 1 ) , ' # ' ) IF( I2. NE.O ) T H E N IF( ( I I . E Q , 2 ) .AND. ( I C . G T . I) ) T H E N COMENT(I:IC+I) -- C O M E N T ( I : I C ) / / ' ' IC = IC + I ENDIF ICN = IC + I2 - 11 COMENT(I:ICN) = COMENT(I:IC)//LINE(1)(II:I2-1) C O M E N T ( I : ICN) ! COMENT .- ' ' 11 : I2 + 1 LINE(1)(12:I2) : ' ' IC = I G O T O 20 ENDIF ICN IF(

= IC + I L E N ( L I N E ( 1 ) ) + I - II I C N . G T . IC ) T H E N IF( ( I I . E Q . 2 ) .AND. ( I C . G T . I) ) T H E N COMENT(I:IC+I) = COMENT(I:IC)//' ' IC = I C + I ICN:

30 D

ICN

*

1

EN DIF COMENT(I:ICN) = COMENT(I:IC)//LINE(1)(II:ILEN(LINE(1))) IC = IC N ENDIF READ(2,7000, END=30) CARDHO, LINE(1) IF(LINE(1)(I:I).EQ. 'w' ) G O T O 10 C ONT IN UE I F ( I C N . G E . I) COMENT(I:ICN); IF( E O F ( 2 ) . N E . O . O ) GOTO

40

5O

/ / 100

C ONT IN UE IF(LINE(1)(I: I).EQ.'$') THEN WRITE(*,' (15X,A)')'SAMPLE ID W R I T E ( * , ' (15X, A)' )' . . . . . . . . . ENDIF CONTINUE LL = ILEN(LINE(1)) L2= 1

+

CM

FROM

TOP'

1

C 60

C ONT I N UE

C LI = L2+I CALL XWORD(LINE(1), LI, L2 ) I F ( L I . G E . LL. O R . L 2 . G T . L L ) G O T O 80 SAMPID = LINE(1)(LI:L2-1) L1 = L 2 + 1 IF(L1.GT.LL) GOTO 70 C A L L X W O R D ( L I N E ( 1 ) , L I,L2) IF(L2. G T . L L ) G O T O 80 DEPTH = LINE(l) (hi:L2-1) P R I N T 8510, S A M P I D , DEPTH G O T O 60 ?0

80

CONTINUE PRINT 8520,'WARNING P R I N T 8520,'

-

''$'' L I N E P R O B A B L Y T O O L O N G ~' M U S T NOT E X C E E D 90 C H A R A C T E R S . '

CONTINUE READ(2,7OOO,END=IO0) CARDNO, IF(LINE(1)(I:I).EQ.'$') GOTO

100

LINE(1) 50

CONTINUE C LOS E(2, S T A T U S = 'KEEP' ) STOP

C Cl i J J l J * l * i * i J i * J J * J l l J l J l l J l l i l i l i J

C/

7000 7100

*****

F

0

FORMAT( FORMAT(

17X, AIO,

R. M A T

S

I2, IX, A ) 2A5, AIO, A6,

JJiJ*ll*

T A T E M E

2A5

)

*Ji*

ill

N T S

JlJi*ll*

**ml*

* * t l l l l l J l i

R. GOLDBERY and K. WINIKOFF

64 7200 FORMAT( 7300 FORMAT( 7400 FORMAT( 7500 FORMAT(

A7, A6, 2AI0, A5, a10 ,F6.2, A 2 , A 3 ) 2 ( 5 X , I 2 , 2 ( I X , I 2 ) , I T X , 12) ) IX,FS. I, IX, 212, FS. 2, 13X,F5. 1 , 5 X , 2 1 2 , F4. I) 12X, F4. I, 2F4. I, 6X, 2F4.1 )

8000 FORMAT(

15X,

8100

120AI

)

F O R M A T ( 15X, ' S A M P NO * D A T E * L O C A T I O N * F O R M A T I O N *' , ' AGE * THICK * REG. DIP ', 'i S A M P L E D BY' ) FORMAT(15X,'MAP S O U R C E * G R I D REF ( N ) * G R I D REF (E)* ', I 'AREAL PHOTO* PHOTONO* SN ID * W E L L ' ) F O R M A T ( 1 5 X , A 7 , 2X,A6, IX,AIO, IX,AIO, I X , A 5 , F 8 . 2, 5X,A2, IX,A3, 4 X , A I O ) FORMAT(15X,A10, SX,A5,8X,AS, TX,AIO, 4X,A6,3X,2(2X,AS) ) FORMAT( ]5X, 2X, A, 3X, A )

I 2 8101 8110 8111 8510

8520 FORMAT(]OK,

A

)

END

File SUB I SUBROUTINE PARAMS( LIST], LIST2 ) CJJJJJJJJJJJJJJJJiJJJJJiJlJJilil*iJJJ*lililJiltilJil*liililJi**i*lilit C C SET PARAMETERS CONTROLLING PRINTING C ClJJJJiililiJ*JJJiliJiiJiJJliliiJlillitililileli*ii*iiltlitet*tile****

LOGICAL LIST], CHARACTER*90 OPEN(

LIST2 LINE

I, F I L E = ' D A T A S ' ,

STATUS='OLD',

ERR=80,IOSTAT=IOS)

READ( I, 7000 ) L I N E C L O S E ( I, S T A T U S = ' K E E P ' ) IF(

LINE(I:6).EQ.'PARAMS' IF(

LINE(8:8).EQ.'Y' LIST] = .TRUE. ELSE L I S T ] = .FALSE. ENDIF

)

THEN

) THEN

IF(

LINE(IO:IO).EQ.'Y' L I S T 2 = .TRUE. ELSE LIST2 = .FALSE. ENDIF

) THEN

ELSE LIST] LIST2

= .FALSE. = .FALSE.

ENDIF

CD

'THERE

WILL

BE'

IF(.NOT.LISTI)'NO';

CALL DSC'THERE WILL IF(.NOT.LISTI) THEN CALL DS('NO')

BE')

'LISTING

OF C O D E S '

//

Decoding mdimentolo~cal field dam ENDIF CALL DS('LISTING CALL NEWLN CALL NEWLN CD

OF

65

CODES')

' T H E R E W I L L BE' I F ( . N O T . L I S T 2 ) ' N O ' ; 'LISTING C A L L D S ( ' T H E R E W I L L BE') IF(.NOT.LIST2) THEN CALL DS('NO') ENDIF CALL D$('LISTING OF D E S C R I P T I O N S ' ) CALL NEWLN CALL NEWLN

OF

DESCRIPTIONS'

//

C RETURN

C ...

ERROR

ON

OPEN

C 80

CONTINUE PRINTm, ' ERROR STOP

ON

OPEN

''DATAS'':

IOS

=

',lOS

C

7000

FORMAT(

A

)

END

CHARACTERmSO FUNCTION L( CODENO ) ClllQ|lllJ|llml|IlJUl,lmllllm~IlmlmlllmgalmlJJ,lIWlli~lllIQmll,mmlllml C C C

EXTRACT

DESCRIPTION

FOR

GIVEN

CODE

& VARIABLE

===========================================

~ =:=

C

CJJJilaiJJJlJ,JJJlJJJiJJlJJJliJJJJJJil,liJJJJlllJiiJlJl,JJJJJlJJJJJJJJ C

PARAMETER

( MXVARS = 3 0 ,

PARAMETER

(

MXCDCDS

= 99

INTEGER CHARACTERm~

CODENO VARNAME,

INTEGER INTEGER

NO, FROM, ROW, C O L

MXCODES

:

20

)

)

CODE TO

CHARACTER*4 VARS(MXVARS), CODES( MXVARS, MXCODES ) CHARACTER*50 DESCS( MXVARS, MXCODES ) COMMON COMMON COMMON COMMON

/AI/ /A2/ /A3/ /A4/

NOVARS, NOC O D E S (MXVA RS ) VARS CODES DESCS

INTEGER CHARACTERiq

C RDC OD I (MXC DC DS, 3) C R D C O D 2 ( M X C DC DS)

COMMON / C 1 / COMMON / C 2 /

NCODES , CRDCOD2

CHARACTERW90

LINE(6)

ILl

COMMON

CRDCOD1

LINE

CiitllllliltllllillllillililiJilli||||,ltltiltl|lllliilllllltlllllll|i C/

C

t,m~i

START

OF

EXECUTABLE

NO FROM TO

= CRDCODI(CODENO;I) = CRDCODI(CODENO,2) = C R D C O D I ( C O D E N O , 3)

CODE

= LINE(NO)(FROM:TO)

VARNAME

= CRDCOD2(CODENO)

CODE

wlmm~

66

R. GOLDBERY and K . WINIKOFF

IF( C C C

INDEX('.#~$',VARNAME(I:I)).NE.O) WE

HAVE

FOUND

AN

PRINTm, ' ATTEMPT STOP ENDIF IF(

CODE.EQ.' h

•

'

ENTRY TO

IN

THEN

TABLE

DECODE

NOT

NUMERIC

TO

BE

CODE

CONVERTED

!!

!!!'

' ) THEN

!

R E T U R N ENDIF C

...

DETERMINE

DO 100 100

ROW

CORRESPONDING

TO

GIVEN

'VARNAME'

ROW--1, NOVARS

IF( V A R N A M E . E Q . V A R S ( R O W ) CONTINUE

) GOTO

120

P R I N T w, ' U N M A T C H E D VARIABLE NAME -CHECK V A R I A B L E N A M E IN B O T H ' P R I N T m, ' C O D E & D E S C R I P T I O N TABLES. ( E R R O R D E T E C T E D IN F U N C T I O N ' P R I N T m, ' ' ' D E S C R I P ' ' A T S T O P 111 )' S T 0 P 111

120 C C C C C

... ... ... ... ...

CONTINUE L O O K F O R P O S I T I O N OF C O D E - N O T E : IF C O D E IS I N V A L I D THE PREVIOUS VAILIDITY CHECKING ENSURES THAT THE FIRST P O S I T I O N OF THE C O D E IS AN A S T E R I S K ('J'). THIS ROUTINE CONVERTS T H E C O D E TO ,mils, W H I C H S U B S E Q U E N T L Y CAUSES AN A P P R O P R I A T E E R R O R M E S S A G E TO BE E X T R A C T E D .

IF(

130

CODE(I:I).EQ.

)

CODE = , m a a a ,

DO 130 C O L = I , NOC ODES (ROW) I F ( CODE. EQ.CODES(ROW,COL) CONTINUE P R I N T m, P R I N T i, P R I N T w, P R I N T i, P R I N T m, S T 0 P

1rio

lm'

' ' ' ' '

)

G O T O lqO

U N M A T C H E D C O D E - DUE TO V A L I D I T Y C H E C K I N G IN THE' SUBROUTINE ''INDATA'', W E S H O U L D N E V E R GET THIS' ERROR MESSAGE PRINTED - C H E C K PROGRAM LOGIC ! ! ' ( E R R O R D E T E C T E D IN F U N C T I O N ''DESCRIP'' AT S T O P ' , 2 2 2 ).' 222

CONTINUE L = DESCS(

ROW, COL )

RETURN CiJllll

JllliJllllJl

JlllJ

J JilJJJJJlJlJl

JJJJlJJJl

JllllJ

J J J JJllJ

JilJlJ

ill

END

SUBROUTINE

LISTDAT(

NSAMPLS

)

CJJJJJJIJJJJJJJJJJJJJJJIJJJJJIJJJJJIJJIJIJJJJJJJJJIJJIJJJJIJJJIJJJJJJJ

C C

LIST

DATA

FOR

VISUAL

VERIFICATION

C C l l l i l i l i i l l l l i i l l l i l i l i i t i l l l l l i l i l l i l t l l l l l i l l l l i l i i l l l i i l l i l l i l l i l t

( MXCRDNO

= 6)

INTEGER INTEGER

NSAMPLS LINENO,

CARDNO

CHARACTERW90 CHARACTERm?2 CHARACTERWIO CHARACTER~50

LINE(6) ERRORS(6) SAM PLNO DESCRIP

PARAMETER

CHARACTER*? NTH(9) DATA NTH/'FIRST', 'SECOND', 'THIRD', 'FOURTH', I 'SIXTH', 'SEVENTH', 'EIGHTH', 'NINTH' /

CJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ

Cmmmn C jmwl C momm

PRINT m P R I N T m , ° E N T E R N A M E OF READ(U,7000) FILNAME

DATA

FILE

.....

'FIFTH',

j j j | j j j j j

',

Decoding sedimentological field data OPEN(

80 81

85

86

I, G O T O 81 PRINT*,' STOP CONTINUE REWIND I O P E N ( 2, G O T O 86 CONTINUE PRINT*,' STOP CONTINUE REWIND 2

FILE='DATAS',

STATUS='OLD',ERR=80,IOSTAT=IOS)

ERROR

''DATAS'':

ON O P E N

... ... I

IOS

ERROR

NSAMPLS

=

LINENO NERRORS

= 0

ON O P E N

''GTEMP'':

IOS

IOS

IOSTAT=IOS)

= ', IOS

0

=

0

READ'

L O O P TO R E A D DATA FILE, A P P E N D L I N E N U M B E R S , S A M P L E N U M B E R A N D C A R D ( W I T H I N S A M P L E ) N U M B E R A N D W R I T E T O F I L E 2. CONTINUE R E A D ( I , 7100, E N D = t 9 0 ) LINE(1) IF(LINE(1)(I:6).EQ.'PARAMS') GOTO

100

= ',

STATUS='NEW' , FILE='GTEMP' , ERR=B5,

D E S C R I P = 'INPUT DATA AS CALL PGHEAD( DESCRIP ) C C

67

I

CONTINUE DO

102

102 I = 2 , M X C R D N O R E A D ( I , 7100, E N D = 1 8 0 ) CONTINUE CALL

VALIDAT(

READ( DO

LINE,

LINE(2),

110

LINE(I)

ERRORS

'(A)'

)

)

SAMPLNO

I=I,MXCRDNO

CARDNO LINENO PRINT

= I = LINENO 8200,

+ I

LINENO,

SAMPLNO,

CARDNO,

LINE(I)

I F ( E R R O R S (I). NE.' ') THEN P R I N T 8210, E R R O R S ( I ) NERRORS = NERRORS DO 105 J = 1 , 7 2

105

WRITE(2,600O)

... 120

...

180

190

=

HANDLE

SAMPLNO,

CARDNO,

LINE(1)

NSAMPLS ANY

I

+

NUMBER

OF C O M M E N T

CARDS

(COL

I = '*' )

CONTINUE READ(I,7100,END=190) LINE(1) IF( L I N E ( 1 ) ( I : I ) . E O . ' * ' .OR. L I N E ( 1 ) ( I : I ) . E Q . ' $ ' ) LINENO = LINENO + I CARDNO = CARDNO + I P R I N T 8200, L I N E N O , S A M P L N O , C A R D N O , L I N E ( 1 ) WRITE(2,6000) LINENO, SAMPLNO, CARDNO, LINE(1) G 0 T 0 120 ENDIF GOTO

C

LINENO,

CONTINUE NSAMPLS

C

I

I F ( E R R O R S ( 1 ) (J: J) .NE. ' ') LINE(I)(J:J) = ERRORS(I)(J:J) CONTINUE ENDIF

I

110

+

E

R

R

100

O

R

CONTINUE PRINT*, ' E

S ...........

R

R

CONTINUE DUMMY = EOF(I )

O

R

-

INCOMPLETE

FINAL

DATA

SET

'

THEN

R. GOLDBERY and K. WINIKOFF

68

CLOSE(1) ENDFILE 2 C LOS E (2, S T A T U S = 'KEEP' ) RETURN CJ i i l J l l l J J l l J l i l J J l J J J l l l l l l t l i l l l J J l i J

6000

FORMAT(

I5,

J ill

IX, AIO,

7000 FORMAT 7100 FORMAT

A7 ) A )

8200 FORMAT 8210 FORMAT

10X, I6, 1 0 X ,' ~ * *

Cilli|Qlilll

IX,

12,

IX,

A

JlJlltJJJtltliltJllJlllJtl

)

3X, AIO, I8, 3X, A ) ERRORS IN ABOVE L I N E I * * ' , 2 X ,

J| Jmilow~ilJmi~

Jmlm~wim~I|~Im

A )

mwi|w Jl Jiiwlwmllm|Qi

jijiwmiii

END

SUBROUTINE CII,mIIIIIIII

C

PRINT

C

TITLE

)

PAGE

HEADING

WITH

J J~llilJmm

CURRENT

DATE

Ji~iimwmi~

Jml Jr*g|

& TIME

=============================================

C'illili'l

C

PGHEAD(

J,oI,,mm~mJlJDeiIQmi|lII1mell

i'l iilll

il Ill I li'liillillil

CHARACTER'(*) CHARACTER*50 CHARACTERi I0

TITLE TITLE I DATE, T I M E

INTEGER DATA

PAGENO PAGENO/O/

...

'DATE'

&

'TIME'

A R E CDC

P A G E N O -- P A G E N O ÷ TITLEI = TITLE P R I N T 8000, T I T L E I , PRINT 8100

Iillilililliil

SYSTEM

li llil

lilililililil

ROUTINES

I

DATE(),

TIME(),

PAGENO

R E T U R N

Cll'ilillli'll

8000 7 8100

FORMAT( ' FORMAT(

lllli'lli,llililllillliili,liii,lill*

lllllillilililll*il

////'o',gx, ASO,' DATE: ', A I O , ' P A G E ', I3 / IOX, 1 0 q ( ' = ' ) / ) IOX, 'LINE NO',' S A M P L E NO',' C A R D NOt

TIME:',

AIO,

)

END

SUBROUTINE

VALIDAT(

CltJtllJJJJJJJJ

JliJJJJJJJ

C

LINES

VALIDATE

OF

C

=========================

Clltl

IWWi iliJJiJJlJll

PARAMETER

INTEGER COMMON ICI/ CHARACTER*4 C O M M O N /C2/

ERROR JJJJ

)

JJ JJJJJJtJJiJJJ

JttlJtliitltlltltltl

INPUT

JJJJJJeliJJJJ

( MXCRDNO

CHARACTER*90 CHARACTER*72

PARAMETER

LINE, JJJJJJ

JlJJJJ

i J J J i l l i l t i l t l l i t t l l t l t i l l l l l l

= 6)

LINE (MXCRDNO) ERROR(MXCRDNO)

( MXCDCDS

=

99

)

N C O D E S , C R D C O D I ( M X C DC DS, 3) NCODES, CRDCODI C R D C O D 2 ( M X C DC DS ) CRDC OD2

C | l t l l l l i l i | i | | | | | | i l | l l | J i l J t l l l i l l | | i t J J | | i l i i l l i l | l i l t l | l l t t l l l l | t t

PARAMETER

( MXVARS

= 30,

MXCODES

= 20

)

Decoding sedimentological field data INTEGER CHARACTER*4

NOCODES( MXVARS VARS( M X V A R S ),

COMMON COMMON COMMON

NOVARS, VARS CODES

NOCODES

LINENO,

FROM,

/AI/ /A2/ /A3/

INTEGER LOGICAL

C

tt

...

it*

! i ti

BLANK

MXVARS,

MXCODES

)

TO

BLANK

CHARACTER*4 CHARACTER*4 Eli*

) CODES(

69

CODE VARNAME

i t i t i l l i l i l l t l l l l l

OUT

ERROR

i i l l l l i l i l l I

l | t l i t l t

l i t i l i l i l l i l l i l l l i i

INDICATORS

DO

100

100 I=I,MXCRDNO ERROR(I) = ' ' CONTINUE DO 200 N = I , N C O D E S VARNAME --CRDCOD2( N ) L I N E N O = C R D C O D I ( N , I) FROM = CRDCODI(N,2) TO -- C R D C O D I ( N , 3) I F ( V A R N A M E . E Q . ' # ' .OR. V A R N A M E . E Q . ' % ' . O R . V A R N A M E . E Q . ' .' ) T H E N FIELD MUST BE NUMERIC ( F O R P R E S E N T NOT T O W O R R Y ABOUT INTEGERS WITH DECIMAL POINT l!!!l!!!!II!I!!!!!!!!!

C C C

C

102 C

...

B L A N K = .TRUE. DO 102 I = F R O M , T O IF(LINE(LINENO)(I:I).EQ.' '.AND. B L A N K ) G O T O 102 B L A N K .- . F A L S E . IF(INDEX('0123456789. ',LINE(LINENO)(I:I)).EO.O) THEN INVALID -- REPLACE BY ZERO: ERROR CODEIS PREVIOUS CHAR ERROR(LINENO)(I:I) -- '0' ENDIF CONTINUE CHECK

VARIABLE

NAME

ONLY

ELSEIF(VARNAME.NE.'$'

IF

NO

'$'

) THEN

DO

120

1111

1112 1113

140 C C C C

120 IC=I, N O V A R S IF (VA R N A M E. EQ. VA RS (IC) ) CONTINUE

150

140

PRINTi,'PROGRAM E R R O R 111 IN ' ' V A L I D A T ' ' ' PRINT*, ' NOVARS, NOCODES, NCODES...', NOVARS, NOCODES, NCODES P R I N T 1111, V A R N A M E FORMAT( ' V A R N A M E = ', A ) DO 1112 I = I , M X V A R S P R I N T 1113, I, V A R S ( I ) CONTINUE FORMAT( 110, 5X, A ) S T O P 111 CONTINUE

PACK LEFT

C

GOTO

'CODE' & R E P L A C E JUSTIFIED !

INTO

LINE

I.E.

REMOVE

CODE : ' J : 0 DO 150 I = F R O M , T O IF(LINE(LINENO)(I:I).NE.' ') T H E N J = J+1 CODE(J:J) = LINE(LINENO)(I:I) ENDIF CONTINUE REPLACE BACK INTO LINE LINE(LINENO)(FROM:TO) = CODE

DO

160

160 J . - I , N O C O D E S ( I C ) IF( C O D E . E Q . C O D E S (IC, J)) CONTINUE ERROR(LINENO)(FROM:TO)

=

GOTO

'****'

200

BLANKS

&

MAKE

R. C-OLDBERYand K. WINIKOFF

70 ENDIF 200

CONTINUE R E T

U R

END

SUBROUTINE INC O D E S Clii*liJllJlJlJJJJJllliilt*iillJJililJli*ilttiJJil*l*J*Jitiil*Jittllt* C

C

READ

& VALIDATE

FILE

OF

CODE

POSITIONS

C ======================================== C CJilJJ*JJliJJlJliliJlJillJiJlJJitJJJlllJlJJJJJlJJiJiJiiJlittlttiililtj

PARAMETER PARAMETER PARAMETER

( MXCDCDS = 99 ) ( MXCRD'NO = 6) ( MXCOLNO = 72 )

INTEGER C HARACTER*4 COMMON /CI/ COMMON /C2/

NC ODES,

CRDCODI(MXC CRDCOD2(MXC CRDCODI CRDCOD2

NCODES,

INTEGER C HARACTER*4 C HA R A C T E R O 2 7

CARDNO, VARNAME COMMENT

C HARACTER*72

TEST(MXCRDNO)

FROM,

TO,

DC DS, 3) DC DS )

COL

ERROR

LOGICAL

LOGICAL LIST COMMON /PI/ LIST Ctl|l|JJJ|J|JJ||tJ|*ilJJJiJJJJJlii|iliJi|Jl|l|lJJ|JJlliiliiljjijjjjiij

C

... 111

222

OPEN( I, F I L E = ' C O D E S ' , S T A T U S = ' O L D ' , E R R = 1 1 1 , I O S T A T = I O S ) GOTO 222 ERROR ON OPEN CONTIN.UE P R I N T * , ' E R R O R ON O P E N ' ' C O D E S ' ' : IOS = ', 10S STOP CONTINUE NERRORS NC ODES

=

0

= 0

DO

qO C A R D N O = I , M X C R D N O DO 20 COL= I,MXCOLNO TEST(CARDNO)(COL:COL) CONTINUE CONTINUE

20 qO

=

' '

DO

60 N : I , M X C D C D S CRDCODI(N,I) = 0 CONTINUE

60

IF( 100

LIST

)

PRINT

8000

CONTINUE

ERROR = .FALSE. READ(I,T100,END=900) VALIDATION: -

I <= C A R D N O I <= F R O M <= NO P R E V I O U S IF A L L O B O V E ALLOCATED.

I. 2. 3. q.

NOTE: IF( IF(

IF

)

CARDNO,

<= M X C R D N O TO <= M X C O L N O E N T R Y F O R 'N' OK THEN CHECK

'TO'=ZERO

TO.EQ.O

N,

TO

(OR

BLANK)

FROM,

THAT

IT

TO,

GIVEN

IS M A D E

VARNAME,

COLUMNS

EQUAL

COMMENT

NOT

TO

YET

'FROM'

= FROM

C A R D N O . LT. I .OR. P R I N T * , ' C A R D OUT

CARDNO. GT.MXCRDNO ) THEN OF R A N G E - M A X I M U M VALUE

ALLOWED

=

',

Decoding scdimcntological field d a m I

MXCRDNO E R R O R : .TRUE. ENDIF IF( F R O M . G T . T O ) THEN PRINT*, ' ''FROM'' ERROR = .TRUE. ENDIF

COLUMN

>

''TO''

COLUMN

F R O M . L T . I .OR. F R O M . G T . M X C O L N O ) THEN PRINT*,' ' ' F R O M ' ' C O L O U T OF R A N G E - M A X I MXCOLNO E R R O R : .TRUE. ENDIF

'

IF(

IF(

TO. LT. I .OR. T O . G T . M X C O L N O PRINT*,' ''TO'' C O L O U T OF TO E R R O R = .TRUE. ENDIF IF(

N . L T . I .OR. N. G T . M X C D C D S PRINT*,' ENTRY NUMBER OUT I M XC DC DS ERROR : .TRUE. ELSEIF( CRDCODI(N,I).NE.O ) P R I N T * , ' ENTRY NUMBER N = ERROR = .TRUE. ENDIF

) THEN RANGE - MAX

) OF

THEN RANGE

THEN ' , N,'

VALUE

VALUE

- MAX

ALLOWED

ALLOWED

VALUE

:

:

',

ALLOWED

:

ALREADY DEFINED '

.NOT.ERROR ) THEN DO 1 2 0 COL:FROM,TO IF( T E S T ( C A R D N O ) ( C O L : C O L ) . N E . ' ' ) THEN PRINTm, I COLUMN ',COL,' ALREADY DEFINED ERROR : .TRUE. ENDIF CONTINUE ENDIF

IF(

120

'

ERROR . O R . LIST ) THEN PRINT 8100, N, CARDNO, FROM, TO, VARNAME, COMMENT ENDIF IF( E R R O R ) T H E N PRINT*,' t A W ERRORS IN ABOVE CARD CARD IGNORED . 1 .

IF(

,

-

NERRORS = NERRORS + I ELSE CRDCODI(N,I) = CARDNO CRDCODI(N,2) : FROM CRDCODI(N,3) : TO CRDCOD2(N) : VARNAME DO

140 COL=FROM,TO TEST(CARDNO)(COL:COL) .- vX' CONTINUE IF( N . G T . N C O D E S ) NCODES = N

140

ENDIF GOTO 900

100

CONTINUE DUMMY = EOF(1) PRINT* NERRORS.NE.O ) THEN P R I N T * , t T H E R E W E R E ,, ELSE P R I N T u, ' NO E R R O R S IN ENDIF IF(

NERRORSpt INPUT

ENTRIES

WITH

ERRORS

'

'

PRINT* DO

920 IF(

I

920

N=It.NCODES CRDCODI(N,I).EQ.O PRINT*,' WARNING

) - NO

ENTRY

CONTINUE CLOSE (I) RETURN

Ciiilil|**liilllliiltiilll|illlliliiitililitl|illllliiliilllililllllil

FOR

ENTRY

NUMBER

',

N

',

',

R. CrOLDBERY and K. WINIKOFF

72 7100 FORMAT( 8000 8100 C ill

413,

FORMAT(//IOX, FORMAT( 10X,

j jlj

j j i l l

j i jJ

lX,

Aq,

1X, A27

)

'NO CARD FROM 13, 315, 3X, Aq,

JJiJJ

JJ Jl'J

lJ

TO VARNAME 3X, A27 )

J J i l l ' ,

J J J J,

J " J Jl

COMMENT

Jl

J " t JlJ

J J''

' / )

" l t l l

''

'',l

END

SUBROUTINE I N D E S C S Cj

jjj

j j j JJJJ

J J,

J J JJJ

JJ

J J J J J J"

J"

JJ

J J J'J

MXCODES = 20

CHA RACTER14 COMMON /A2/

VANS( MXVARS ) VARS

CHARACTERm~ COMMON / A 3 /

CODES( MXVARS, MXCODES ) CODES

CHARAC TERm50 COMMON / A 4 /

DESCS( DESCS

CHARACTER" ~ C HARACTEN'Q50

VAR, C O D E DESC

MXVARS,

MXCODES

JJ

J"

JJ

J,',

JJ

JJ

J J J J J

)

)

LIST /P2/ LIST

J W,IIIQ~WRIIIIJOI,m~Q~e||~mNm|,JI~W

Ji~ImmgQIm

JJ JwQm~m

J,i~'mm

NOVARS : 0 DO 10 N : I , MXVARS NOCODES( N ) = 0 VANS ( N ) = ' ' CONTINUE

OPEN(

1,

FILE='DESCS',

222

GOTO 222 CONTINUE PRINTi, ' ERROR STOP CONTINUE

100

CONTINUE READ(

...

J"

NOVARS, NOCODES( MXVARS ) NOVARS, NOCODES

C Jg~IQ41

C

J,"

INTEGER COMMON /AI/

LOGICAL COMMON

111

JJJ',

( MXVARS = 30,

PARAMETER

10

J JJ

LOOK

I, FOR

7100,

STATUS='OLD', ERR=111,

IOSTAT=IOS)

ON O P E N

''DESCS'':

IOS

END=900

)

VAR,

'VAR t IN E X I S T I N G

CODE,

=

',

DESC

TABLES

IF(

120

140

NOVARS.NE.O ) THEN DO 120 N = I , NOVARS I F ( VAR. EQ. VARS(N) CONTINUE N = NOVARS + I ELSE N -- ] ENDIF

IOSTAT

)

GOTO 140

CONTINUE IF(

N.GT.MXVARS ) THEN PRINT i PRINT', o NO R O O M IN T A B L E S FOR A N O T H E R V A R I A B L E I! ' PRINT m, ' MAXIMUM NUMBER IN PROGRAM = ' , MXVARS PRINT", ' CHANGE ALL OCCURENCES OF PARAMETER ( M X V A R S = . . . ) ' , P R I N T m, ' AS R E Q U I R E D ' PRINT u, ' AND RERUN PROGRAM. t S T 0 P 333

ELSE NOVARS = N ENDIF J = NOCODES(N) + IF( J. G T . M X C O D E S

I )

THEN

Decoding sedimentological field data

73

PRINT* PRINT*, ' NO R O O M IN T A B L E S FOR A N O T H E R C O D E !! ' P R I N T * , ' M A X I M U M N U M B E R IN P R O G R A M = ', M X C O D E S PRINT*, ' CHANGE ALL OCCURENCES OF PARAMETER (MXCODES=...)' PRINT*, ' AS R E Q U I R E D ' PRINT*, ' AND RERUN PROGRAM. ' S T 0 P 444 ENDIF VARS NOCODES CODES( DESCS( GOTO 900

( N ) ( N ) N, J) N, J)

= = = =

VAR J CODE DESC

100

CONTINUE DUMMY = EOF(1) CLOSE(1) IF(

220 240

LIST ) THEN DO 2 4 0 N = I , N O V A R S PRINT 8000 DO 220 J = I , N O C O D E S ( N ) P R I N T 8100, V A R S ( N ) , CONTINUE CONTINUE

CODES(

N,

J 1,

DESCS(

N,

J

)

ENDIF R E T

U R

N

C i l i l l i l i * i l l i l l l i l i i l i l l i l l i i t l i l i i l l l i l i l i l l * i l l i l i t l l l i i l i l i i l l e l i l

7000 7100 8000 8100

FO%RMAT( A3 ) FORMAT( IX, A4, FORMAT(//) FORMAT( IOX, A,

IX,

A4,

2X,

A,

IX, 2X,

A

)

A)

C i l i l i t t l l | i t i l l i l l l l l l l l i i l i i i l i l i l i i l l l i l i l e l l l l t l i l l i l | i l i l l t l l l i l i

END

File SUB2 INTEGER

FUNCTION

DETERMINE

ACTUAL

ILEN(S)

LENGTH

CHARACTER*(*)

OF

A DS

(I.E.

GOTO

20

W/O

TRAILING

BLANKS)

S

DO

10 I = L E N ( S ) , I,-I IF( S ( I : I ) . N E . ' ' ) CONTINUE

10

I = 0 CONTINUE I L E N -- I

20

END

SUBROUTINE C ili

C C C

! il

lilt*

DISPLAY

Cm m*wi**m

PERCNT(

N

)

l t * * * l i l i l t l i i l i l t i i * * i t t i l

l l * l i l l i i

i i i l i t i l i i i l i i * * i i l l l l

N$

m u |Rmmm*mm**wmJmw*m

lJ*wmmIm

i*******wwommemiww*g**J**I**J*m***

C CHARACTER*

I0

S

C WRITE(S,' (I3,''~'')' C A L L DS( S )

)

N

C C*ti

itil*

! it*

END

lJ*ltlli

*Jwli

it**

It*

JJliili

J * l * t * i i J l l l i i l i *

JJliJt*il

ill*

,

R. GOLDBERY a n d K. WIN1KOFF

74 SUBROUTINE Ci til

NMREAL(

R,

FMT

)

l l l i l t l l l l l l l l l l l t l l l l l l l l l l t i l l l l i i l i li l l l l l t l i i l l l l l i i t l i l l

C C C

DISPLAY A REAL

NUMBER

IN

GIVEN

lill

FORMAT

C CHARACTER FMT*(m) WRITE(S,FMT) R C A L L DS( S )

, S'I0

C CJ J J J i J J

JJJJJJ

JJJJJJJJJJJJJJ

JJJJJJJJJJJJJ

J JJJJJJJJJlJJJJJJJJJJ

JJJJ

JJJJ

END

C C C

SUBROUTINE

NMINT(

DISPLAY

INTEGER

AN

N,

FMT

WITH

)

GIVEN

FORMAT

C l l l l l l l i l l l l t l l l l t l i l l i i l l l i l i l i l l l l l l l t l i l l l t l l l l l l l l i l l l i i l l i l lll i l

C

CHARACTER

FMTi(*) ~ S l l 0

C

W R I T E ( S , FMT) CALL

DS ( S

N

)

C

END

SUBROUTINE

1)5( S

)

C l l l J i l l l l l l l l l l l l l l i l i l l l i l i l l l l l l l l l l l l l l l l l i i l l l l i l i l i l i i l l l l l l l l l t C i l l l l l i l l l l t l l l i l l l i i l l l i t l i l l l i l l l i l l l l l i l l l i l l i l l i i l i l l l l l l i l l l i l l i

PARAMETER (LNLEN--?6 ) CHARACTERU(m) S C H A R A C TERm I00 LINE LOGICAL HEAD CHARACTERe 1 UNDLIN DATA II/0/, LINE/t '/ DATA U N D L I N / v - '/

I C

10

CONTINUE L E N -- I L E N ( S ) IGNORE IF I N P U T S T R I N G IF(LEN.EQ.O) RETURN LI - - 1

ALL

BLANK

CONTINUE CALL XWORD( S, L 1 , L 2 ) LN = L 2 - L 1 I 2 -- I 1 + LN IF( I2. GT.LNLEN.AND. LEN.GT.1 PRINT 8 0 0 0 , L I N E ( I : L N L E N ) II = 0 I 2 = LN L I N E ." ' ' ENDIF

)

THEN

11 = II + I LINE(II:I2) = S(LI:L2-1) 11 .- 1 2 + I LI = L 2 + I I F ( L I . LE. L E N ) GOTO 10 RETURN ENTRY HEADING HEAD = .TRUE. GOTO 100 C

I00

ENTRY NEWLN HEAD = .FALSE. CONTINUE PRINT 8000, LINE(I:ILEN(LINE)) IF(HEAD) PRINT 8100, (UNDLIN II = 0 L I N E -- ' ' RETURN

, I=I,ILEN(LINE)

)

C

::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

Decoding s~dimentoiogical field data C C

...THIS

ENTRY

SUPPRESSES

ENTRY DSI( S ) IF( I I . G T . O ) II GOTO I

THE

= II

SPACE

BEFORE

THE

75 FIRST

WORD

-I

C C =====================================================================

8000 8100

FORMAT(15X, A ) FORMAT( 15X, IOOAI

)

C C l l t l l t l i t | t l l l i l | | l l l | i i | l l l l l t | l l l l l l l l l l t | i i l l t | l l | l l t l l t i l t l l | l l | t

END

SUBROUTINE CI JJJJJJl

XWORD(

S,

LI,L2)

JlJJiJJJJJJJJJJJJJJJJlJJJJJJllJJJlllJJlJiJJlJJllJllJJllJJiJli

C

FINDS

C

FIRST

WORD

IN S T R I N G

S AND

RETURNS

LENGTH

C

CHARACTER*(*)

S

DO

10 L = L I , L E N ( S ) IF(S(L:L).NE.' CONTINUE L2= LEN(S) + 1 RETURN

10

20

') G O T O

CONTINUE LI = L DO 30 L = L I , L E N ( S ) IF(S(L:L).EQ.' CONTINUE L2= LEN(S) + I RETURN

30

50

')

GOTO

20

50

CONTINUE L2= L RETURN

END

program CONVERT PROGRAM

CONVERT(

INPUT,

C C

CONVERT

C

_-_-=.-.-.-.-.-.-----=.-=.-=--==.-====.-==.-=.-====================

C

C C C C C

C C C C

C C C C C C

THIS

DDL

PROGRAM

JJJJJJJJ

)

JJJJJJJ

C C C CD C

J J JJlJJJJJJ

OUTPUT

CIJIJJ

STATEMENTS

CONVERTS

J JJ JJ JJJJJJ

TO F O R T R A N

LINES

IN T H E

JJJJJJJJJ

SUBROUTINE

J JJ JJJJJJJJJJJJJJi

CALLS

FORM

$V I, V2, %V I, $ t S T R I N G ' , IF( A. GT. B) ' S T R I N G 2 ' ,-V 3; INTO

THE

APPROPRIATE

DS (STRING) DSI (STRING) PCNT (NUMBER) NHINT (NUMBER) NMREAL(NUMBER)

TO TO TO TO TO

SETS

OF

DISPLAY DISPLAY DISPLAY DISPLAY DISPLAY

CALLS

~ FOR # FOR . FOR NOTE

THAT WHAT FOLLOWS REFERS PRECEDES THE STRING, IT IS PERCENTAGES INTEGER NUMBERS REAL NUMBERS.

A

-

THAT

A

GROUP

OF

CI ~mlt WJ~WmmUWlW~Wm~UjmRj~QI

SUBROUTINES:-

STRING WITH LEADING BLANK S T R I N G W/O LEADING BLANK AN INTEGER AS PERCENTAGE AN I N T E G E R N U M B E R A REAL NUMBER

$ INDICATES [IF

TO T H E

CONTIGUOUS

'D'

ADDED ADDED

TO A S T R I N G (OR C H A R V A R I A B L E ) DISPLAYED U S I N D 'DSI ']

LINES

ARE

jiim~weRIIm~mlm~J|lwl

TREATED

AS

A

GROUP

jljlt~IIIm~jmN~

R. GOLDBERY and K. %VINIKOFF

76 IMPLICIT

COMPLEX(A-Z)

CHARACTER*72 COMMON /LINE/

LINE LINE

CHARACTER

LFMT*7,

FFMT*11,

TOKEN*50

INTEGER CHARACTER LOGICAL

ISW, M A R G I N , ILEN, RFMT*IO, IFMT*IO EOL

I

::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

MARGIN = ? WRITE(LFMT,'( ' ' ( ' ' , 12, ISW = I I F M T = ', ' ' ( I 2 ) ' ' ' F F M T -- ' , ' ' ( F I 0 . 2 ) ' ' ' 10

C

...

C

o.,

) MARGIN

C ONT IN UE E O L -- . F A L S E . R E A D ( * , ' (A)' , E N D = 9 0 0 ) L I N E IF(LINE(I:I).NE.'D t ) THEN NORMAL L I N E -- NO PROCESSING TO BE DONE WRITE(m,'(A) ' ) LINE G O T O I0 EN DIF WE

HAVE

FOUND

A

'DISP'

WRITE(*,'(/A/)')

C

)'

''X,A)''

'C'

IF A NEW G R O U P RESET DEFAULTS

LINE

!l!

//LINE

(I.E.

PREVIOUS

C C

C ONT IN UE CALL NEXT( TOKEN, EOL ) IF( E O L ) G O T O 10 ... A B O V E IF C H E C K S IF W E H A V E ... IF YES - W E GO B A C K T O R E A D

C

...

MORE

C

...

CHECK I F

CARD

N 0 T

'DISP'

CARD

20

I

FINISHED PROCESSING ANOTHER LINE.

CARD.

PROCESS

TO

ONE OF TYPES

$,

%,

.,

#

OR /

= INDEX('$%.#',TOKEN(I:I))

IF(I. NE. O) T H E N ISW S E T TO IN C O M P U T E D ISW = I GOTO 2 0

I FOR GOTO

$,

2 FOT

ELSEIF(TOKEN(I:3).EQ.'IF(' HAVE

FOUND

START

OF AN

$ 3 FOR

. 4 FOR

#

LATER

) THEN IF:

WRITE

IF( .. . ) T H E N

&

INDENT

IF(INDEX(TOKEN,' .' ) . E Q . O ) T H E N WRITE(m,LFMT) TOKEN(I:ILEN(TOKEN)-I)//' .NE.'' '') ELSE WRITE(m,LFMT) TOKEN(I:ILEN(TOKEN))//' THEN' ENDIF MARGIN = MARGIN+3 WRITE(LFMT,'( ' ' ( ' ' , I2, ' ' X , A ) ' ' )' ) M A R G I N ELSEIF(TOKEN.EQ.';' END

OF

IF:

WRITE

) THEN ENDIF

&

MARGIN = MARGIN-3 W R I T E ( L F M T , ' ( ' ' ( ' ' , 12, W R I T E ( * , L F M T ) 'ENDIF '

OUTDENT

''X,A)''

E L S E I F ( T O K E N . EQ.' {' ) T H E N WRITE(*,LFMT) 'CALL DSI('' .'')' WRITE(*,LFMT) 'CALL NEWLN' ELSEIF(TOKEN. EQ.'/' ) THEN WRITE(*,LFMT) 'CALL NEWLN' ELSEIF(TOKEN.EQ.' \' ) T H E N WRITE(*,LFMT) 'CALL HEADING' E LSE

USED

)'

) MARGIN

THEN'

Decoding sedimentologica! field TOKEN

TREATED

IN A C C O R D A N C E

WITH

77

data

PREVIOUS

SET

'ISW'

GOTO (110, 12 0, 13 O, 140 ) ISW S T R I N G

C 110

(ISW=I:

'$')

CONTINUE IF(TOKEN(I: I).EQ.'-') THEN WRITE(I,LFMT) 'CALL DSI('

// TOKEN(2:ILEN(TOKEN))// ' )'

ELSE WRITE(m,LFMT) ' C A L L DS(' // TOKEN(I:ILEN(TOKEN))// ENDIF G O T O I 90 P E R C E N T A G E

C

(ISW=2:

' )'

'%')

CONTINUE WRITE(t,LFMT) 'CALL PERCNT(' // TOKEN(I:ILEN(TOKEN))// G O T O 190

120

R E A

C

L

N

U M

' )'

(ISW=3:

B E R

'.' )

CONTINUE WRITE(*,LFMT) 'CALL NMREAL(' // TOKEN(I:ILEN(TOKEN))//FFMT G O T O 190

130

I

C 140

N T E G E R

N U M B E R

//

(ISW=4:

CONTINUE WRITE(i,LFMT) 'CALL NMINT(' // TOKEN(I:ILEN(TOKEN))// IFMT G O T O 190

1 90

' )'

'#')

//

')'

CONTINUE ENDIF ISW -- I G O T O 20

900 C* II

CONTINUE Iilli

l i l l l i l l l l l l l l l l l l l l i l i * l l l l l l t l l l l

illil

i l l i l l l t l i l l l i t l i

END o

SUBROUTINE

NEXT (TOKEN, EOL)

C C

EXTRACT

C

==========================================================

NEXT

'TOKEN'

OR

RETURN

EOL

= TRUE

FOR

END OF L I N E

C CUmiui**uwmwln,mtmwwlilm~o,mwI*tmi*mmmnmi*wlw~wwtmwwmmmwJi*i,im*utmwmm IMPLIC IT C01'IPLEX(A-Z) CHARACTER~50 LOGICAL

TOKEN EOL

C HARAC TERi72 COMMON /LINE/

L L

INTEGER DATA

I,

II,

IS,

IE,

LEVEL,

J,

IT,

IN

IE/I/

C =====================================================================

C ...

L O O K FOR

NEXT

NON-BLANK

(IF A N Y )

IS DO

10 C

...

= IE+I I0 I--IS, 72 IF( L ( I : I ) . N E . ' CONTINUE

CHARACTER

IF W E IE

CAGEO 12:I-F

= I

GET

HERE WE

'.AND. L ( I : I ) . N E . ' ,') G O T O

HAVE

FINISHED

SCANNING

LINE

20

!

Jill

R. GOLDBERYand K. VVINIKOFF

78 EOL R E

C

... 20

= T

.TRUE. U R N

EXTRACT NEXT CONTINUE TOKEN = ' ' IT = 0

C

...WE

C

...

HERE

TOKEN

NEED

DO W E

TO

HAVE

DETERMINE

A SPECIAL

ONE

IN = I N D E X ( ' $ ~ . # ; / \ I ' , IF(IN. NE.O) THEN TOKEN = L(I:I) IE = I R E T U R N ENDIF C

...

DO W E

HAVE

START

OF

WHICH

TYPE

CHARACTER

OF

TOKEN

TOKEN

?

WE

HAVE

L(I=I))

AN

IF(L(I:I+2).EQ.'IF(' LEVEL = 0 TOKEN = 'IF(' J = 3 DO 30 I I = I + 3 , 7 2

'IF( .... )'

) THEN

d = d÷l TOKEN(J'J)

= L(II'II) IF(L(II'II).EQ.' )'.AND. LEVEL. EO.O) THEN IE = II R E T U R N EN DIF • IF(L(II:II).EQ.')') LEVEL = LEVEL-I IF(L(II'II).EO.'(' ) LEVEL = LEVEL + I CONTINUE

30 C

...

IF W E GOTO

GET

HERE

WE'RE

IN

TROUBLE

80

C ENDIF C

...

EXTRACT

STRING

I F ( L ( I : I ) . E Q . ' ' ' ' .OR. L(I: I+I ).EQ. '-' ' ' ) T H E N LEVEL

=

+I

TOKEN = w t J = I IF(L(I:I),EQ.tTOKEN(J:J) I = I +I J = EN DIF

J

I) T H E N = L(I:I)

+1

TOKEN(J:J) = L(I:I) DO 4 0 I I = I + I , 7 2 J

40

=

J+l

TOKEN(J:J) = L(II:II) IF(L(II: II).EQ.''''.AND. L(II+I:II+I).NE.'''' I .AND. LEVEL. GT.O) THEN IE = II R E T URN EN DIF IF(L(II:II).EQ.'''') LEVEL =-LEVEL CONTINUE GOTO 8O EN DIF

C ... E X T R A C T C### NOTE: WE

VARIABLE UP T O D E L I M I T E R DO NOT Y E T H A N D L E C H A N G I N G

J = O TOKEN = ' ' DO 50 I I = I , 7 2 IF(INDEX('$%.# IE = I I - 1 R E T U R ENDIF J

50

=

R

E

T

, ;I',L(II:II)).NE.O) N

J+l

TOKEN(J: CONTINUE U R

J)

N

FORMAT

= L(II:II)

FOR

THEN

REALS

&

INTEGERS

Decoding sedimentoiogical field data 80

CONTINUE E O L -- . T R U E . PRINT*,' ERROR" PRINT*,' Ig = R E T U R N

TOKEN LINE

= ', = ',

?9

TOKEN L

C

Clll*lllli**i*ll*l*lllili*tliilllllllllllil}illllliillll

lllillllllilli*

END

INTEGER

FUNCTION

ILEN(S)

CIJIJIIIJIIJJJJIIJIJIIIJJJJJIJIJJJJJJJIJJIJJJIJJIJJJJIJIJIJIIJJIJJJJJJ c C

DETERMINE

ACTUAL

LENGTH

STRING

S

(I.E.

W/O

TRAILING

BLANKS)

c

ClilitillllltliillllllIilill}llililliliililliiltiilillitlilililIillill C HA RAC T E R I ( e )

10

20

S

DO 10 I = L E N ( S ) , I , - 1 IF( S(I:I).NE.' C 0 NT IN UE

'

)

GOTO

20

I • 0 CONTINUE I L E N .- I

CJ|JJJJJJJJJJJJJJJJJJJJJJJJJJJJ||JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ END