SUBROUTINE SETGLOBAL(iptotal,ireqex,nprotot) C SETGLOBAL IS A ROUTINE TO SET ALL CHARACTER VARIABLES C GLOBALLY IN C. THIS ELIMINATES THE NEED (IN MOST CASES) C TO CARRY THESE VARIABLES INTO THE MAIN BODY OF THE C FORTRAN PROGRAM. c------------------------------------------------------------ c c Subroutine Steps: c c 1. Set 'other' character variables (C subroutine cname) c 2. Add C character array end notation '\0', to the c end of all character variables and then set these c three variables (parameter name (citf), parameter c abbreviation (citf2), and parameter code (mtype) c (C subroutines findchar and cname) c 3. Do the same for probe identifier (ctype) c (C subroutines findchar and cname2) c c------------------------------------------------------------ ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Passed Variables: c c iptotal - total number of requested parameters c (measured and calculated) c nprotot - total number of probes c ireqex - number of non-requested measured parameters c which are related to a calculated parameter c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Parameters: c c nprobe - maximum number of probes in the OCL system. c maxlevel - maximum number of depth levels c maxparm - maximum number of measured parameters c maxcalc - maximum number of calculated parameters c noffset - offset between bio and sec headers and c their set data c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc parameter (nprobe=100, maxlevel=6000, maxparm=100) parameter (maxcalc=200, maxkdim=137,noffset=200) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Character Variables: c c citf - 1-15 letter name of parameter, is used as the c actual file name where parameter data is stored c ctype - 1-11 letter probe name, is used as the directory c under which data is stored c mtype - 1 to 3 letter code for parameter. Used for c auxilary file naming, such as analyzed data. c citf2 - 1-6 letter parameter abbreviation. Used for c identifying output in ASCII profiles. c c xcitf,xctype,xmtype,xcitf2 - same as similiarly named c variables above, but with two extra spaces for the C c end of character array marker '\0'. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc character citf*15,ctype*11,citf2*6,mtype*3 character xcitf(maxlevel)*17,xctype(nprobe)*13 character xcitf2(maxlevel)*8,xmtype(maxlevel)*5 c*********************************************************** c c Array: c c ip2 - parameter codes of requested parameters c c*********************************************************** dimension ip2(0:maxlevel) common /parnames/ citf(maxlevel) common /parname1/ mtype(maxlevel) common /parname4/ citf2(maxlevel) common /probes/ ctype(nprobe) common /reqps/ ip2 common /extra/ ireqpars2,ireqsec,ireqbio common /reflevs/ nlevs,dz2(maxkdim) common /calctype/ ipx(maxcalc) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c eachparm contains numeach, which holds the number of c parameters in each type of category: c 1. measured parameters c 2. calculated parameters c 3. second header parameters c 4. biological parameters c 5. taxonomic parameters c 6. second header variable specific parameters c c numtotx - starting number (minus one) for second header c parameters c numtotz - starting number (minus one) for biological c parameters c ntax - number of taxa in individual profiles c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc common /eachparm/ numeach(6),numtotx,numtotz,ntax,numsecset ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Call cname to name 'other' parameter. Other parameter c pertains to masks that deal with either all parameters c or special subsets (such as density masks for salinity c and temperature) or depth. c c Cname sets 3 global variables, a 15 letter code, a three c letter code, and a four letter code (maximums). The c last passed variable is the parameter number code which c corresponds to the passed character variables. c c Usually, the fifteen letter name is citf, the one letter c name is mtype and the four letter name is citf2. Mtype is c always a one letter code except for some calculated c parameters. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc call cname('other'//CHAR(0),'o'//CHAR(0),'oth'//CHAR(0),0) call cname('header2'//CHAR(0),'h2'//CHAR(0),'h2'//CHAR(0), * numeach(1)) cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Start requested parameters loop. c c Set i to the correct parameter code (ip2) c c Set xcitf equal to citf. c c Call findend to find the last letter in citf (actually the c first space). c nx - the number corresponding to the placement of the c first space in xcitf c xcitf - the character variable being examined c - the next number is the maximum number of letters in citf c - the last variable is the character, in this case a space c which the subroutine is looking for the first occurrance of. c add the C end of character array notation ('\0') to the end c of xcitf. c c Repeat for citf2 and mtype c c Assign global C parameter variables in cname as described above. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c do 90 i0=1,iptotal-ireqpars2-ireqex do 90 i0=1,numeach(1)-1 c i=ip2(i0) i=i0 xcitf(i)=citf(i) call findchar(nx,citf(i),15,' ') if ( nx .lt. 2 .or. nx .gt. 15 ) write(6,*) 'cname error 1' xcitf(i)(nx:nx)=CHAR(0) xcitf2(i)=citf2(i) call findchar(nx,citf2(i),6,' ') xcitf2(i)(nx:nx)=CHAR(0) if ( nx .lt. 2 .or. nx .gt. 6 ) write(6,*) 'cname error 2' xmtype(i)=mtype(i) call findchar(nx,mtype(i),3,' ') xmtype(i)(nx:nx)=CHAR(0) if ( nx .lt. 2 .or. nx .gt. 3 ) write(6,*) 'cname error 3' call cname(xcitf(i),xmtype(i),xcitf2(i),i) 90 continue cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Assign global variables for calculated parameters c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc do 81 i0=iptotal-(ireqpars2+ireqex)+1,iptotal i=ip2(i0) i2=i c i2=numeach(1)+i0-(iptotal-ireqpars2-ireqex) c ip2(i0)=i2 i3=0 c ipx(i2-numeach(1))=i-numeach(1) ipxx=ipx(i2-numeach(1)) if ( ipxx .le. nlevs ) then c ix=numeach(1)+1 i3=i - numeach(1) elseif ( ipxx .le. 2*nlevs+1 ) then c ix=numeach(1)+2 i3=i - (numeach(1)+nlevs) else c ix=numeach(1)+ (i - 2*nlevs) endif xcitf(i2)=citf(i) call findchar(n1,citf(i2),15,' ') xcitf2(i2)=citf2(i2) call findchar(n2,citf2(i2),6,' ') xmtype(i2)=mtype(i2) call findchar(n3,mtype(i2),3,' ') if ( i3 .gt. 0 .and. i3.lt.10 ) then write(xcitf(i2)(n1:n1),'(i1)') i3 write(xcitf2(i2)(n2:n2),'(i1)') i3 write(xmtype(i2)(n3:n3),'(i1)') i3 n1=n1+1 n2=n2+1 n3=n3+1 elseif ( i3 .ge. 10 ) then write(xcitf(i2)(n1:n1+1),'(i2)') i3 write(xcitf2(i2)(n2:n2+1),'(i2)') i3 write(xmtype(i2)(n3:n3+1),'(i2)') i3 n1=n1+2 n2=n2+2 n3=n3+2 endif xcitf(i2)(n1:n1)=CHAR(0) xcitf2(i2)(n2:n2)=CHAR(0) xmtype(i2)(n3:n3)=CHAR(0) if ( n1 .lt. 2 .or. n1 .gt. 15 ) write(6,*) 'cname error 4' if ( n2 .lt. 2 .or. n2 .gt. 6 ) write(6,*) 'cname error 5' if ( n3 .lt. 2 .or. n3 .gt. 3 ) write(6,*) 'cname error 6' if ( i2 .lt. 1 .or. i2 .gt. maxlevel ) * write(6,*) 'cname error 7' call cname(xcitf(i2),xmtype(i2),xcitf2(i2),i2) 81 continue c********************************************************** c c Do the same for non-requested measured parameters c necessary for calculated parameters c c********************************************************** do 93 i0=iptotal-ireqex+1,iptotal i=ip2(i0) xcitf(i)=citf(i) call findchar(nx,citf(i),15,' ') xcitf(i)(nx:nx+1)=CHAR(0) xcitf2(i)=citf2(i) call findchar(nx,citf2(i),6,' ') xcitf2(i)(nx:nx+1)=CHAR(0) xmtype(i)=mtype(i) call findchar(nx,mtype(i),3,' ') xmtype(i)(nx:nx+1)=CHAR(0) call cname(xcitf(i),xmtype(i),xcitf2(i),i) 93 continue ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Do the same procedure for second header data and c biological data. c c numtot2 is the first possible second header parameter-1 c numtot3 is the last possible second header parameter c numtot4 is the first possible biological parameter-1 c numtot5 is the last possible biological parameter c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc numtot2=maxparm+maxcalc+1 numtot3=numtot2+numeach(3) numtot4=(2*maxparm)+maxcalc+noffset+1 numtot5=numtot4+numeach(4) numtot6=(2*maxparm)+maxcalc+(2*noffset)+1 numtot7=numtot6+numeach(5) numtot8=maxparm+maxcalc+noffset+1 numtot9=numtot8+numeach(6) do 91 nn=1,4 if ( nn.eq.2) then i1=numtot2 i2=numtot3 elseif ( nn.eq.1) then i1=numtot4 i2=numtot5 elseif ( nn .eq. 4 ) then i1=numtot8 i2=numtot9 else i1=numtot6 i2=numtot7 endif do 92 i=i1,i2 xcitf(i)=citf(i) call findchar(nx,citf(i),15,' ') xcitf(i)(nx:nx+1)=CHAR(0) xcitf2(i)=citf2(i) call findchar(nx,citf2(i),6,' ') xcitf2(i)(nx:nx+1)=CHAR(0) xmtype(i)=mtype(i) call findchar(nx,mtype(i),3,' ') xmtype(i)(nx:nx+1)=CHAR(0) call cname(xcitf(i),xmtype(i),xcitf2(i),i) 92 continue 91 continue ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Do the same procedure for probe character array ctype, c which is set in cname2. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc do 55 j=1,nprotot xctype(j)=ctype(j) call findlastchar(nx,ctype(j),11) ctype(j)(nx+1:nx+1)=CHAR(0) call cname2(ctype(j),j) 55 continue return end