SUBROUTINE INPROBE(npro,nprotot,numpar,ireqpars,isoor) C INPROBE READS THE FILE PROBEFILE.D AND SETS THE DEFINING C PROBES AND PARAMETER INFORMATION FROM WHAT IT READS. IT C ALSO GETS USER INPUT INFORMATION ON WHICH PROBES AND C PARAMETERS ARE TO BE INVESTIGATED IN THE MAIN PROGRAM. c----------------------------------------------------------------- c c Subroutine Steps: c c 1. Open probefile.d c 2. Read in total number of probes and measured and c calculated parameters which reside in the system. c 3. Extract measured parameter information. c 4. Extract probe information. c 5. Extract calculated parameter information. c 6. Extract secondary header information c 7. Extract biological parameter information c c----------------------------------------------------------------- cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Passed Variables: c c npro - number of requested probes c nprotot - total number of probes in probefile.d. c numpar - total number of measured parameters in probefile.d. c maxparm -maximum number of parameters system can hold. c ireqpars- number of requested measured parameters. c isoor - requested observed (0) or standard (1) levels. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Parameter: c c maxcalc - maximu number of measured and calculated c parameters allowed in OCL system. c maxparm - maximum number of measured parameters allowed in system c nprobe - maximum number of probes allowed in system. c maxlevel - maximum number of depth levels c maxkdim - maximum number of reference levels c noffset - offset between bio and sec headers from c set data c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc parameter (maxcalc=200,maxparm=100,nprobe=100) parameter (maxlevel=6000, maxkdim=137) parameter (noffset=200) cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Character Variables: c c cparm - holder array used to read in probe data c cchoice - reads in user choices (marked with an 'x') c citf - 1-15 letter parameter name which is read from c probefile.d and is used as the filename under c which actual parameter data is stored. c citf2 - 1-6 letter parameter abbreviation used to c identify data in printed out profiles. c mtype - 1-3 letter parameter code used in auxilary c file names such as for analyzed data. c ctype - 1-11 letter probe name used in directory structure c of OCL system. c infile - name for correct probefile.d c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc character*1 cchoice(maxlevel),xchoice character*3 mtype(maxlevel),xmtype(maxcalc) character*6 citf2(maxlevel),xcitf2(maxcalc) character*7 initial character*11 ctype(nprobe) character*15 infile character*15 citf(maxlevel),xcitf(maxcalc) character*80 cparm,filename save initial dimension ip2(0:maxlevel),isurx(maxcalc) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Common Blocks: c c setchoice - choices about which set of data (which probefile.d) c to use. Contains isetnum, the data set number c (0 corresponds to probefile.d, 1 to probefile1.d etc.) c isetadd, the number to add to parameter c codes for this data set (for using two data sets c simultaneously), and isetadd2, the number to add c to probe codes. c reqps - contains ip2, parameter codes for requested parameters. c parnames - contains citf (described under character variables) c parname1 - contains mtype (described above) c parname4 - contains citf2 (described above) c probes - contains ctype (described above) c surrogate - contains isur which keeps the code of the surrogate c for a calculated parameter. Surrogates are the c least abundant measured parameter which goes into c the calculating of the calculated parameter. The c calculated parameter will have the same record c structure as its surrogate. c nopars - contains nopas, which keeps the number of parameters c measured by each probe. c partype - contains nprm, which contains, in order of appearance, c the parameters measured for each probe. c totalparms - contains npatot, which keeps the number of probes c which measure each parameter. c depthcon - contains ixbt, which marks with a one all XBT probe c types. c reqprobe - contains jp, which holds probe codes for requested c probes. c allprobe - contains jpm, which holds probe codes for requested c probes, including 'special use' probes, which are c marked with a 'y' instead of an 'x' c parmord - contains nprec, which holds the order of recording c of each parameter code, by probe c twoparm - contains itwo. If a parameter is a biological c parameter, this number is a two. If a parameter c is a secondary header, this number is a one. c extra - parameters other than measured physical and chemical c parameters, ireqpars2 = number of calculated parameters, c ireqsecond= number of requested second header parameters, c ireqbio=number of requested biological parameters c eachparm - contains the number of each type of parameter listed, c numpar=number of normal (physical and chemical plus c overall biological and overall second header) c parameters. numcalc=number of calculated parameters. c numsecond=number of specific second header parameters. c numbio=number of specific biological parameters c numtax=number of taxonomic variables. numsecset is c number of parameter specific secod header sets. numtot2 is c the first possible code for second header c parameters (minus one). numtot3 is the first c possible code number for biological parameters c ntax - number of taxa in individual proflie c (minus one) c reflevs - contains nplv, the number of reference levels, and c dz2, the actual reference levels c calctype - contains ipx, the actual parameter codes for c each calculated parameter c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc common /setchoice/ isetnum,isetadd,isetadd2 common /reqps/ ip2 common /parnames/ citf common /parname1/ mtype common /parname4/ citf2 common /probes/ ctype common /reqprobe/ jp(0:nprobe) common /allprobe/ jpm(0:nprobe),npromax common /nopars/ nopas(nprobe) common /partype/ nprm(nprobe,maxparm) common /parmord/ nprec(maxcalc,nprobe) common /totalparms/ npatot(maxparm) common /depthcon/ ixbt(nprobe) common /surrogate/ isur(maxcalc) common /twoparm/ itwo(0:maxparm) common /extra/ ireqpars2,ireqsecond, ireqbio common /eachparm/ numpars,numcalc,numsecond,numbio, * numtax,numset,numtot2,numtot3,ntax, * numsecset c nplv is the number of potential density surfaces common /reflevs/ nplv,dz2(maxkdim) common /calctype/ ipx(maxcalc) if ( initial .ne. 'inprobe' ) then initial='inprobe' npro=0 ireqtots=0 ireqpars2=0 ireqpars=0 ireqbio=0 ireqsecond=0 numpars=0 numcalc=0 numsecond=0 numbio=0 numset=0 numtot2=0 numtot3=0 ntax=0 numsecset=0 endif ispace = 0 !- Linux init imiddle = 0 ireqtot=0 c*********************************************************** c c If a previous data set has been read in, adjust the c order number for the second header parameter. c c*********************************************************** do nc=1,nprobe nprec(ip2(maxlevel),jp(nc)) = 0 enddo cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Open probefile.d. This file contains all necessary information c on probes and parameters (measured and calculated) as well as c user input information on which probes and parameters to c be investigated in the main program c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc call clearstring(infile,15) if ( isetnum .eq. 0 ) then infile = './probefile.d' elseif ( isetnum .lt. 10 ) then infile(1:9) = 'probefile' write(infile(10:10),'(i1)') isetnum infile(11:12) = '.d' else infile(1:11) = './probefile' write(infile(12:13),'(i2)') isetnum infile(14:15) = '.d' endif open(10,file=infile,status='old') ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c This read statement, which will be repeated often, c skips text lines in probefile.d c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc read(10,'(/)') ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Read in number of probe types (nprotot) and number of c parameters, measured (numpar) and calculated (numcalc). c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc read(10,*) nprototx read(10,*) numparx read(10,*) numcalc if ( isetnum .eq. 0 ) then isetadd=0 isetadd2=0 endif numpar = numparx + isetadd nprotot = nprototx + isetadd2 read(10,'(7(/))') ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Read in information about each measured parameter c c cchoice is blank unless this parameter is to be investigated c in the main program. Any mark will do, although an 'x' is c prompted for in the probefile.d text. c c citf is a 15 letter parameter name which will be used c in the file name where data is stored c c mtype is a 1-3 letter parameter code used in auxilary file c naming. c c citf2 is a 1-6 letter parameter abbreviation used in c identifying parameters in a printed out profile. c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc call setforsurf(1,0) call setforsurf(2,0) call setforsurf(3,0) do 50 n=isetadd+1,numpar call clearstring(cchoice(n),1) call clearstring(citf(n),15) call clearstring(mtype(n),3) call clearstring(citf2(n),6) read(10,200) cchoice(n),citf(n),mtype(n),citf2(n) c Store lat,lon, and time variable locations in C c global variables call findlastchar(ny,citf(n),15) if ( ny .eq. 8 .and. citf(n)(1:ny) .eq. 'Latitude' ) * call setforsurf(1,n) if ( ny .eq. 9 .and. citf(n)(1:ny) .eq. 'Longitude' ) * call setforsurf(2,n) if ( ny .eq. 9 .and. citf(n)(1:ny) .eq. 'JulianDay' ) * call setforsurf(3,n) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Check if this is a biological parameter. If it is c the first three letters must be 'Bio'. Assign the c a two to itwo if this is a biological parameter c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc if ( citf(n)(1:3).eq.'Bio') itwo(n)=2 if ( cchoice(n).ne.' ' ) then cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c If this is a chosen parameter, add one to the chosen c parameter counter (ireqpars) and record the code number c in ip2. The code number is simply the order in which c the parameter is entered in probefile.d c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ireqpars=ireqpars+1 ireqtots=ireqtots+1 ip2(ireqpars)=n endif 50 continue 200 format(a1,a11,14x,a3,6x,a4) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Add one more parameter, this is the secondary header c parameter, which, like the biology parameter, is a two c dimensional parameter. Denote this by setting its itwo c to two. All probes have this parameter. c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc itwo(numpar-isetadd) = 0 numpars = numpar+1 numpar = numpar+1 call clearstring(citf(numpar),15) call clearstring(citf2(numpar),6) citf(numpar)='Header2' citf2(numpar)='Hed2' itwo(numpar)=1 ip2(maxlevel)=numpar ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c As a safeguard against the listed number of parameters c being more than the input number of parameters (numpar), c lines will be continously read until the line containing c all '-' characters is found. This is more important for the c probe types. c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 101 read(10,'(a1)') cparm if ( cparm(1:1) .ne. '-' ) goto 101 c************************************************************ c c Read in wheter observed or standard level data is to c be examined. If there is a marker in front of c the standard level prompt, standard levels will be c examined, otherwise, observed levels will be examined. c c************************************************************ read(10,'(/)') read(10,'(a1)') cparm isoor=0 if ( cparm(1:1).ne.' ') isoor=1 read(10,'(a1)') cparm ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Read in information on probe types c c cchoice is marked only if the probe type is to be c investigated in the main program. c ctype is the 11 character probe name used in the c directory structure of the data base. c nprm lists the parameters recorded by each probe type c in the order they are listed. c c nproprev = the previous requested probe total ( if more c than one data set is being used). c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc nproprev = npro do 55 n=isetadd2+1,nprotot call clearstring(cparm,80) read(10,'(a80)') cparm cchoice(n)=cparm(1:1) call clearstring(ctype(n),11) ctype(n)=cparm(2:12) read(cparm(20:21),'(i2)') nopas(n) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c The parameters which a probe measures are listed by c code number, separated either by a ',', a space, or c a '-'. A comma or a space just seperate two code numbers, c A hyphen means the probe measures each parameter whose c code number falls between the two values, including the c values themselves. c c Since a code may be 1-3 digits, these digits must all c be read together to form a code. So, the code is only read c when a comma, a space, or a hyphen is encountered. The c number of digits read is dependent on the distance between c hyphen, comma, and/or spaces. c c Reading the codes continues until the number of parameters c measured by a probe (nopas) is reached. c c Reset number of parameters (m) to zero c c nspace is set to 24 because this is the space of the first c digit of parameter code in cparm. nspace will be increased c as cparm is read. c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc m=0 nspace=24 56 if ( cparm(nspace+1:nspace+1).eq.',' .or. * cparm(nspace+1:nspace+1).eq.' ') then ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c If a space or a comma is encountered, add one to the c parameter counter. Read the parameter code according c to how many digits since the last comma or space (ispace). c c Also increase nspace to the beginning of the next digit. c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc m=m+1 if ( ispace.eq.0 ) then read(cparm(nspace:nspace),'(i1)') nprm(n,m) elseif ( ispace.eq.1 ) then read(cparm(nspace-1:nspace),'(i2)') nprm(n,m) elseif ( ispace.eq.2 ) then read(cparm(nspace-2:nspace),'(i3)') nprm(n,m) endif nspace=nspace+2 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c If this digit is to the right of a hyphen (imiddle=2), c set nprm (parameter codes by probe) for each number c between the last code read in and the latest code c read in successively, including these outside code c values. c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc if ( imiddle.eq.2 ) then npholds=nprm(n,m-1) npholde=nprm(n,m) m=m-1 do 60 i=npholds+1,npholde m=m+1 nprm(n,m)=i 60 continue endif ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Reinitialize ispace. c If the last code read in was to the left of a hyphen, c (imiddle=1), set imiddle to 2, since the next entered c code will be to the right of the hyphen. c Otherwise reinitialize imiddle. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ispace=0 if ( imiddle.eq.1 ) then imiddle=2 else imiddle=0 endif elseif ( cparm(nspace+1:nspace+1).eq.'-' ) then cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c If the code to be entered is to the left of a hyphen, c record this information by making imiddle=1. Also c change the hyphen to a comma so the code can be entered. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc imiddle=1 cparm(nspace+1:nspace+1)=',' else cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Bump ispace and nspace up one since this code must have c more digits. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ispace=ispace+1 nspace=nspace+1 endif ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c If all codes have not been read, read the next code. c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc if ( m.lt.nopas(n)) goto 56 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Add one to counter npatot, which counts how many probes c measure each parameter, for each parameter measured. c c Also, invert nprm, that is, for each parameter, record c the order in which it was recorded. c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc do 58 i=1,nopas(n) nprm(n,i) = nprm(n,i) + isetadd npatot(nprm(n,i))=npatot(nprm(n,i))+1 nprec(nprm(n,i),n)=i 58 continue ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Set nprec and nprm for the second header c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc nprec(numpar,n)=nopas(n)+1 nprm(n,nopas(n)+1)=numpar ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Check if this probe is an XBT type. XBT probes c name code must start with a large or small x. XBT's c need to have their depths corrected later. c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc if ( ctype(n)(1:1).eq.'X' .or. ctype(n)(1:1).eq.'x') then ixbt(n)=1 endif c********************************************************** c c Check if this is a surface probe (if probe starts c with SUR) c c********************************************************** if ( ctype(n)(1:3) .eq. 'SUR' .or. * ctype(n)(1:3) .eq. 'sur' ) then call setsurfprobe(n,1) else call setsurfprobe(n,0) endif ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c If this is a chosen probe, add one to chosen probes c (npro) and place the code in jp. The code is simply c the order of listing in probefile.d. c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc if ( cchoice(n).ne.' ') then if ( cchoice(n) .ne. 'y' ) then npro=npro+1 jp(npro)=n endif npromax=npromax+1 jpm(npromax)=n endif 55 continue c*********************************************************** c c If a previous data set has been read in, adjust the c order number for the second header parameter. c c*********************************************************** do 909 nc=1,nproprev nprec(ip2(maxlevel),jp(nc)) = nopas(jp(nc))+1 nprm(jp(nc),nopas(jp(nc))+1) = ip2(maxlevel) 909 continue ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c As a safeguard against the listed number of probes c being more than the input number of probes (nprotot), c lines will be continously read until the line containing c all '-' characters is found. This may be manipulated by c user to gain the proper auxilary file names. (See manual.) c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 102 read(10,'(a1)') cparm if ( cparm(1:1) .ne. '-' ) goto 102 read(10,'(3(/))') ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Read in calculated parameter information. The information c is similiar to measured parameter data with the following c differences. For potential temperature and potential density c there are 33 and 34 categories respectively. These correspond c to using the standard level represented by each number as c the reference level. The 34th category for potential density c is in situ density. citf and citf2 for these parameters are as c listed plus and ending of one or two digits corresponding to c the reference level used. To choose one or more potential c temperatures or densities to be investigated, place the number c of different reference levels to be investigated in the two spaces c to the left of the parameter name. Between the dotted lines at c the bottom of probefile.d, enter the reference levels desired, c first potential temperature, then potential densities if some of c both are desired. For other calculated parameters, simply place c an 'x' in the first column as before. isur is the surrogate for c each measured parameter. This is the least abundant measured c parameter involved in the calculation of the parameter. The file c structure of the calculated parameter will be the same as that of c the surrogate parameter. So to look in potential temperature c files, salinity record numbers will be used. The code number of c each calculated parameter is the number listed plus the total c number of measured parameters (numpar). c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Set potential temperature and potential density information. c (numpar+(1tonplv) and numpar+nplv+(1tonplv+1) codes respectively. c c ipt and ipd are the number of potential temperature and potential c density parameters to be investigated in the main program. The c actual code numbers are then listed below. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc call clearstring(xcitf(1),15) call clearstring(xmtype(1),3) call clearstring(xcitf2(1),6) call clearstring(xcitf(2),15) call clearstring(xmtype(2),3) call clearstring(xcitf2(2),6) read(10,240) ipt,xcitf(1),xmtype(1),xcitf2(1),isurx(1) read(10,240) ipd,xcitf(2),xmtype(2),xcitf2(2),isurx(2) 240 format(i2,a11,17x,a1,8x,a4,7x,i3) cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Set character variables for potential temperature and c potential density. First call findchar to find the end c of each variable, then add the appropriate suffix. c c findchar outputs the distance from the beginning of a c character array to the first occurance of a character. c Here, n1 is the distance, the second variable is the array c in question, the third is the maximum length of a variable c and the last is the character to be searched for. So the c length of an array is the distance -1 to the first space c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc call findlastchar(n1,xcitf(1),15) n1=n1+1 call findlastchar(n2,xcitf2(1),4) n2=n2+1 call findlastchar(n3,xmtype(1),3) n3=n3+1 call findlastchar(n4,xcitf(2),15) n4=n4+1 call findlastchar(n5,xcitf2(2),4) n5=n5+1 call findlastchar(n6,xmtype(2),3) n6=n6+1 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Read in rest of calculated parameters. c First set the number of calculated parameters to ipt+ipd since c these parameters are evaluated first. c For each chosen parameter, set the values of the character c codes in the space for the code of the last measured code c entered plus the number of requested calculated parameters. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ireqpars2=ipd+ipt ireqtots=ireqtots+ipd+ipt ipo=0 do 75 n=3,numcalc call clearstring(xcitf(n),15) call clearstring(xmtype(n),3) call clearstring(xcitf2(n),6) read(10,250) xchoice,xcitf(n),xmtype(n),xcitf2(n),isurx(n) if (xchoice .ne. ' ') then ireqpars2=ireqpars2+1 ireqtots=ireqtots+1 ipo=ipo+1 nchoice=numpar+ipt+ipd+ipo ipx(ipt+ipd+ipo)=(2*nplv)+n-2 ip2(ireqpars+ireqpars2)=nchoice call clearstring(citf(nchoice),15) call clearstring(mtype(nchoice),3) call clearstring(citf2(nchoice),6) citf(nchoice)=xcitf(n) mtype(nchoice)=xmtype(n) citf2(nchoice)=xcitf2(n) isur(nchoice)=isurx(n) do 98 np=1+isetadd2,nprotot nprec(nchoice,np)=nprec(isur(nchoice),np) 98 continue endif 75 continue 250 format(a1,1x,a11,17x,a1,8x,a4,7x,i3) cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Read in requested potential temperature and potential c density requested parameters. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc read(10,'(a80)') cparm do 70 i=1,ipt read(10,*) ichoice nchoice=numpar+i ipx(i)=ichoice ip2(ireqpars+i)=nchoice call clearstring(citf(numpar+i),15) call clearstring(mtype(numpar+i),3) call clearstring(citf2(numpar+i),6) citf(numpar+i)=xcitf(1) citf2(numpar+i)=xcitf2(1) mtype(numpar+i)=xmtype(1) isur(numpar+i)=isur(1) do 199 np=1+isetadd2,nprotot nprec(nchoice,np)=nprec(isur(nchoice),np) 199 continue if ( ichoice.lt.10 ) then write(citf(numpar+i)(n1+1:n1+1),'(i1)') ichoice write(citf2(numpar+i)(n2+1:n2+1),'(i1)') ichoice write(mtype(numpar+i)(n3+1:n3+1),'(i1)') ichoice else write(citf(numpar+i)(n1+1:n1+2),'(i2)') ichoice write(citf2(numpar+i)(n2+1:n2+2),'(i2)') ichoice write(mtype(numpar+i)(n3+1:n3+2),'(i2)') ichoice endif 70 continue do 71 i=ipt+1,ipt+ipd read(10,*) ichoice nchoice=numpar+i ipx(i)=ichoice ip2(ireqpars+i)=nchoice call clearstring(citf(numpar+i),15) call clearstring(mtype(numpar+i),3) call clearstring(citf2(numpar+i),6) citf(numpar+i)=xcitf(2) citf2(numpar+i)=xcitf2(2) mtype(numpar+i)=xmtype(2) isur(numpar+i)=isurx(2) do 99 np=1+isetadd2,nprotot nprec(nchoice,np)=nprec(isur(nchoice),np) 99 continue if ( ichoice .eq. 2*nplv+1 ) then call clearstring(citf(numpar+i),15) call clearstring(mtype(numpar+i),3) call clearstring(citf2(numpar+i),6) citf(numpar+i)='indensit' citf2(numpar+i)='IDen' mtype(numpar+i)='DIS' isur(numpar+i)=isurx(2) elseif ( ichoice-nplv.lt.10 ) then write(citf(numpar+i)(n4:n4),'(i1)') ichoice-nplv write(citf2(numpar+i)(n5:n5),'(i1)') ichoice-nplv write(mtype(numpar+i)(n6:n6),'(i1)') ichoice-nplv else write(citf(numpar+i)(n4:n4+1),'(i2)') ichoice-nplv write(citf2(numpar+i)(n5:n5+1),'(i2)') ichoice-nplv write(mtype(numpar+i)(n6:n6+1),'(i2)') ichoice-nplv endif 71 continue c****************************************************** c c Store all calculated parameter identifiers at c the end of the requested list c c****************************************************** do 72 ii=1,numcalc call clearstring(citf(numpar+ipt+ipd+ipo+ii),15) call clearstring(mtype(numpar+ipt+ipd+ipo+ii),3) call clearstring(citf2(numpar+ipt+ipd+ipo+ii),6) citf(numpar+ipt+ipd+ipo+ii)=xcitf(ii) mtype(numpar+ipt+ipd+ipo+ii)=xmtype(ii) citf2(numpar+ipt+ipd+ipo+ii)=xcitf2(ii) isur(numpar+ipt+ipd+ipo+ii)=isurx(ii) 72 continue cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Set the actual number of calculated parameters. This c is the number (numcalc) which was read in + all the c rest of the potential temperature and potential density c parameters ((2*nplv)-2)+1 for in situ density c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc numcalc=ipt+ipd+ipo c read(10,'(a80)') cparm c read(10,'(a80)') cparm close(10) call extraname('sys.inf'//CHAR(0), * 'secbiofile.d'//CHAR(0),filename) open(10,file=filename,status='old') read(10,'(a80)') cparm ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Read in Secondary Header Information c c The parameter numbers of secondary header information will c be nchoice + code number as listed in probefile.d c c nchoice is set to maxcalc+maxparm+1. This ensures that c second parameter code numbers will not change even when c measured and calculated parameters are added to the data c base c c numsecond is the number of secondary header specific parameters c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc nchoice=maxparm+maxcalc+1 read(10,*) numsecond do 85 n=1,numsecond cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Add one to the choice number and read in the next c specific second header parameter, including c choice prefence, name, and maximum number of figures c in the parameter c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc nchoice=nchoice+1 call clearstring(citf(nchoice),15) read(10,300) cchoice(nchoice),citf(nchoice) cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Set four letter parameter code to the first four letters c of the parameter name. c c Set mtype to the parameter code c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc call clearstring(citf2(nchoice),6) citf2(nchoice)=citf(nchoice)(1:4) call clearstring(mtype(nchoice),3) if ( nchoice.lt.10 ) then write(mtype(nchoice+n2)(1:1),'(i1)') nchoice elseif ( nchoice.lt.100 ) then write(mtype(nchoice)(1:2),'(i2)') nchoice else write(mtype(nchoice)(1:3),'(i3)') nchoice endif ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c If this is a chosen parameter, add one to chosen second c header parameters, add one to total chosen parameters, c store the parameter code in ip2 c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc if ( cchoice(nchoice).ne.' ') then ireqsecond=ireqsecond+1 ireqtot=ireqtot+1 ip2(ireqtot)=nchoice endif 85 continue 104 read(10,'(a1)') cparm if ( cparm(1:1) .ne. '-' ) goto 104 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Read in Parameters Specific Set Information c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc nchoice=maxparm+maxcalc+noffset + 1 read(10,'(a80)') cparm read(10,*) numset do 196 n=1,numset nchoice=nchoice+1 call clearstring(citf(nchoice),15) read(10,300) cchoice(nchoice),citf(nchoice) call clearstring(citf2(nchoice),6) citf2(nchoice)=citf(nchoice)(1:4) call clearstring(mtype(nchoice),3) if ( nchoice.lt.10 ) then write(mtype(nchoice)(1:1),'(i1)') nchoice elseif ( nchoice.lt.100 ) then write(mtype(nchoice)(1:2),'(i2)') nchoice else write(mtype(nchoice)(1:3),'(i3)') nchoice endif if ( cchoice(nchoice).ne.' ') then ireqset=ireqset+1 ireqtot=ireqtot+1 ip2(ireqtot)=nchoice endif 196 continue 114 read(10,'(a1)') cparm if ( cparm(1:1) .ne. '-' ) goto 114 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Read in Specific Biological Parameters c c nchoice starts at maxparm + 2*maxcalc +1. This ensures c that the addition of other parameters will not affect c the biology numbering system. c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc nchoice=(2*maxparm)+maxcalc+noffset+1 read(10,'(a80)') cparm read(10,*) numbio do 95 n=1,numbio nchoice=nchoice+1 call clearstring(citf(nchoice),15) call clearstring(citf2(nchoice),6) call clearstring(mtype(nchoice),3) citf2(nchoice)=citf(nchoice)(1:4) read(10,300) cchoice(nchoice),citf(nchoice) if ( nchoice.lt.10 ) then write(mtype(nchoice)(1:1),'(i1)') nchoice elseif ( nchoice.lt.100 ) then write(mtype(nchoice)(1:2),'(i2)') nchoice else write(mtype(nchoice)(1:3),'(i3)') nchoice endif if ( cchoice(nchoice).ne.' ') then ireqbio=ireqbio+1 ireqtot=ireqtot+1 ip2(ireqtot)=nchoice endif 95 continue 300 format(a1,3x,a15) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Read in Biological Taxa Parameters c c nchoice starts at the end of the biological parameters c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc nchoice=(2*maxparm)+maxcalc+(2*noffset) + 1 read(10,'(a80)') cparm read(10,*) numtax do 96 n=1,numtax nchoice=nchoice+1 call clearstring(citf(nchoice),15) call clearstring(citf2(nchoice),6) call clearstring(mtype(nchoice),3) read(10,300) cchoice(nchoice),citf(nchoice) citf2(nchoice)=citf(nchoice)(1:4) if ( nchoice.lt.10 ) then write(mtype(nchoice)(1:1),'(i1)') nchoice elseif ( nchoice.lt.100 ) then write(mtype(nchoice)(1:2),'(i2)') nchoice else write(mtype(nchoice)(1:3),'(i3)') nchoice endif if ( cchoice(nchoice).ne.' ') then ireqbio=ireqbio+1 ireqtot=ireqtot+1 ip2(ireqtot)=nchoice endif 96 continue close(10) isetadd = numpar - 1 isetadd2 = nprotot return end