PROGRAM OCLDEMO c This program prints out the first ten profiles of an c OCL ASCII file to the screen. This main program (OCLdemo) c calls the subroutine OCLread. OCLread does the actual c reading of the ASCII format, and loads it into arrays which c are passed back to OCLdemo. OCLread then works (only) with c these arrays to print out the profile data on the screen. c It is intended that OCLread provide an example of how c to extract the data and variables from the ASCII format, c whereas OCLdemo provides an example of how these data can c be made accessible/workable as a series of arrays. c*********************************************************** c Missing values used in this dataset c c time: 99.99 c latitute: -99.9 c longitude: -999. c depth: -99.99 (bmiss) c data: -99.99 (bmiss) c*********************************************************** c c Parameters (constants): c c maxlevel - maximum number of depth levels, also maximum c number of all types of variables c maxcalc - maximum number of measured and calculated c depth dependent variables c kdim - number of standard depth levels c bmiss - binary missing value marker c maxtcode - maximum number of different taxa variable codes c maxtax - maximum number of taxa sets c c****************************************************************** parameter (maxlevel=10000, maxcalc=100) parameter (kdim=40, bmiss=-99.99) parameter (maxtcode=25, maxtax=2000) c****************************************************************** c c Character Arrays: c c cc - NODC country code c chars - OCL character data: 1. originators cruise code, c 2. originators station cod c filename - file name c c***************************************************************** character*2 cc character*15 chars(2) character*80 filename c****************************************************************** c c Arrays: c c isig() - number of significant figures in (1) latitude, (2) longitude c and (3) time c iprec() - precision of (1) latitude, (2) longitude, (3) time c ip2() - variable codes for variables in profile c ierror() - whole profile error codes for each variable c c ipi() - primary investigators information c 1. primary investigators c 2. for which variable c c jsig2() - number of significant figures in each secondary header variable c jprec2() - precision of each secondary header variable c sechead() - secondary header variables c c jsigb() - number of significant figures in each biological variable c jprecb() - precision of each biological variable c bio() - biological data c c depth() - depth of each measurement c c jtot2() - number of bytes in each secondary header variable c jtotb() - number of bytes in each biological variable c c msig() - number of significant figures in each measured variable at c each level of measurement c mprec() - precision of each measured variable at each c level of measurement c c mtot() - number of digits in each measured variable at c each level of measurement c c temp() - variable data at each level c iderror() - error flags for each variable at each depth level c c isec() - variable codes for secondary header data c ibio() - variable codes for biological data c c itaxnum() - different taxonomic and biomass variable c codes found in data c vtax() - value of taxonomic variables and biomass variables c c jsigtax() - number of significant figures in taxon values and c biomass variables c jprectax()- precision of taxon values and biomass variables c c jtottax() - number of bytes in taxon values c itaxerr() - error codes for taxon data c c nbothtot()- total number of taxa variables c stdz(40) - standard depth levels c c******************************************************************* dimension isig(3), iprec(3), ip2(0:maxlevel), ierror(maxlevel) dimension ipi(maxlevel,2) dimension jsig2(maxlevel), jprec2(maxlevel), sechead(maxlevel) dimension jsigb(maxlevel), jprecb(maxlevel), bio(maxlevel) dimension depth(maxlevel) dimension jtot2(maxlevel),jtotb(maxlevel) dimension msig(maxlevel,maxcalc), mprec(maxlevel,maxcalc) dimension mtot(maxlevel,maxcalc) dimension temp(maxlevel,maxcalc),iderror(maxlevel,0:maxcalc) dimension isec(maxlevel),ibio(maxlevel) dimension itaxnum(maxtcode,maxtax),vtax(0:maxtcode,maxtax) dimension jsigtax(maxtcode,maxtax),jprectax(maxtcode,maxtax) dimension jtottax(maxtcode,maxtax),itaxerr(maxtcode,maxtax) dimension stdz(kdim) common /thedata/ depth,temp common /flags/ ierror,iderror common /significant/ msig common /precision/ mprec common /totfigs/ mtot common /second/ jsig2,jprec2,jtot2,isec,sechead common /biology/ jsigb,jprecb,jtotb,ibio,bio common /taxon/ jsigtax,jprectax,jtottax,itaxerr, * vtax,itaxnum,nbothtot data stdz/ 0., 10., 20., 30., 50., 75., 100., 125., 150., * 200., 250., 300., 400., 500., 600., 700., 800., 900., * 1000., 1100., 1200., 1300., 1400., 1500., 1750., 2000., * 2500., 3000., 3500., 4000., 4500., 5000., 5500., 6000., * 6500., 7000., 7500., 8000., 8500., 9000./ c************************************************************** c c nf is the input file indentification number c c************************************************************** data nf/11/ c************************************************************** c c Get user input file name from which profiles will be c taken. Open this file. c c************************************************************** write(6,*)' ' write(6,*)'Input File Name (in quotes)' read(5,*) filename write(6,*)' ' write(6,*)' ' open(nf,file=filename,status='old') c************************************************************** c c SUBROUTINE "OCLread": READS IN A SINGLE PROFILE FROM THE ASCII c FILE AND STORES THE DATA INTO ARRAYS (PASSED c OR SHARED BETWEEN OCLread AND OCLdemo). c ------------------------------------------------------------------- c c Passed Variables: c c nf - file identification number for input file c jj - OCL profile number c cc - NODC country code c icruise - NODC cruise number c iyear - year of profile c month - month of profile c iday - day of profile c time - time of profile c rlat - latitude of profile c rlon - longitude of profile c levels - number of depth levels of data c istdlev - observed (0) or standard (1) levels c nvar - number of variables recorded in profile c ip2(i) - variable codes of variables in profile c nsecond - number of secondary header variables c nbio - number of biological variables c isig() - number of significant figures in (1) latitude, (2) longitude c and (3) time c iprec() - precision of (1) latitude, (2) longitude, (3) time c bmiss - missing value marker c ieof - set to one if end of file has been encountered c c Common/Shared Variables and Arrays (see COMMON area of program): c c depth(x) - depth in meters (x = depth level) c temp(x,y) - variable data (x = depth level, y = variable ID = ip2(i)) c ... see also nvar, ip2, istdlev, levels above ... c sechead(i) - secondary header data (i = secondary header ID = isec(j)) c isec(j) - secondary header ID (j = #sequence in profile (1st, 2nd, 3rd)) c ... see also nsecond above ... c bio(i) - biology header data (i = biol-header ID = ibio(j)) c ibio(j) - biology header ID (j = #sequence in profile (1st, 2nd, 3rd)) c ... see also nbio above ... c nbothtot - number of taxa set / biomass variables c vtax(i,j) - taxonomic/biomass array, where j = (1..nbothtot) c For each entry (j=1..nbothtot), there are vtax(0,j) c sub-entries. [Note: The number of sub-entries is c variable for each main entry.] vtax also holds the c value of the sub-entries. c itaxnum(i,j)- taxonomic code or sub-code c chars - OCL character data: 1. originators cruise code, c 2. originators station cod c npi - number of PI codes c ipi - Primary Investigator information c 1. primary investigator c 2. variable investigated c c*************************************************************** do 50 ij=1,10 !- MAIN LOOP chars(1)= ' ' chars(2)= ' ' call OCLread(nf,jj,cc,icruise,iyear,month,iday, * time,rlat,rlon,levels,istdlev,nvar,ip2,nsecond,nbio, * isig,iprec,bmiss,ieof,chars,ipi,npi) if ( ieof.gt.0 ) goto 4 !- Exit c*************************************************************** c c STANDARD LEVELS OR OBSERVED LEVELS c ---------------------------------- c c If this file is on standard levels (istdlev=1), place the standard c depths in the depth array (otherwise, observed depth values c were read in and stored above by OCLread). c c*************************************************************** if (istdlev .eq. 1 .and. ij .eq. 1) then do 60 i=1,kdim depth(i)=stdz(i) 60 continue endif c************************************************************** c c WRITE HEADER INFORMATION TO THE SCREEN c -------------------------------------- c c cc - country code (a2) c icruise - OCL internal cruise identifier (i8) c rlat - latitude (f7.3) c rlon - longitude (f7.8) c iyear - year (i4) c month - month (i2) c iday - day (i2) c time - time (GMT) (f5.2) c jj - OCL internal profile identifier (i8) c levels - number of depth levels measured (i4) c c************************************************************** 800 format(1x,a2,i8,1x,f7.3,1x,f8.3,1x,i4,1x,i2,1x,i2, * 1x,f5.2,1x,i8,1x,i4) write(6,*) *'----------------------------------------------------------' write(6,*) 'Output from ASCII file, profile# ',ij write(6,*) *'----------------------------------------------------------' write(6,*)' ' write(6,*) *'CC cruise Latitde Longitde YYYY MM DD Time Station #' write(6,800) cc,icruise,rlat,rlon,iyear,month,iday, * time,jj,levels write(6,*) ' ' c************************************************************** c c WRITE CHARACTER DATA TO THE SCREEN c ---------------------------------- c c chars(1) - Originators cruise identifier c chars(2) - Originators station identifier c c************************************************************** if ( ( chars(1)(1:1) .ne. ' ' ) .and. * ( chars(1)(1:4) .ne. 'NONE' )) then write(6,*) 'Originators Cruise Code: ',chars(1) endif if ( ( chars(2)(1:1) .ne. ' ' ) .and. * ( chars(2)(1:4) .ne. 'NONE' )) then write(6,*) 'Originators Station Code: ',chars(2) endif write(6,*) ' ' c*************************************************************** c c WRITE PRIMARY INVESTIGATOR INFORMATION TO THE SCREEN c ---------------------------------------------------- c c npi = number of primary investigator entries c ipi(1..npi,1) - PI code c ipi(1..npi,2) - variable for which PI was responsible c c*************************************************************** do 505 n=1,npi write(6,'(1x,a21,i5,1x,a20,i3)') * 'Primary Investigator:',ipi(n,1), * ' ... for variable #:',ipi(n,2) 505 continue if ( npi .gt. 0 ) write(6,*) ' ' c************************************************************** c c WRITE VARIABLE-CODE (column headings) TO THE SCREEN c ---------------------------------------------------- c c nvar - number of variables (1...nvar) c ip2(1..nvar) - variable code for each variable present c c Example: c For a profile with just Temperature[1], Oxygen[3], Pressure[25]: c c The variable sequence is ip2(1)=Temperature, ip2(2)=Oxygen, c ip2(3)=Pressure c c nvar = 3 c c ip2(1) = 1, ip2(2) = 3, ip3(3) = 25 c c c Note: If "nvar = 0", biology only station. c c************************************************************** c format(5x,1a,5x,10(3x,i2,11x)) 801 format(5x,a4,3x,10(i2,8x,a1,3x)) if (nvar .gt. 0) then write(6,801) "z f",((ip2(n),'f'),n=1,nvar) write(6,*)' ' c************************************************************** c c WRITE DEPTH-DEPENDENT VARIABLE DATA TO THE SCREEN c -------------------------------------------------- c c Print depth (depth(n)), error flags for depth (iderror(n,0)), c each variable (temp(n,1..nvar)), and error flags for each c variables (iderror(n,1..nvar)) c c************************************************************** 802 format(1x,f6.1,1x,i1,14(f8.3,' (',i1,') ',i1)) do 80 n=1,levels write(6,802) depth(n),iderror(n,0), * (temp(n,ip2(j)),msig(n,ip2(j)), * iderror(n,ip2(j)),j=1,nvar) 80 continue write(6,*) ' ' c*************************************************************** c c PRINT ENTIRE-PROFILE ERROR FLAGS c ------------------------------------ c c*************************************************************** 8021 format('ERR: ',11(i1,13x)) write(6,8021)(ierror(j),j=0,nvar) write(6,*) ' ' endif !- "if (nvar .gt. 0) then" c************************************************************* c c WRITE SECONDARY-HEADER INFORMATION TO THE SCREEN c --------------------------------------------- c c Print the secondary header code (isec(1..nsecond)) and the value c for that secondary header (sechead(isec(n))). c c************************************************************* 803 format(1x,'Secondary header #',i3,3x,f8.3,' (',i1,')') 903 format(1x,'Secondary header #',i3,3x,f8.0,' (',i1,')') do 85 n = 1,nsecond if ( int(sechead(isec(n))) .lt. sechead(isec(n))) then write(6,803) isec(n), sechead(isec(n)),jsig2(isec(n)) else write(6,903) isec(n), sechead(isec(n)),jsig2(isec(n)) endif 85 continue write(6,*) ' ' c************************************************************* c c WRITE BIOLOGICAL INFORMATION TO THE SCREEN c ------------------------------------------ c c Print the biology header code (ibio(1..nbio)) and the value c for that biology header (bio(ibio(n))). c c************************************************************* 804 format(1x,'Biological header #',i3,3x,f8.3,' (',i1,')') do 90 n = 1,nbio write(6,804) ibio(n), bio(ibio(n)),jsigb(ibio(n)) bio(ibio(n))=bmiss jsigb(ibio(n))=0 ibio(n)=0 90 continue nbio=0 write(6,*) ' ' c************************************************************* c c WRITE TAXA SET/BIOMASS VARIABLE INFORMATION TO THE SCREEN c ---------------------------------------------------------- c c For each set/variable (1..nbothtot), print the set/variable code c (ivtax = vtax(1,n)) and each member of that set (1..vtax(0,n)), c where the sub-code is itaxnum(n2,n) and the sub-value is vtax(n2,n). c c************************************************************* 805 format(5x,' Code #',i4,3x,f13.3,' (',i1,')') do 91 n = 1,nbothtot intax = vtax(0,n) ivtax = vtax(1,n) if ( ivtax .lt. 0. .and. ivtax .gt. -501.) then write(6,'(a8,i3,1x,a25,i12," (",i1,")")') 'Taxa-set',n, * ': Biomass Parameter [1]#',ivtax,jsigtax(1,n) else write(6,'(a8,i3,1x,a22,4x,i10," (",i1,")")') 'Taxa-set',n, * ': Taxonomic Code [1]#',ivtax,jsigtax(1,n) endif vtax(0,n)=0. vtax(1,n)=0. do 92 n2 = 2,intax write(6,805) itaxnum(n2,n), vtax(n2,n), jsigtax(n2,n) vtax(n2,n)=bmiss jsigtax(n2,n)=0 itaxnum(n2,n)=0 92 continue write(6,*)' ' 91 continue nbothtot=0 write(6,*) ' ' 50 continue !- End of MAIN LOOP 4 continue !- EXIT stop end c----------------------------------------------------------- c----------------------------------------------------------- c----------------------------------------------------------- SUBROUTINE OCLREAD(nf,jj,cc,icruise,iyear,month,iday, * time,rlat,rlon,levels,isoor,nvar,ip2,nsecond,nbio, * isig,iprec,bmiss,ieof,chars,ipi,npi) c This subroutine reads in the OCL ASCII format and loads it c into arrays which are common/shared with the calling program. c***************************************************************** c c Passed Variables: c c nf - file identification number for input file c jj - OCL profile number c cc - NODC country code c icruise - NODC cruise number c iyear - year of profile c month - month of profile c iday - day of profile c time - time of profile c rlat - latitude of profile c rlon - longitude of profile c levels - number of depth levels of data c isoor - observed (0) or standard (1) levels c nvar - number of variables recorded in profile c ip2 - variable codes of variables in profile c nsecond - number of secondary header variables c nbio - number of biological variables c isig - number of significant figures in (1) latitude, (2) longitude, c and (3) time c iprec - precision of (1) latitude, (2) longitude, (3) time c itotfig - number of digits in (1) latitude, (2) longitude, (3) time c bmiss - missing value marker c ieof - set to one if end of file has been encountered c chars - character data: 1=originators cruise code, c 2=originators station code c npi - number of PI codes c ipi - Primary Investigator information c 1. primary investigator c 2. variable investigated c c Common/Shared Variables and Arrays (see COMMON area of program): c c depth(x) - depth in meters (x = depth level) c temp(x,y) - variable data (x = depth level, y = variable ID = ip2(i)) c ... see also nvar, ip2, istdlev, levels above ... c sechead(i) - secondary header data (i = secondary header ID = isec(j)) c isec(j) - secondary header ID (j = #sequence in profile (1st, 2nd, 3rd)) c ... see also nsecondary above ... c bio(i) - biology header data (i = biol-header ID = ibio(j)) c ibio(j) - biology header ID (j = #sequence in profile (1st, 2nd, 3rd)) c ... see also nbio above ... c nbothtot - number of taxa set / biomass variables c vtax(i,j) - taxonomic/biomass array, where j = (1..nbothtot) c For each entry (j=1..nbothtot), there are vtax(0,j) c sub-entries. [Note: The number of sub-entries is c variable for each main entry.] vtax also holds the c value of the sub-entries. c itaxnum(i,j)- taxonomic code or sub-code c c*************************************************************** c****************************************************************** c c Parameters (constants): c c maxlevel - maximum number of depth levels, also maximum c number of all types of variables c maxcalc - maximum number of measured and calculated c depth dependent variables c maxtcode - maximum number of different taxa variable codes c maxtax - maximum number of taxa sets c c****************************************************************** parameter maxlevel=10000, maxcalc=100 c parameter maxlevel=6000, maxcalc=200 parameter maxtcode=25, maxtax=2000 c****************************************************************** c c Character Variables: c c cc - NODC country code c xchar - dummy character array for reading in each 80 c character record c aout - format specifier (used for FORTRAN I/O) c ichar - profile character array c c****************************************************************** character*2 cc character*4 aout character*15 chars(2) character*80 xchar character*300000 ichar data aout /'(iX)'/ c****************************************************************** c c Arrays: c c isig - number of significant figures in (1) latitude, (2) longitude, c and (3) time c iprec - precision of (1) latitude, (2) longitude, (3) time c itotfig - number of digits in (1) latitude, (2) longitude, (3) time c ip2 - variable codes for variables in profile c ierror - whole profile error codes for each variable c jsig2 - number of significant figures in each secondary header variable c jprec2 - precision of each secondary header variable c jtot2 - number of digits in each secondary header variable c sechead - secondary header variables c jsigb - number of significant figures in each biological variable c jprecb - precision of each biological variable c jtotb - number of digits in each biological variable c bio - biological data c idsig - number of significant figures in each depth measurement c idprec - precision of each depth measurement c idtot - number of digits in each depth measurement c depth - depth of each measurement c msig - number of significant figures in each measured variable at c each level of measurement c mprec - precision of each measured variable at each c level of measurement c mtot - number of digits in each measured variable at c each level of measurement c temp - variable data at each level c iderror - error flags for each variable at each depth level c isec - variable codes for secondary header data c ibio - variable codes for biological data c itaxnum - different taxonomic and biomass variable c codes found in data c vtax - value of taxonomic variables and biomass variables c jsigtax - number of significant figures in taxon values and c biomass variables c jprectax - precision of taxon values and biomass variables c jtottax - number of digits in taxon values and biomass c variables c itaxerr - taxon variable error code c nbothtot - total number of taxa and biomass variables c ipi - Primary investigator informationc c 1. primary investigator c 2. variable investigated c c******************************************************************* dimension isig(3), iprec(3), ip2(0:maxlevel), ierror(maxlevel) dimension itotfig(3),ipi(maxlevel,2) dimension jsig2(maxlevel), jprec2(maxlevel), sechead(maxlevel) dimension jsigb(maxlevel), jprecb(maxlevel), bio(maxlevel) dimension idsig(maxlevel),idprec(maxlevel), depth(maxlevel) dimension jtot2(maxlevel),jtotb(maxlevel),idtot(maxlevel) dimension msig(maxlevel,maxcalc), mprec(maxlevel,maxcalc) dimension mtot(maxlevel,maxcalc) dimension temp(maxlevel,maxcalc),iderror(maxlevel,0:maxcalc) dimension isec(maxlevel),ibio(maxlevel) dimension itaxnum(maxtcode,maxtax),vtax(0:maxtcode,maxtax) dimension jsigtax(maxtcode,maxtax),jprectax(maxtcode,maxtax) dimension jtottax(maxtcode,maxtax),itaxerr(maxtcode,maxtax) c******************************************************************* c c Common Arrays and Variables: c c******************************************************************* common /thedata/ depth,temp common /flags/ ierror,iderror common /significant/ msig common /precision/ mprec common /totfigs/ mtot common /second/ jsig2,jprec2,jtot2,isec,sechead common /biology/ jsigb,jprecb,jtotb,ibio,bio common /taxon/ jsigtax,jprectax,jtottax,itaxerr, * vtax,itaxnum,nbothtot c****************************************************************** c c Read in the first line of a profile into dummy character c variable xchar c c****************************************************************** read(nf,'(a80)',end=500) xchar c****************************************************************** c c The first seven characters of a profile contain the c number of characters which make up the entire profile. Read c this number into nchar c c****************************************************************** read(xchar(1:1),'(i1)') inc write(aout(3:3),'(i1)') inc read(xchar(2:inc+1),aout) nchar c****************************************************************** c c Place the first line of the profile into the profile holder c character array (ichar) c c****************************************************************** ichar(1:80) = xchar c****************************************************************** c c Calculate the number of full (all 80 characters contain information) c lines in this profile. Subtract one since the first line was c already read in. c c****************************************************************** nlines = nchar/80 c***************************************************************** c c Read each line into the dummy variable c c***************************************************************** do 49 n0 = 2,nlines read(nf,'(a80)') xchar c***************************************************************** c c Place the line into the whole profile array c c***************************************************************** n = 80*(n0-1)+1 ichar(n:n+79)=xchar 49 continue c***************************************************************** c c If there is a last line with partial information, read in c this last line and place it into the whole profile array c c***************************************************************** if ( nlines*80 .lt. nchar .and. nlines .gt. 0) then read(nf,'(a80)') xchar n = 80*nlines+1 ichar(n:nchar) = xchar endif c***************************************************************** c c Extract header information from the profile array c c jj - OCL profile number c cc - NODC country code c icruise - NODC cruise number c iyear - year of profile c month - month of profile c iday - day of profile c c***************************************************************** istartc=inc+2 read(ichar(istartc:istartc),'(i1)') inc write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) jj istartc=istartc+inc+1 cc = ichar(istartc:istartc+1) istartc=istartc+2 read(ichar(istartc:istartc),'(i1)') inc write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) icruise istartc=istartc+inc+1 read(ichar(istartc:istartc+3),'(i4)') iyear istartc=istartc+4 read(ichar(istartc:istartc+1),'(i2)') month istartc=istartc+2 read(ichar(istartc:istartc+1),'(i2)') iday istartc=istartc+2 c***************************************************************** c c SUBROUTINE "charout": READS IN AN OCL ASCII FLOATING-POINT c VALUE SEQUENCE (i.e. # sig-figs, c # total figs, precision, value itself). c * THIS WILL BE CALLED TO EXTRACT MOST c Examples: FLOATING POINT VALUES IN THE OCL ASCII. c c VALUE Precision OCL ASCII c ----- --------- --------- c 5.35 2 332535 c 5. 0 1105 c 15.357 3 55315357 c (missing) - c c --------------------------------------------------------------- c c Read in time of profile (time) using CHAROUT subroutine: c c istartc - position in character array to begin to read c in data c isig - number of digits in data value c iprec - precision of data value c ichar - character array from which to read data c time - data value c 99.99 - missing value marker c c***************************************************************** call charout(istartc,isig(3),iprec(3),itotfig(3),ichar,time,99.99) c***************************************************************** c c Read in latitude (rlat) and longitude (rlon) using CHAROUT: c c Negative latitude is south. c Negative longitude is west. c c***************************************************************** call charout(istartc,isig(1),iprec(1),itotfig(3),ichar,rlat,-99.9) call charout(istartc,isig(2),iprec(2),itotfig(3),ichar,rlon,-999.) c***************************************************************** c c Read in the number of depth levels (levels) using CHAROUT: c c***************************************************************** read(ichar(istartc:istartc),'(i1)') inc write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) levels istartc=istartc+inc+1 c***************************************************************** c c Read in whether data is on observed levels (isoor=0) or c standard levels (isoor=1) c c***************************************************************** read(ichar(istartc:istartc),'(i1)') isoor istartc=istartc+1 c***************************************************************** c c Read in number of variables in profile c c***************************************************************** read(ichar(istartc:istartc+1),'(i2)') nvar istartc=istartc+2 c***************************************************************** c c Read in the variable codes (ip2()) and the whole profile c error flags (ierror(ip2())) c c***************************************************************** do 30 n = 1,nvar read(ichar(istartc:istartc),'(i1)') inc write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) ip2(n) istartc=istartc+inc+1 read(ichar(istartc:istartc),'(i1)') ierror(ip2(n)) istartc=istartc+1 30 continue c**************************************************************** c c Read in number of bytes in character data c c**************************************************************** read(ichar(istartc:istartc),'(i1)') inc istartc=istartc+1 if ( inc .gt. 0 ) then write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) inchad istartc=istartc+inc c**************************************************************** c c Read in number of character and primary investigator arrays c c**************************************************************** npi=0 chars(1)(1:4)='NONE' chars(2)(1:4)='NONE' read(ichar(istartc:istartc),'(i1)') ica istartc=istartc+1 c**************************************************************** c c Read in character and primary investigator data c 1 - originators cruise code c 2 - originators station code c 3 - primary investigators information c c**************************************************************** do 45 nn=1,ica read(ichar(istartc:istartc),'(i1)') icn istartc=istartc+1 if ( icn .lt. 3 ) then read(ichar(istartc:istartc+1),'(i2)') ns istartc=istartc+2 chars(icn)= ' ' chars(icn)= ichar(istartc:istartc+ns-1) istartc= istartc+ns else read(ichar(istartc:istartc+1),'(i2)') npi istartc=istartc+2 do 505 n=1,npi read(ichar(istartc:istartc),'(i1)') inc write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) ipi(n,2) istartc=istartc+inc+1 read(ichar(istartc:istartc),'(i1)') inc write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) ipi(n,1) istartc=istartc+inc+1 505 continue endif 45 continue endif c**************************************************************** c c Read in number of bytes in secondary header variables c c**************************************************************** read(ichar(istartc:istartc),'(i1)') inc istartc=istartc+1 if ( inc .gt. 0 ) then write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) insec istartc=istartc+inc c**************************************************************** c c Read in number of secondary header variables (nsecond) c c**************************************************************** read(ichar(istartc:istartc),'(i1)') inc write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) nsecond istartc=istartc+inc+1 c**************************************************************** c c Read in secondary header variables (sechead()) c c**************************************************************** do 35 n = 1,nsecond read(ichar(istartc:istartc),'(i1)') inc write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) nn istartc=istartc+inc+1 call charout(istartc,jsig2(nn),jprec2(nn),jtot2(nn),ichar, * sechead(nn),bmiss) isec(n) = nn 35 continue endif c**************************************************************** c c Read in number of bytes in biology variables c c**************************************************************** read(ichar(istartc:istartc),'(i1)') inc istartc=istartc+1 if ( inc .gt. 0 ) then write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) inbio istartc=istartc+inc c**************************************************************** c c Read in number of biological variables (nbio) c c**************************************************************** read(ichar(istartc:istartc),'(i1)') inc write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) nbio istartc=istartc+inc+1 c**************************************************************** c c Read in biological variables (bio()) c c**************************************************************** do 40 n = 1,nbio read(ichar(istartc:istartc),'(i1)') inc write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) nn istartc=istartc+inc+1 call charout(istartc,jsigb(nn),jprecb(nn),jtotb(nn),ichar, * bio(nn),bmiss) ibio(n) = nn 40 continue c**************************************************************** c c Read in biomass and taxonomic variables c c**************************************************************** read(ichar(istartc:istartc),'(i1)') inc write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) nbothtot istartc=istartc+inc+1 do 41 n = 1,nbothtot itaxtot=0 read(ichar(istartc:istartc),'(i1)') inc write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) nn istartc=istartc+inc+1 vtax(0,n)=nn do 42 n2 =1,nn itaxtot=itaxtot+1 read(ichar(istartc:istartc),'(i1)') inc write(aout(3:3),'(i1)') inc read(ichar(istartc+1:istartc+inc),aout) itaxnum(itaxtot,n) istartc=istartc+inc+1 call charout(istartc,jsigtax(itaxtot,n),jprectax(itaxtot,n), * jtottax(itaxtot,n),ichar,vtax(itaxtot,n),bmiss) read(ichar(istartc:istartc),'(i1)') itaxerr(itaxtot,n) istartc=istartc+1 42 continue 41 continue endif c**************************************************************** c c Read in measured and calculated depth dependent variables c along with their individual reading flags c c**************************************************************** do 50 n = 1,levels if ( isoor.eq.0 ) then call charout(istartc,idsig(n),idprec(n),idtot(n),ichar, * depth(n),bmiss) read(ichar(istartc:istartc),'(i1)') iderror(n,0) istartc=istartc+1 endif do 55 i = 1,nvar call charout(istartc,msig(n,ip2(i)),mprec(n,ip2(i)), * mtot(n,ip2(i)),ichar,temp(n,ip2(i)),bmiss) if ( temp(n,ip2(i)) .gt. bmiss ) then read(ichar(istartc:istartc),'(i1)') iderror(n,ip2(i)) istartc=istartc+1 else iderror(n,ip2(i))=0 endif 55 continue 50 continue return 500 ieof = 1 return end c----------------------------------------------------------- c----------------------------------------------------------- c----------------------------------------------------------- SUBROUTINE CHAROUT(istartc,jsig,jprec,jtot,ichar,value,bmiss) c This subroutine reads a single real value from the c OCL ASCII format. This value consists of four c components: # significant figures, # total figures, c precision, and the value. c Examples: c VALUE Precision OCL ASCII c ----- --------- --------- c 5.35 2 332535 c 5. 0 1105 c 15.357 3 55315357 c (missing) - c****************************************************** c c Passed Variables: c c istartc - starting point to read in data c jsig - number of significant figures in data value c jprec - precision of data value c jtot - number of figures in data value c ichar - character array from which to read data c value - data value c bmiss - missing value marker c c***************************************************** c***************************************************** c c Character Array: c c cwriter - format statement (FORTRAN I/O) c c**************************************************** character*6 cwriter character*(*) ichar data cwriter /'(fX.X)'/ c**************************************************** c c Check if this is a missing value (number of c figures = '-') c c**************************************************** if ( ichar(istartc:istartc) .eq. '-' ) then istartc = istartc+1 value = bmiss return endif c**************************************************** c c Read in number of significant figure, total c figures and precision of value c c**************************************************** read(ichar(istartc:istartc),'(i1)') jsig read(ichar(istartc+1:istartc+1),'(i1)') jtot read(ichar(istartc+2:istartc+2),'(i1)') jprec istartc=istartc+3 c**************************************************** c c Write these values into a FORTRAN format statement c c e.g. "553" --> '(f5.3)' c "332" --> '(f3.2)' c c**************************************************** write(cwriter(3:3),'(i1)') jtot write(cwriter(5:5),'(i1)') jprec c**************************************************** c c Read in the data value using thhe FORTRAN c format statement created above (cwriter). c c**************************************************** read(ichar(istartc:istartc+jtot-1),cwriter) value c**************************************************** c c Update the character array position (pointer) c and send it back to the calling program. c c**************************************************** istartc=istartc+jtot return end