SUBROUTINE ARRAYINIT(iarray,nstart,nend) C ARRAYINIT INITIALIZES ALL ELEMENTS IN A ONE DIMENSIONAL C INTEGER ARRAY TO ZERO dimension iarray(nstart:nend) do 50 n=nstart,nend 50 iarray(n)=0 return end SUBROUTINE CHECK_MISSING(nvartype,cvar,nspvar, * intvar,dvar,xvar,cfill,ifill,xfill,dfill, * ihasfill,nspfill,ismissing) C CHECK_MISSING CHECKS FOR MISSING VALUE c ismissing=1 when value is equal to fill (missing) value character*(*) cvar character*(*) cfill double precision dvar,dfill include 'netcdf.inc' ismissing=0 if ( ihasfill .eq. 1 ) then if ( nvartype .eq. NF_CHAR ) then if ( nspvar .eq. nspmissing .and. * cvar(1:nspvar) .eq. cfill(1:nspvar) ) * ismissing=1 elseif ( nvartype .eq. NF_INT ) then if ( intvar .eq. ifill ) ismissing=1 elseif ( nvartype .eq. NF_DOUBLE ) then xvar=dvar xfill=dfill call checkforfill(xvar,xfill,ismissing) elseif ( nvartype .eq. NF_FLOAT ) then call checkforfill(xvar,xfill,ismissing) endif endif return end SUBROUTINE CHECKFORFILL(xval,fillval,isfill) C CHECKS IF VALUE IS A FILL VALUE C SETS ISFILL=1 IF VALUE IS A FILL VALUE isfill=1 isnan=isitnan(xval) if ( isnan .eq. 0 ) then isnan=isitnan(fillval) if ( * (isnan .ne. 0 ) * .or. * (fillval .gt. 0. .and. xval .lt. fillval) * .or. * (fillval .lt. 0. .and. xval .gt. fillval) * ) then isfill=0 endif endif return end SUBROUTINE CLEARSTRING(c,nsize) C CLEARSTRING INITIALIZES A CHARACTER STRING WITH C BLANKS character*(*) c do 80 n=1,nsize 80 c(n:n)=' ' return end SUBROUTINE FINDLASTCHAR(nspace,carray,maxspace) C FINDLASTCHAR FINDS THE LOCATION OF THE LAST NON-BLANK C IN A CHARACTER STRING cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Passed Variables: c c nspace - distance, in characters, from the beginning of c the character string where the last non-blank c character is found c carray - character string to be examined c maxspace - maximum number of characters in character array c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc character*(*) carray cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Initialize nspace c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc nspace=-1 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c Look at each character in string. If a character is a blank c set the value of nspace. If a nonblank character is found, c nspace is set to zero. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc do 50 n=1,maxspace c write(6,*) 'x50',n,'|',carray(n:n),'|' c if ( carray(n:n) .eq. CHAR(0) ) then i=isitreturn(carray(n:n)) if ( i .eq. 1 ) then if ( nspace .eq. 0 ) then nspace=n endif goto 4 endif if ( carray(n:n) .eq. " " .and. nspace .eq. 0 ) nspace=n if ( carray(n:n) .ne. " ") nspace=0 50 continue 4 continue cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c If a blank is not found, set nspace to maxspace. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc if ( nspace.eq.0 ) nspace=maxspace+1 if ( nspace .eq. -1 ) nspace=1 nspace=nspace-1 return end SUBROUTINE GETMEASUREDPOSRAGGED(maxvar,ivarpos,ncastnow,ncid, * ivarposnow,nlevels,identifyvar,identifytype,nvar_loc, * ivar_loc,npi_loc,nplank_loc,nvarsp,npiposnow, * npipos,nplankposnow,nplankpos) C GETMEASUREDPOSRAGGED RETRIEVES POSITION IN NETCDF FILE C FOR EACH VARIABLE TO BE READ IN (RAGGED ARRAY) dimension identifytype(maxvar),identifyvar(maxvar) dimension ivarposnow(maxvar),ivarpos(maxvar) dimension ivar_loc(maxvar) dimension index(1) include 'netcdf.inc' nlevels=0 nvar_loc=0 npi_loc=0 nplank_loc=0 index(1)=ncastnow do 55 n=1,nvarsp c row_size 7 or 8 if ( identifytype(n) .eq. 7 .or. * identifytype(n) .eq. 8 ) then instat=nf_get_var1_int(ncid,n,index,intval) ii=identifyvar(n) if ( instat .ne. 0 ) then write(6,*) 'Problem reading in rowsize:',ii,instat endif if ( intval .gt. 0 ) then if ( ii .ge. 0 ) then ivarposnow(ii)=ivarpos(ii) ivarpos(ii)=ivarpos(ii)+intval elseif ( ii .eq. -1 ) then npiposnow=npipos npipos=npipos+intval elseif ( ii .eq. -2 ) then nplankposnow=nplankpos nplankpos=nplankpos+intval endif if ( ii .gt. 0 ) then nvar_loc=nvar_loc+1 ivar_loc(nvar_loc)=ii elseif ( ii .eq. 0 ) then nlevels=intval elseif ( ii .eq. -1 ) then npi_loc=intval elseif ( ii .eq. -2 ) then nplank_loc=intval endif else ivarposnow(ii)=-1 endif endif 55 continue return end SUBROUTINE GETNCATTS(maxcatt,natttype,ncid, * lencatt,cattributeval,iattval,xattval,dattval, * maxattval,cfill, maxcfill,ifill,xfill,dfill,ihasfill, * lencfill,cvarfullname,nvarsp,maxcvar,maxlencunit, * lencvarfull,lencunit,cattname,maxvar,cunitname,iyear0, * maxatt,identifytype,identifyvar,nvaratt,bmiss,lencattval, * iquod) C GETNCATTS GETS ATTRIBUTES AND SETS UP NEEDED ATTRIBUTES C IN APPROPRIATE ARRAYS parameter (neededatt=4,maxglobal=500) character*4 time_variable character*5 depth_variable character*20 catttype(neededatt) character*240 cinput character*(maxglobal) cglobal c maxcfill characters character*(*) cfill(maxvar) c maxlencunit characters character*(*) cunitname(maxvar) c maxattval characters character*(*) cattributeval(maxvar,maxatt) c maxcvar characters character*(*) cvarfullname(maxvar) c maxcatt characters character*(*) cattname(0:maxvar,maxatt) dimension nspatttype(neededatt) dimension nvaratt(0:maxvar) dimension natttype(0:maxvar,maxatt) dimension lencatt(0:maxvar,maxatt) dimension lencattval(maxvar,maxatt) dimension lencfill(maxvar),lencvarfull(maxvar) dimension iattval(maxvar,maxatt),xattval(maxvar,maxatt) dimension dattval(maxvar,maxatt),dfill(maxvar) dimension ifill(maxvar),ihasfill(maxvar) dimension xfill(maxvar),lencunit(maxvar) dimension identifytype(maxvar),identifyvar(maxvar) double precision dattval,dfill c Necessary attributes data catttype /'units','_FillValue','standard_name', * 'long_name'/ data nspatttype /5,10,13,9/ c Special variable - get base year from units attribute data time_variable /'time'/ data nsptime_variable /4/ c Special variable - levels always set by 'depth' variable data depth_variable /'depth'/ data lendepth_variable /5/ include 'netcdf.inc' itimevariable=0 idepthvariable=0 c Check global attributes 'title' to see if this c is IQuOD or WOD type file do 30 na=1,nvaratt(0) c Get attributes for each variable nsp=lencatt(0,na) cinput(1:nsp)=cattname(0,na)(1:nsp) if ( nsp .eq. 5 .and. * cinput(1:nsp) .eq. 'title' ) then call clearstring(cglobal,maxglobal) instat=nf_get_att_text(ncid,0,cinput(1:nsp), * cglobal) if ( cglobal(1:5) .eq. 'IQuOD' ) then iquod=1 endif endif 30 continue do 40 n=1,nvarsp c Initialize needed attributes call clearstring(cvarfullname(n),maxcvar) lencvarfull(n)=0 call clearstring(cunitname(n),maxlencunit) lencunit(n)=0 call clearstring(cfill(n),maxcfill) lencfill(n)=0 ifill(n)=0 xfill(n)=bmiss dfill(n)=bmiss ihasfill(n)=0 do 45 na=1,nvaratt(n) nsp=lencatt(n,na) cinput(1:nsp)=cattname(n,na)(1:nsp) iattribute=-1 do 75 n2=1,neededatt if ( nsp .eq. nspatttype(n2) .and. cinput(1:nsp) .eq. * catttype(n2)(1:nsp) ) then iattribute=n2 endif 75 continue if ( natttype(n,na) .eq. NF_CHAR ) then call clearstring(cattributeval(n,na),maxattval) instat=nf_get_att_text(ncid,n,cinput(1:nsp), * cattributeval(n,na)) elseif ( natttype(n,na) .eq. NF_SHORT .or. * natttype(n,na) .eq. NF_INT ) then instat=nf_get_att_int(ncid,n,cinput(1:nsp), * iattval(n,na)) elseif ( natttype(n,na) .eq. NF_FLOAT ) then instat=nf_get_att_real(ncid,n,cinput(1:nsp), * xattval(n,na)) elseif ( natttype(n,na) .eq. NF_DOUBLE ) then instat=nf_get_att_double(ncid,n,cinput(1:nsp), * dattval(n,na)) endif if ( instat .eq. 0 ) then if ( natttype(n,na) .eq. NF_CHAR ) then call findlastchar(lencattval(n,na),cattributeval(n,na), * maxattval) elseif ( natttype(n,na) .eq. NF_DOUBLE ) then xattval(n,na)=dattval(n,na) endif else write(6,*) 'Attribute reading problem:',instat, * n,cinput(1:nsp) endif if ( iattribute .eq. 1 ) then cunitname(n)(1:lencattval(n,na))= * cattributeval(n,na)(1:lencattval(n,na)) lencunit(n)=lencattval(n,na) elseif ( iattribute .eq. 2 ) then c _Fill Value if ( natttype(n,na) .eq. NF_CHAR ) then cfill(n)(1:lencattval(n,na))= * cattributeval(n,na)(1:lencattval(n,na)) lencfill(n)=lencattval(n,na) elseif ( natttype(n,na) .eq. NF_SHORT .or. * natttype(n,na) .eq. NF_INT ) then ifill(n)=iattval(n,na) elseif ( natttype(n,na) .eq. NF_FLOAT ) then xfill(n)=xattval(n,na) elseif ( natttype(n,na) .eq. NF_DOUBLE ) then dfill(n)=dattval(n,na) xfill(n)=dattval(n,na) endif ihasfill(n)=1 elseif ( iattribute .eq. 3 ) then cvarfullname(n)(1:lencattval(n,na))= * cattributeval(n,na)(1:lencattval(n,na)) lencvarfull(n)=lencattval(n,na) c Check for time variable if ( lencvarfull(n) .eq. nsptime_variable .and. * cvarfullname(n)(1:lencvarfull(n)) .eq. * time_variable(1:nsptime_variable) ) then itimevariable=n c Check for depth variable elseif ( lencvarfull(n) .eq. lendepth_variable .and. * cvarfullname(n)(1:lencvarfull(n)) .eq. * depth_variable(1:lendepth_variable) ) then idepthvariable=n endif elseif ( iattribute .eq. 4 .and. lencvarfull(n) .eq. 0 ) then cvarfullname(n)(1:lencattval(n,na))= * cattributeval(n,na)(1:lencattval(n,na)) lencvarfull(n)=lencattval(n,na) endif 45 continue 40 continue c Get base year if ( itimevariable .gt. 0 ) then read(cunitname(itimevariable)(12:15),*) iyear0 endif c Depth variable is variable zero (0) the variable to which c all other profile variables are co-measured. Reset all c other variables codes accordingly (subtract 1 from all c variable sequence encountered after depth variable). if ( idepthvariable .gt. 0 ) then identifyvar(idepthvariable)=0 do 50 nn=1,nvarsp if ( identifytype(nn) .ge. 0 .and. * identifytype(nn) .le. 9 ) then if ( identifyvar(nn) .gt. identifyvar(idepthvariable) ) * identifyvar(nn)=identifyvar(nn)-1 endif 50 continue endif return end SUBROUTINE GETNCINFO(ncid,nvarsp,nvaratt,nunlimdim, * maxdim,maxvar,maxatt,ndimval,lencdim,nvartype,nvardims, * nvardimid,lencvar,natttype,nattlen,lencatt,cattname, * cdimname,cvarname,maxcdim,maxcvar,maxcatt,ndimsp) C GETNCINFO EXTRACTS INFORMATION ON DIMENSIONS C AND VARIABLES FROM NETCDF FILE parameter (maxdim_loc=50) character*(*) cdimname(maxdim) character*(*) cvarname(maxvar) character*(*) cattname(0:maxvar,maxatt) character*500 cdum dimension ndimval(maxdim),lencdim(maxdim) dimension nvaratt(0:maxvar) dimension nvartype(maxvar),nvardims(maxvar) dimension nvardimidT(maxdim_loc) dimension nvardimid(maxvar,maxdim) dimension lencvar(maxvar) dimension natttype(0:maxvar,maxatt) dimension nattlen(0:maxvar,maxatt) dimension lencatt(0:maxvar,maxatt) include 'netcdf.inc' c get number of dimensions, variables, global attributes instat=nf_inq(ncid,ndimsp,nvarsp,nvaratt(0),nunlimdim) if ( instat .ne. 0 ) then write(6,*) 'problem with nf_inq:',instat endif if ( nvarsp .gt. maxvar ) then write(6,*) 'number of variables > maxvar:',nvarsp stop endif if ( ndimsp .gt. maxdim ) then write(6,*) 'number of dimensions > maxdim:',ndimsp stop endif c write(6,*) 'number of dimensions:',ndimsp c write(6,*) 'number of variables:',nvarsp c write(6,*) 'number of global attributes:',nvaratt(0) c get dimension names, values do 30 n=1,ndimsp call clearstring(cdimname(n),maxcdim) instat=nf_inq_dim(ncid,n,cdimname(n),ndimval(n)) if ( instat .ne. 0 ) then write(6,*) 'problem with dimension:',n,instat else call findlastchar(lencdim(n),cdimname(n),maxcdim) endif c write(6,*) 'dimension name #',n,lencdim(n), c * cdimname(n)(1:lencdim(n)),maxcdim 30 continue c get variable names, values, dimensions c write(6,*) 'NFVALUES',NF_CHAR,NF_SHORT,NF_INT,NF_FLOAT, c * NF_DOUBLE do 40 n=1,nvarsp call clearstring(cvarname(n),maxcvar) instat=nf_inq_var(ncid,n,cvarname(n),nvartype(n), * nvardims(n), nvardimidT,nvaratt(n)) if ( instat .ne. 0 ) then write(6,*) 'problem with variable inq:',n,instat else do 45 nn=1,nvardims(n) 45 nvardimid(n,nn)=nvardimidT(nn) call findlastchar(lencvar(n),cvarname(n),maxcvar) endif 40 continue c get attribute names do 50 n=0,nvarsp if ( n .ne. 0 ) then nx=n else nx=NF_GLOBAL endif do 55 n2=1,nvaratt(n) call clearstring(cattname(n,n2),maxcatt) instat=nf_inq_attname(ncid,nx,n2,cattname(n,n2)) if ( instat .ne. 0 ) then write(6,*) 'problem with variable inq:',n,n2,instat else call findlastchar(lencatt(n,n2),cattname(n,n2),maxcatt) endif instat=nf_inq_att(ncid,nx,cattname(n,n2)(1:lencatt(n,n2)), * natttype(n,n2),nattlen(n,n2)) if ( instat .ne. 0 ) then write(6,*) 'problem with variable inq:',n,n2, * cattname(n,n2)(1:lencatt(n,n2)),instat endif c write(6,*) 'attribute #',n,n2,lencatt(n,n2), c * cattname(n,n2)(1:lencatt(n,n2)),maxcatt,natttype(n,n2), c * nattlen(n,n2) 55 continue 50 continue return end SUBROUTINE GETNCVARS(nvarsp,nvarobs,identifyvar,identifytype, * nvardims,nvardimid,lencdim,cdimname,lencvar,cvarname, * cvarobsname,nspvarobs,maxdim,maxvar) C GETNCVARS GETS VARIABLE CODE AND SORTS INTO CATEGORIES IN C ORDER TO BEST REPRESENT PROFILE DATA parameter (ncategory=6,nprimehead=8) parameter (notherdims=3,nrowsize=3) character*8 cplanktonsample character*15 crowsize(nrowsize) character*20 cotherdim(notherdims) character*20 ccategory(ncategory) character*20 cpiname character*30 cprimehead(nprimehead) character*(*) cvarobsname(maxvar) character*(*) cdimname(maxdim) character*(*) cvarname(maxvar) dimension nspcategory(ncategory) dimension nspprimehead(nprimehead) dimension nspotherdim(notherdims) dimension nsprowsize(nrowsize) dimension identifytype(maxvar),identifyvar(maxvar) dimension lencdim(maxdim) dimension nvardims(maxvar) dimension nvardimid(maxvar,maxdim) dimension lencvar(maxvar),nspvarobs(maxvar) c Categories: c 1 [profile variable] (has dimension [variable_name]_obs) c attribute units c attribute _FillValue c attribute standard_name c attribute long_name c 2 _sigfigs c 3 _WODflag c 4 _IQUODflag c 5 _origflag c 6 _uncertainty data ccategory /'_obs','_sigfigs','_WODflag','_IQUODflag', * '_origflag','_uncertainty'/ data nspcategory /4,8,8,10,9,12/ c Row size representations c 7 _row_size c 8 _rowsize (_row_size for primary investigators) c Other single value profile variable dependent variable c 9 _WODprofileflag data crowsize /'_row_size','_rowsize','_WODprofileflag'/ data nsprowsize /9,8,15/ data cotherdim /'casts','biosets','numberofpis'/ data nspotherdim /5,7,11/ c Primary header variables (category 10) c 1 - time (year,month,day, GMT time) c 2 - WOD_cruise_identifier c 3 - lat c 4 - lon c 5 - wod_unique_cast c 6 - country c 7 - originators_cruise_identifier c 8 - originators_station_identifier c data cprimehead /'time','WOD_cruise_identifier','lat','lon', * 'wod_unique_cast','country','originators_cruise_identifier', * 'originators_station_identifier'/ data nspprimehead /4,21,3,3,15,7,29,30/ c Primary investigator variables (variable (-1) ) data cpiname /'Primary_Investigator'/ data nspipiname /20/ c Plankton variables (variable (-2) ) data cplanktonsample /'plankton'/ data nspplankton /8/ c Number of profile variables (including depth) nvarobs=0 do 75 n=1,nvarsp c Initialize variable identifier and variable category c Categories are c profile variable or variable descriptor (1-9) c primary header (10) c primary investigator or descriptor (11)X c plankton tow or descriptor (12)X c cast secondary header (13) c variable specific second header (14) identifyvar(n)=0 identifytype(n)=0 c Dimension of profile variable will be [variable_name]_obs ivarcheck=0 len1v=0 ivarfound=0 if ( nvardims(n) .eq. 1 ) then c dimension [variable_name]_obs len2=lencdim(nvardimid(n,1)) len1=len2-3 if ( cdimname(nvardimid(n,1))(len1:len2) .eq. * ccategory(1)(1:nspcategory(1)) ) then c Assume this is the variable itself ivarcheck=1 len1v=lencvar(n) c Check if this is a variable descriptor do 35 nn=2,ncategory if ( ivarcheck .eq. 1 ) then len2=lencvar(n) len1=(len2-nspcategory(nn))+1 if ( len1 .gt. 0 .and. cvarname(n)(len1:len2) .eq. * ccategory(nn)(1:nspcategory(nn)) ) then ivarcheck=nn len1v=len1-1 endif endif 35 continue endif c or row_size/profile flag if ( ivarcheck .eq. 0 ) then do 36 nn=1,nrowsize if ( ivarcheck .eq. 0 ) then len2=lencvar(n) len1=(len2-nsprowsize(nn))+1 if ( len1 .gt. 0 .and. cvarname(n)(len1:len2) .eq. * crowsize(nn)(1:nsprowsize(nn)) ) then ivarcheck=ncategory+nn len1v=len1-1 endif endif 36 continue endif c See if profile variable has been encountered before if ( ivarcheck .gt. 0 ) then do 80 nn=1,nvarobs 80 if ( nspvarobs(nn) .eq. len1v .and. * cvarobsname(nn)(1:nspvarobs(nn)) .eq. * cvarname(n)(1:len1v) ) ivarfound=nn c Set profile variable information for reading in if ( ivarfound .eq. 0 ) then nvarobs=nvarobs+1 ivarfound=nvarobs cvarobsname(ivarfound)(1:len1v)=cvarname(n)(1:len1v) nspvarobs(ivarfound)=len1v endif identifytype(n)=ivarcheck identifyvar(n)=ivarfound c Check if this is one of two special variables (primary investigator c or plankton tow. These variables do not have c [variablename]_obs dimensions, but they do have _row_size c primary investigator is variable -1 c plankton is variable -2 if ( len1v .eq. nspipiname * .and. cvarname(n)(1:len1v) .eq. cpiname(1:nspipiname) ) then identifyvar(n)=-1 elseif ( len1v .eq. nspplankton .and. cvarname(n)(1:len1v) .eq. * cplanktonsample(1:nspplankton) ) then identifyvar(n)=-2 endif endif endif c If not a profile variable, check if this is a primary header c primary header (category 10) if ( ivarfound .eq. 0 ) then do 85 nn=1,nprimehead if ( lencvar(n) .eq. nspprimehead(nn) .and. * cvarname(n)(1:lencvar(n)) .eq. * cprimehead(nn)(1:nspprimehead(nn)) ) then ivarfound=nn identifytype(n)=10 identifyvar(n)=ivarfound endif 85 continue endif 75 continue c Check unidentified variables to see if they are c second headers, variable specific second headers, primary c investigator/descriptors, plankton do 40 n=1,nvarsp if ( identifytype(n) .eq. 0 .and. nvardims(n) .gt. 0 ) then ivarfound=0 c See if first part of name is a known variable do 60 nz=1,nvarobs 60 if ( nspvarobs(nz) .le. lencvar(n) .and. * cvarobsname(nz)(1:nspvarobs(nz)) .eq. * cvarname(n)(1:nspvarobs(nz)) ) ivarfound=nz c Determine category by dimension name do 45 nn=1,nvardims(n) lend=lencdim(nvardimid(n,nn)) do 55 n3=1,notherdims if ( lend .eq. nspotherdim(n3) .and. * cdimname(nvardimid(n,nn))(1:lend) .eq. * cotherdim(n3)(1:nspotherdim(n3)) ) then c With dimension 'casts' is second header, check if c variable specific (first part of name known variable) if ( n3 .eq. 1 ) then identifytype(n)=13 nspx=nspvarobs(ivarfound) if ( ivarfound .gt. 0 .and. lencvar(n) .gt. nspx * .and. cvarname(n)(nspx:nspx) .eq. '_' ) then identifytype(n)=14 identifyvar(n)=ivarfound endif c check if plankton variable elseif ( n3 .eq. 2 ) then identifytype(n)=12 identifyvar(n)=-2 c check if primary investigator or primary investigator descriptor c there is only one primary investigator descriptor (VAR, given c category 2) elseif ( n3 .eq. 3 ) then identifytype(n)=11 if ( ivarfound .gt. 0 .and. lencvar(n) .eq. * nspipiname ) then identifyvar(n)=1 else identifyvar(n)=2 endif endif endif 55 continue 45 continue endif 40 continue return end SUBROUTINE INITIALIZE_CAST_VARS(nsec_loc,nsp_origc, * nsp_origs,iuniq,rlat,rlon,iyear,month,iday,time, * ccruise,origs,origc,npi_loc,nplank_loc,nlevels, * maxorigc,maxorigs,maxcountry,maxccruise,nvar_loc, * ipi_loc,inplank_loc,country,nsp_country) parameter (rlatmiss=-99.999,rlonmiss=-999.999) parameter (iyearmiss=0,monthmiss=0,idaymiss=0) parameter (timemiss=-99.999) dimension ipi_loc(2) character*(*) ccruise character*(*) origc character*(*) origs character*(*) country nsec_loc=0 nsp_origc=0 nsp_origs=0 nsp_country=0 iuniq=0 rlat=rlatmiss rlon=rlonmiss iyear=iyearmiss month=monthmiss iday=idaymiss time=timemiss call clearstring(ccruise,maxccruise) call clearstring(origc,maxorigc) call clearstring(origs,maxorigs) nvar_loc=0 npi_loc=0 nplank_loc=0 nlevels=0 call clearstring(country,maxcountry) ipi_loc(1)=0 ipi_loc(2)=0 inplank_loc=0 return end SUBROUTINE INITXUNC(xunc,maxlevel,maxcalc,nvarobs,bmiss) C INITXUNC INITIALIZES UNCERTAINTY ARRAY dimension xunc(maxlevel,0:maxcalc) do 50 nn=0,nvarobs do 55 n2=1,maxlevel xunc(n2,nn)=bmiss 55 continue 50 continue return end SUBROUTINE INSERTNUM(crep,nrep0,chars,maxchar) C INSERTNUM REPLACES A GIVEN CHARACTER WITH THE C CORRESPONDING NUMBER c*************************************************** c c Passed Variables: c c crep - character to be replaced c nrep0 - number to replace character c chars - character string in which replacement will occur c maxchar - maximum number of characters in chars c c**************************************************** character*1 crep character*4 cform character*(*) chars data cform /'(iX)'/ inegative=0 nrep=nrep0 if ( nrep .lt. 0 ) then nrep=-nrep inegative=1 endif c**************************************************** c c Locate first occurance of character to be changed c c**************************************************** do 50 nn=1,maxchar if ( chars(nn:nn) .eq. crep ) then c**************************************************** c c Locate last occurance of character to be changed c c**************************************************** do 51 n2=nn+1,maxchar 51 if ( chars(n2:n2) .ne. crep ) goto 52 52 n2=n2-1 nchar=(n2-nn)+1 nten=10**(nchar-inegative) c****************************************************** c c Check that there is sufficient room to write given c number c c****************************************************** if ( nten+inegative .le. nrep ) then write(6,800) 'Given number (',nrep0, * ') is larger than space to be', * ' written to' write(6,*) 'nrep,nten,inegative ',nrep,nten,inegative 800 format(a14,i10,a28,a11) return endif nadd=0 if ( inegative .eq. 1 ) then chars(nn:nn)='-' inegative=0 nadd=1 endif c***************************************************** c c Enter necessary trailing zeros c c**************************************************** do 60 n3=2,nchar nten=nten/10 if ( nrep .lt. nten ) then chars(nn+nadd:nn+nadd)='0' nadd=nadd+1 endif 60 continue c***************************************************** c c Enter number c c***************************************************** write(cform(3:3),'(i1)') nchar-nadd write(chars(nn+nadd:nn+nchar-1),cform) nrep return endif 50 continue return end SUBROUTINE NAILUJt(iyear0,iyear,month,iday,time,xjulian) C COMPUTES CALENDAR DAY FROM JULIAN DAY, INCLUDING TIME, WITH RESPECTS C TO MIDNIGHT JANUARY 1 OF THE BASE YEAR C ADAPTED FROM ORIGINAL SUBROUTINE CREATED BY LINDA STATHOPOLIS c************************************************************* c c Passed variables c c iyear0 - base year for calculating julian day c iyear - present year c month,iday - present month,day c time - present time c xjulian - output julian day c c************************************************************ parameter (bmiss=-1E10,zdays=365.,tmiss=99.99) dimension yrnorm(13) data yrnorm/0,31,59,90,120,151,181,212,243,273,304,334,365/ if ( xjulian .le. bmiss ) then iyear=-9999 month=-99 iday=-99 return endif xadd=0. iyearadd=0 xjulian0=xjulian iyear=0 month=0 iday=0 if ( (iyear0/4)*4 .eq. iyear0 ) xadd=1. if ( (iyear0/100)*100 .eq. iyear0 .and. * (iyear0/400)*400 .ne. iyear0 ) xadd=0. xj0=xjulian ineg=0 if ( xjulian .lt. 0 ) then ineg=1 xj0=-xj0 endif if ( xj0 .ge. zdays+xadd ) then call reducejulian(iyear0,xjulian0,iyearadd) elseif (xjulian .lt. 0 ) then iyearadd=-1 endif c Set year xadd=0. iyear=iyear0+iyearadd if ( (iyear/4)*4 .eq. iyear ) xadd=1. if ( (iyear/100)*100 .eq. iyear .and. * (iyear/400)*400 .ne. iyear ) xadd=0. c Set month xj0=xjulian0 if ( ineg .eq. 1 ) xj0=xjulian0+yrnorm(13)+xadd x1=0. do 30 mm=2,13 if ( mm .eq. 3 ) x1=xadd if ( xj0 .lt. yrnorm(mm)+x1 ) then month=mm-1 goto 31 endif 30 continue 31 continue c Set day iday=xj0-yrnorm(month)+1. if ( month .ge. 3 .and. xadd .gt. 0. ) iday=iday-1 c Set time ijulian=xj0 xjuliant=ijulian time=(xj0-xjuliant)*24. return end SUBROUTINE PUTINPIARRAY_RAGGED(ipi_loc,maxpi, * cpi_loc,maxcpi,cpivar_loc,nsp_cpi,nsp_cpivar, * cvar,nspvar,identifyvar) character*(*) cpi_loc(maxpi) character*(*) cpivar_loc(maxpi) character*(*) cvar dimension nsp_cpi(maxpi),nsp_cpivar(maxpi) dimension ipi_loc(2) ipi_loc(identifyvar)=ipi_loc(identifyvar)+1 ipi=ipi_loc(identifyvar) c PI name if ( identifyvar .eq. 1 ) then cpi_loc(ipi)(1:nspvar)=cvar(1:nspvar) nsp_cpi(ipi)=nspvar elseif ( identifyvar .eq. 2 ) then cpivar_loc(ipi)(1:nspvar)=cvar(1:nspvar) nsp_cpivar(ipi)=nspvar endif return end SUBROUTINE PUTINHEADER_RAGGED(identifyvar,ismissing,iuniq, * rlat,rlon,iyear,month,iday,origc,origs,ccruise,country, * nsp_origc, nsp_origs,nsp_country,nsp_ccruise,cvar,nspvar, * intvar,xvar,dvar,iyear0,time) c Primary header variables (category 10) c 1 - time (year,month,day, GMT time) c 2 - WOD_cruise_identifier c 3 - lat c 4 - lon c 5 - wod_unique_cast c 6 - country c 7 - originators_cruise_identifier c 8 - originators_station_identifier double precision dvar character*(*) origc character*(*) origs character*(*) ccruise character*(*) country character*(*) cvar if ( ismissing .eq. 0 ) then if ( identifyvar .eq. 1 ) then call nailujt(iyear0,iyear,month,iday,time,xvar) elseif ( identifyvar .eq. 2 ) then ccruise(1:nspvar)=cvar(1:nspvar) nsp_ccruise=nspvar elseif ( identifyvar .eq. 3 ) then rlat=xvar elseif ( identifyvar .eq. 4 ) then rlon=xvar elseif ( identifyvar .eq. 5 ) then iuniq=intvar elseif ( identifyvar .eq. 6 ) then country(1:nspvar)=cvar(1:nspvar) nsp_country=nspvar elseif ( identifyvar .eq. 7 ) then origc(1:nspvar)=cvar(1:nspvar) nsp_origc=nspvar elseif ( identifyvar .eq. 8 ) then origs(1:nspvar)=cvar(1:nspvar) nsp_origs=nspvar endif endif return end SUBROUTINE PUTINPROFARRAY_RAGGED(identifyvar, * nlevels,bmiss,identifytype,depth,temp,iderror, * iorigflag,xunc,msig,ismissing,xvar,intvar, * maxlevel,maxcalc,ierror) dimension msig(maxlevel,0:maxcalc),depth(maxlevel) dimension temp(maxlevel,maxcalc),iderror(maxlevel,0:maxcalc) dimension iorigflag(maxlevel,0:maxcalc) dimension xunc(maxlevel,0:maxcalc) dimension ierror(maxlevel) c profile variable if ( identifyvar .lt. 0 ) return if ( identifytype .eq. 1 ) then if ( ismissing .eq. 0 ) then if ( identifyvar .gt. 0 ) then temp(nlevels,identifyvar)=xvar else depth(nlevels)=xvar endif else if ( identifyvar .gt. 0 ) then temp(nlevels,identifyvar)=bmiss else depth(nlevels)=bmiss endif endif c significant figure elseif ( identifytype .eq. 2 ) then if ( ismissing .eq. 0 ) then msig(nlevels,identifyvar)=intvar else msig(nlevels,identifyvar)=0 endif c qc flag elseif ( identifytype .eq. 3 .or. * identifytype .eq. 4 ) then if ( ismissing .eq. 0 ) then iderror(nlevels,identifyvar)=intvar else iderror(nlevels,identifyvar)=0 endif c originators qc flag elseif ( identifytype .eq. 5 ) then if ( ismissing .eq. 0 ) then iorigflag(nlevels,identifyvar)=intvar else iorigflag(nlevels,identifyvar)=0 endif c uncertainty elseif ( identifytype .eq. 6 ) then if ( ismissing .eq. 0 ) then xunc(nlevels,identifyvar)=xvar else xunc(nlevels,identifyvar)=bmiss endif elseif ( identifytype .eq. 9 ) then if ( ismissing .eq. 0 ) then ierror(identifyvar)=intvar else ierror(identifyvar)=0 endif endif return end SUBROUTINE PUTINSECHEADER(identifyvar,ismissing, * nsec_loc,ivarsec_loc,ivalsec_loc,xvalsec_loc, * cvalsec_loc,isectype_loc,cvar,nspvar,intvar,xvar, * nvartype,nspsec_loc,maxsec_loc,maxlensec,norder, * isecorder_loc) character*(*) cvalsec_loc(maxsec_loc) character*(*) cvar dimension ivarsec_loc(maxsec_loc),ivalsec_loc(maxsec_loc) dimension xvalsec_loc(maxsec_loc),isectype_loc(maxsec_loc) dimension nspsec_loc(maxsec_loc),isecorder_loc(maxsec_loc) include 'netcdf.inc' if ( nvartype .eq. NF_CHAR .and. * nspvar .eq. 0 ) ismissing=1 if ( ismissing .eq. 0) then nsec_loc=nsec_loc+1 ivarsec_loc(nsec_loc)=identifyvar isectype_loc(nsec_loc)=nvartype isecorder_loc(nsec_loc)=norder if ( nvartype .eq. NF_CHAR ) then call clearstring(cvalsec_loc(nsec_loc),maxlensec) cvalsec_loc(nsec_loc)(1:nspvar)=cvar(1:nspvar) nspsec_loc(nsec_loc)=nspvar elseif ( nvartype .eq. NF_INT .or. * nvartype .eq. NF_SHORT .or. * nvartype .eq. NF_BYTE ) then ivalsec_loc(nsec_loc)=intvar else xvalsec_loc(nsec_loc)=xvar endif endif return end SUBROUTINE READNCVAR(nvartype,cvar,nspvar,maxcvar, * ncid,ivarid,index,nindex,indexcount,nindexcount, * intvar,dvar, xvar,instat,imiss,bmiss) C READNCVAR READS IN NETCDF VARIABLE BASED C ON INPUT PARAMETERS character*(*) cvar dimension index(nindex),indexcount(nindexcount) double precision dvar include 'netcdf.inc' xvar=bmiss dvar=bmiss intvar=imiss c write(6,*) 'nvartu[',nvartype if ( nvartype .eq. NF_CHAR ) then call clearstring(cvar,maxcvar) instat= nf_get_vara_text(ncid,ivarid,index, * indexcount,cvar) call findlastchar(nspvar,cvar,maxcvar) elseif ( nvartype .eq. NF_INT ) then instat= * nf_get_var1_int(ncid,ivarid,index,intvar) elseif ( nvartype .eq. NF_SHORT ) then instat= * nf_get_var1_int(ncid,ivarid,index,intvar) elseif ( nvartype .eq. NF_BYTE ) then instat= * nf_get_var1_int(ncid,ivarid,index,intvar) elseif ( nvartype .eq. NF_DOUBLE ) then instat= * nf_get_var1_double(ncid,ivarid,index,dvar) xvar=dvar elseif ( nvartype .eq. NF_FLOAT ) then instat= * nf_get_var1_real(ncid,ivarid,index,xvar) c write(6,*) 'var1',ivarid,index(1),xvar else write(6,*) 'Unknown var type:',ivarid,nvartype endif return end SUBROUTINE REDUCEJULIAN(iyear,rjul,iyearadd) C REDUCEJULIAN REDUCES A MULTIYEAR JULIAN DATE TO C YEAR AND SINGLE YEAR JULIAN DATE parameter (xdays=366.) iyearx=iyear ineg=0 if ( rjul .lt. 0. ) then ineg=1 iyearx=iyearx-1 endif do 500 nz=1,300 xsub=1. if ( (iyearx/4)*4 .eq. iyearx) xsub=0. if ( (iyearx/100)*100 .eq. iyearx .and. * (iyearx/400)*400 .ne. iyearx ) xsub=1. if ( ineg .eq. 0 ) then if ( rjul .ge. xdays-xsub ) then iyearx=iyearx+1 rjul=rjul-(xdays-xsub) else goto 450 endif else if ( -rjul .ge. xdays-xsub ) then iyearx=iyearx-1 rjul=rjul+(xdays-xsub) else goto 450 endif endif 500 continue 450 continue iyearadd=iyearx-iyear return end PROGRAM WOD_nc c This program prints out to the screen data from WOD ragged array c netCDF file to the screen. c c Comments and suggestions for improving this program would be appreciated. c Updates to the World Ocean Data data and to this program will be posted c in the NCEI/WOD web site at http://www.nodc.noaa.gov c*********************************************************** c c Parameters (constants): c c maxlevel - maximum number of depth levels in a single cast c maxcalc - maximum number of measured and calculated c depth dependent variables c maxpi - maximum number of primary investigators c associated with a single cast c bmiss, imiss - real and integer default missing value markers c maxsec_loc - maximum number of secondary headers in a c single cast c maxcpi,maxcountry,maxorigc,maxorigs,maxxcruise, c maxcdim,maxcvar,maxcatt,maxlensec - maximum character c lengths for respective character arrays c maxdim - maximum number of dimensions in netcdf file c maxvar - maximum number of variables in netcdf file c maxatt - maximum number of attributes for a single c variable in netcdf file c c****************************************************************** parameter (maxlevel=30000, maxcalc=100) parameter (bmiss=-1.E10,imiss=-99999) parameter (maxlencunit=100) parameter (maxpi=25,maxcpi=240) parameter (maxsec_loc=400) parameter (maxcountry=240,maxorigc=17,maxorigs=17) parameter (maxccruise=10) parameter (maxdim=50,maxvar=300,maxatt=100) parameter (maxcdim=200,maxcvar=300,maxcatt=200) parameter (maxcfill=300,maxattval=500) parameter (maxlensec=200) c****************************************************************** c c Character Arrays: c c filename - input netcdf file name c cdimname - name for each netcdf dimension c cvarname - name for each netcdf variable c cvarobsname - specific oceanograpic variable portion of c netcdf variable names (e.g. 'Temperature' c in 'Temperature_sigfigs') c cattname - name for each netcdf attribute c cvar - individual character variable read from netcdf file c cfill - fill value for each netcdf character variable c cattributeval - character value for netcdf attributes c country - country of origin of oceanographic cast c origc - originators cruise identifier c origs - originators station identifier c ccruise - WOD cruise identifier c cpi_loc - primary investigator (PI) name(s) for individual cast c cpivar_loc - variable(s) for which PI was responsible c cunitname - units for each netcdf variable c cvalsec_loc - secondary header character values for individual cast c c***************************************************************** character*240 filename character*(maxcdim) cdimname(maxdim) character*(maxcvar) cvarname(maxvar),cvar,cvarobsname(maxvar) character*(maxcfill) cfill(maxvar) character*(maxcatt) cattname(0:maxvar,maxatt) character*(maxcvar) cvarfullname(maxvar) character*(maxattval) cattributeval(maxvar,maxatt) character*(maxcountry) country character*(maxorigc) origc character*(maxorigs) origs character*(maxccruise) ccruise character*(maxcpi) cpi_loc(maxpi),cpivar_loc(maxpi) character*(maxlencunit) cunitname(maxvar) character*(maxlensec) cvalsec_loc(maxsec_loc) c****************************************************************** c c Arrays: c c ierror() - whole profile error codes for each variable c c ipi_loc() - individual cast counts of primary investigators information c 1. primary investigator names c 2. variables for which PI was responsible c c depth() - depth of each measurement c c msig() - number of significant figures in each measured variable at c each level of measurement c c temp() - variable data at each depth level c iderror() - error flags for each variable at each depth level c xunc() - uncertainties for each measurement c iorigflag()- originators flags for each variable and depth c c ndimval() - value of each netcdf dimension c lencdim() - length of character string for each netcdf dimension c (associated with cdimname) c nvaratt() - number of attributes for each netcdf variable c nvartype() - type (character, integer, real, double) of c each netcdf variable c nvardims() - number of dimensions in each netcdf variable c nvardimid() - netcdf identifier for each dimension within c each netcdf variable c lencvar() - character length of each netcdf character variable c (associated with cvarname) c natttype() - type (character, integer, real, double) of c each netcdf attribute c nattlen() - character length of each netcdf attribute value c (associated with cattval - note that this c array is filled in getncinfo. It appears to c contain duplicate information to lencattval, c which is filled in getncatts by counting c characters. One of these, probably lencattval c should be replaced.) c lencatt() - character length for each netcdf attribute name c (associated with cattname) c lencattval() - (see nattlen note above) c lencunit() - length of character string for unit value for c each netcdf variable c c c******************************************************************* dimension ierror(maxlevel) dimension depth(maxlevel) dimension msig(maxlevel,0:maxcalc) dimension temp(maxlevel,maxcalc),iderror(maxlevel,0:maxcalc) dimension xunc(maxlevel,0:maxcalc) dimension iorigflag(maxlevel,0:maxcalc) dimension ndimval(maxdim),lencdim(maxdim) dimension nvaratt(0:maxvar) dimension nvartype(maxvar),nvardims(maxvar) dimension nvardimid(maxvar,maxdim) dimension lencvar(maxvar),lencvarfull(maxvar) dimension natttype(0:maxvar,maxatt) dimension nattlen(0:maxvar,maxatt) dimension lencatt(0:maxvar,maxatt) dimension lencattval(maxvar,maxatt) dimension lencunit(maxvar) c lencfill() - length of character fill value for netcdf variables c iattval() - integer value for netcdf attributes c xattval() - real value for netcdf attributes c dattval() - double precision value for netcdf attributes (no c known values in WOD) c dfill() - fill value for double precision netcdf variables c (only 'time' variable in WOD, which has no missing values) c identifytype() - category for each netcdf variable c 1 [profile variable] (has dimension [variable_name]_obs) c attribute units c attribute _FillValue c attribute standard_name c attribute long_name c 2 _sigfigs c 3 _WODflag c 4 _IQUODflag c 5 _origflag c 6 _uncertainty c 7 _row_size c 8 _rowsize (_row_size for primary investigators) c Other single value profile variable dependent variable c 9 _WODprofileflag c 10 primary header c 11 primary investigators c 12 plankton information c 13 secondary header c 14 variable specific secondary header c c identifyvar() - sequential order of profile measured c variables as listed in netcdf file c nspvarobs - character length of each short variable name c (name of oceanographic profile variable in netcdf c variable name - 'Temperature' in 'Temperature_row_size' c associated with cvarobsname) c ivar_loc() - sequential order number of oceanographic profile c variables (see identifyvar()) in an individual cast c ivarpos() - position of oceanographic variable information c for the present cast within the netcdf variable c array (0 if no measurements of particular variable c in the present cast). c ivarposnow() - cumulative position of oceanographic variable information c for last measurement of last cast with measurements of the c particular oceanographic variable in the netcdf variable array c (holder of cumulative information, even when present cast has c zero row size - no measurements for cast). c index(),indexcount() - indices for reading in netcdf values from c given variable c ifill() - integer fill value for each netcdf variable c xfill() - real fill value for each netcdf variable c nsp_cpi() - character length for primary investigator names c (associated with cpi_loc) c nsp_cpivar() - character length for variables for which primary c investigator is responsible (associated with cpivar_loc) c ihasfill() - set to 1 if the netcdf variable has a fill (missing) c value c ipi_loc - local counter of number of primary investigators and c number of variables responsible for read in for c current cast c ivarsec_loc - sequential variable associated with each secondary c header (zero if not variable specific) c ivalsec_loc - secondary header integer value c xvalsec_loc - secondary header real value c isectype_loc() - type (character, integer, real) for each c secondary header value c nspsec_loc() - character length for each secondary header c character value (associated with cvarsec_loc) dimension lencfill(maxvar) dimension iattval(maxvar,maxatt),xattval(maxvar,maxatt) dimension dattval(maxvar,maxatt),dfill(maxvar) dimension identifytype(maxvar),identifyvar(maxvar) dimension nspvarobs(maxvar) dimension ivar_loc(maxvar),ivarpos(maxvar),ivarposnow(maxvar) dimension index(2),indexcount(2) dimension ifill(maxvar),xfill(maxvar) dimension ihasfill(maxvar) dimension nsp_cpi(maxpi), nsp_cpivar(maxpi) dimension ipi_loc(2) dimension ivarsec_loc(maxsec_loc),ivalsec_loc(maxsec_loc) dimension xvalsec_loc(maxsec_loc),isectype_loc(maxsec_loc) dimension nspsec_loc(maxsec_loc),isecorder_loc(maxsec_loc) double precision dattval,dfill include 'netcdf.inc' iquod=0 c************************************************************* c c Initialize variables which keep track of positions within c variable arrays for current cast (npipos for primary c investigators, nplankpos for plankton tow sets). c c************************************************************* npiposnow=0 npipos=0 nplankposnow=0 nplankpos=0 call arrayinit(ivarpos,1,maxvar) call arrayinit(ivarposnow,1,maxvar) c************************************************************** c c Get user input file name from which casts will be c taken. Open this file. c c************************************************************** c User can modify the next section to read from a text file listing c different input data files as a do-loop, for example, as opposed c a single data input file. write(6,*)' ' write(6,*)'Input File Name:' read(5,'(a80)') filename write(6,*)' ' write(6,*)' ' instat=nf_open(filename,NF_NOWRITE,ncid) c Extract all dimension, variable, and attribute information c from netcdf file. c nvarsp - number of netcdf variables in file c nvaratt - number of attributes for each netcdf variable in file c nunlimdim - number of unlimited dimensions in netcdf file c (none for WOD) c ndimsp - number of dimensions in netcdf file call getncinfo(ncid,nvarsp,nvaratt,nunlimdim, * maxdim,maxvar,maxatt,ndimval,lencdim,nvartype,nvardims, * nvardimid,lencvar,natttype,nattlen,lencatt,cattname, * cdimname,cvarname,maxcdim,maxcvar,maxcatt,ndimsp) c Sort netcdf variable information into categories: c 1 profile variable (has dimension [variable_name]_obs) c 2 significant figures c 3 WOD qc flag c 4 IQuOD qc flag c 5 originators qc flag c 6 uncertainty (IQuOD) c 7 row size c 8 row size (primary investigators) c 9 WOD profile qc flag c 10 primary header c 11 primary investigator information c 12 plankton tow information c 13 secondary header c 14 variable specific secondary header c c nvarobs - number of ocean profile variables in file call getncvars(nvarsp,nvarobs,identifyvar,identifytype, * nvardims,nvardimid,lencdim,cdimname,lencvar,cvarname, * cvarobsname,nspvarobs,maxdim,maxvar) c Get attribute information c Main attributes: c attribute units c attribute _FillValue c attribute standard_name c attribute long_name c c Also look to global attributes to see if this is an c IQuOD (1) or WOD (0) file (iquod variable) c c Also find the 'depth' standard name. This variable c is the variable to which all oceanographic profile c variables are associated. call getncatts(maxcatt,natttype,ncid, * lencatt,cattributeval,iattval,xattval,dattval, * maxattval,cfill, maxcfill,ifill,xfill,dfill,ihasfill, * lencfill,cvarfullname,nvarsp,maxcvar,maxlencunit, * lencvarfull,lencunit,cattname,maxvar,cunitname,iyear0, * maxatt,identifytype,identifyvar,nvaratt,bmiss, * lencattval,iquod) c initialize uncertainty for iquod. Not all variables will have c uncertainties attached (only temperature, salinity, depth/press) call initxunc(xunc,maxlevel,maxcalc,nvarobs,bmiss) c Get number of casts dimensions do 25 nd=1,ndimsp 25 if ( lencdim(nd) .eq. 5 .and. cdimname(nd)(1:lencdim(nd)) * .eq. 'casts' ) ncasts=ndimval(nd) c Write out relevant whole file information: c Variable sequential order (write out of each cast will c refer to this sequential order when writing out c variables measured in that cast), variable full c name (either standard or long), short name (name consistent c in array naming) and units. call writewodfileinfo(iquod,nvarsp,identifytype, * identifyvar,lencvarfull,cvarfullname,lencvar, * cvarname,lencunit,cunitname,maxvar,ncasts) write(6,*) * 'Enter number of casts to view (0=view entire file)' read(5,*) numcasts if ( numcasts .eq. 0 ) numcasts=ncasts do 50 ncastnow=1,numcasts !- MAIN CAST LOOP c Initialize all necessary variables for next cast c nsec_loc - number of secondary headers in this cast c nsp_origc - character length for originators cruise c identifier (origc, zero if not available for cast) c iuniq - WOD unique cast number c rlat,rlon - position of cast c iyear,month,iday,time - derived from netcdf 'time' c variable c ccruise - WOD cruise identifier c npi_loc - number of primary investigators for cast c nplank_loc - number of plankton groups for cast c nlevels - number of depth levels for cast. Each c present oceanographic variable will have the same c number of levels as depth (or 0 if not measured c in this cast. c maxorigc,maxorgs,maxcountry,maxccruise - maximum c character lengths for character variables (used c to initialize character variables c nvar_loc - number of variables in the present cast c ipi_loc - number of primary investigators and c variables responsible for in this cast c inplank_loc - number of plankton sets read in for c this cast c nsp_country - character length for country call initialize_cast_vars(nsec_loc,nsp_origc, * nsp_origs,iuniq,rlat,rlon,iyear,month,iday,time, * ccruise,origs,origc,npi_loc,nplank_loc,nlevels, * maxorigc,maxorigs,maxcountry,maxccruise,nvar_loc, * ipi_loc,inplank_loc,country,nsp_country) c Get position in arrays for this cast for each profile c variable (+primary investigator, plankton) c ivarpos will either be zero (variable not measured in c this cast or the cumulative row sizes for all casts c sequentially before the present cast in the netcdf file. call getmeasuredposragged(maxvar,ivarpos,ncastnow,ncid, * ivarposnow,nlevels,identifyvar,identifytype,nvar_loc, * ivar_loc,npi_loc,nplank_loc,nvarsp,npiposnow, * npipos,nplankposnow,nplankpos) c Read in each variable for this cast do 55 nx=1,nvarsp c For profile variables (+ primary investigators, plantkon) c read multiple levels per cast, otherwise one nlend=1 if ( identifytype(nx) .ge. 1 .and. * identifytype(nx) .le. 6 ) then nlend=nlevels elseif ( identifytype(nx) .eq. 11 ) then nlend=npi_loc elseif ( identifytype(nx) .eq. 12 ) then nlend=nplank_loc endif ivarx=identifyvar(nx) do 60 nl=1,nlend c row size has already been used (in measuredposragged) c dont read again if ( identifytype(nx) .eq. 7 .or. * identifytype(nx) .eq. 8 ) goto 60 c Set index values to read in netcdf variable instance c based on variable category index(1)=ncastnow indexcount(1)=1 nindex=1 nindexcount=1 if ( identifytype(nx) .gt. 0 .and. * identifytype(nx) .le. 6 ) then index(1)=ivarposnow(ivarx)+nl nindex=1 nindexcount=1 elseif ( identifytype(nx) .eq. 11 .or. * identifytype(nx) .eq. 12 ) then if ( identifytype(nx) .eq. 11 ) then index(2)=npiposnow+nl else index(2)=nplankposnow+nl endif index(1)=1 indexcount(2)=1 indexcount(1)=ndimval(nvardimid(nx,1)) nindexcount=2 nindex=2 elseif ( nvartype(nx) .eq. NF_CHAR ) then index(2)=ncastnow index(1)=1 indexcount(2)=1 indexcount(1)=ndimval(nvardimid(nx,1)) nindexcount=2 nindex=2 endif c Read in netcdf variable. Depending on type (nvartype) c variable will be read in to cvar (character, with nspvar c as character length), intvar (integer), xvar (real) or c dvar (double precision, also read in to xvar) call readncvar(nvartype(nx),cvar,nspvar,maxcvar, * ncid,nx,index,nindex,indexcount,nindexcount,intvar, * dvar,xvar,instat,imiss,bmiss) c Check if the value read in is a missing value (ismissing=1) call check_missing(nvartype(nx),cvar,nspvar, * intvar,dvar,xvar,cfill(nx),ifill(nx),xfill(nx),dfill(nx), * ihasfill(nx),lencfill(nx),ismissing) c Put profile variable/associated fields in proper array if ( identifytype(nx) .gt. 0 .and. * identifytype(nx) .le. 9 ) then call putinprofarray_ragged(identifyvar(nx), * nl,bmiss,identifytype(nx),depth,temp,iderror, * iorigflag,xunc,msig,ismissing,xvar,intvar, * maxlevel,maxcalc,ierror) c Put primary investigators information in local variables elseif ( identifytype(nx) .eq. 11 ) then call putinPIarray_ragged(ipi_loc,maxpi,cpi_loc, * maxcpi,cpivar_loc,nsp_cpi,nsp_cpivar,cvar, * nspvar,identifyvar(nx)) c Put plankton tow information in local variables elseif ( identifytype(nx) .eq. 12 ) then c call putinplankarray_ragged() c Put header information in local variables elseif ( identifytype(nx) .eq. 10 ) then call putinheader_ragged(identifyvar(nx),ismissing,iuniq, * rlat,rlon,iyear,month,iday,origc,origs,ccruise,country, * nsp_origc,nsp_origs,nsp_country,nsp_ccruise,cvar,nspvar, * intvar,xvar,dvar,iyear0,time) c Put secondary headers in local variables elseif ( identifytype(nx) .eq. 13 .or. * identifytype(nx) .eq. 14 ) then call putinsecheader(identifyvar(nx),ismissing, * nsec_loc,ivarsec_loc,ivalsec_loc,xvalsec_loc, * cvalsec_loc,isectype_loc,cvar,nspvar,intvar,xvar, * nvartype(nx),nspsec_loc,maxsec_loc,maxlensec,nx, * isecorder_loc) endif 60 continue 55 continue c Write out all cast information to screen c Note rlonunc and rlatunc are planned for iquod, but c not presently available so their values are set to missing. rlatunc=bmiss rlonunc=bmiss call writewodtoscreen(ncastnow,iquod,nlevels,ccruise,rlat, * rlatunc,rlon,rlonunc,iyear,month,iday,time,iuniq,nvar_loc, * origc,origs,nsp_origc,nsp_origs,npi_loc,depth,iderror, * iorigflag,temp,msig,xunc,ierror,isecorder_loc, * isectype_loc,cvarname,lencvar,cvalsec_loc,nspsec_loc, * ivalsec_loc,xvalsec_loc,maxsec_loc,maxvar, * ivar_loc,maxlevel,maxcalc,nsec_loc,cpi_loc,cpivar_loc, * nsp_cpi,nsp_cpivar,maxpi) 50 continue !- End of MAIN LOOP 4 continue !- EXIT stop end SUBROUTINE WRITEWODFILEINFO(iquod,nvarsp,identifytype, * identifyvar,lencvarfull,cvarfullname,lencvar, * cvarname,lencunit,cunitname,maxvar,ncasts) C WRITEWODFILEINFO WRITES TO SCREEN INFORMATION ABOUT WHAT C VARIABLES ARE FOUND IN THE CHOSEN FILE character*(*) cvarfullname(maxvar) character*(*) cunitname(maxvar) character*(*) cvarname(maxvar) dimension lencunit(maxvar) dimension lencvar(maxvar) dimension lencvarfull(maxvar) dimension identifytype(maxvar) dimension identifyvar(maxvar) if ( iquod .eq. 0 ) then write(6,*) 'World Ocean Database (WOD) file' else write(6,*) 'International Quality Controlled', * ' Oceanographic Database (IQuOD) file' endif write(6,*) ' ' write(6,*) 'Number of casts in file:',ncasts write(6,*) ' ' write(6,*) 'Variables in file:' do 50 n=1,nvarsp if ( identifytype(n) .eq. 1 ) then write(6,*) 'Variable #',identifyvar(n) write(6,*) 'Name:',cvarfullname(n)(1:lencvarfull(n)) write(6,*) 'Short name:',cvarname(n)(1:lencvar(n)) if ( lencunit(n) .gt. 0 ) then write(6,*) 'Units:',cunitname(n)(1:lencunit(n)) endif write(6,*) ' ' endif 50 continue return end SUBROUTINE WRITEWODTOSCREEN(ncastnow,iquod,nlevels,ccruise,rlat, * rlatunc,rlon,rlonunc,iyear,month,iday,time,iuniq,nvar_loc, * origc,origs,nsp_origc,nsp_origs,npi_loc,depth,iderror, * iorigflag,temp,msig,xunc,ierror,isecorder_loc, * isectype_loc,cvarname,lencvar,cvalsec_loc,nspsec_loc, * ivalsec_loc,xvalsec_loc,maxsec_loc,maxvar, * ivar_loc,maxlevel,maxcalc,nsec_loc,cpi_loc,cpivar_loc, * nsp_cpi,nsp_cpivar,maxpi) character*(*) ccruise character*(*) origc character*(*) origs character*(*) cvarname(maxvar) character*(*) cvalsec_loc(maxsec_loc) character*(*) cpi_loc(maxpi) character*(*) cpivar_loc(maxpi) character*14 cform803 character*16 cform903 character*16 cform1003 character*26 cform8031 character*28 cform9031 character*28 cform10031 character*28 cformout dimension isecorder_loc(maxsec_loc),isectype_loc(maxsec_loc) dimension nspsec_loc(maxsec_loc) dimension ivalsec_loc(maxsec_loc) dimension xvalsec_loc(maxsec_loc) dimension lencvar(maxvar) dimension ierror(maxlevel) dimension depth(maxlevel) dimension msig(maxlevel,0:maxcalc) dimension temp(maxlevel,maxcalc),iderror(maxlevel,0:maxcalc) dimension xunc(maxlevel,0:maxcalc) dimension iorigflag(maxlevel,0:maxcalc) dimension ivar_loc(maxvar) dimension nsp_cpi(maxpi),nsp_cpivar(maxpi) include 'netcdf.inc' cform803='(aXXX,": ",i8)' cform903='(aXXX,": ",f8.3)' cform1003='(aXXX,": ",aYYY)' c************************************************************** c c WRITE HEADER INFORMATION TO THE SCREEN c -------------------------------------- c c cruise_ID - country code (2 bytes)+WOD cruise identifier (i8) c rlat - latitude (f7.3) c rlon - longitude (f8.3) c iyear - year (i4) c month - month (i2) c iday - day (i2) c time - time (GMT) (f7.2) c ij - WOD cast identifier (i8) c levels - number of depth levels measured (i6) c c************************************************************** 800 format(1x,a10,1x,f7.3,1x,f8.3,1x,i4,1x,i2,1x,i2, & 1x,f7.2,1x,i8,1x,i6) 8000 format(1x,a10,1x,f7.3,1x,f6.3,1x,f8.3,1x,f6.3,1x, & i4,1x,i2,1x,i2,1x,f7.2,1x,i8,1x,i6) write(6,*) &'----------------------------------------------------------' write(6,*) 'Output from netCDF ragged array file, cast# ', & ncastnow write(6,*) &'----------------------------------------------------------' write(6,*)' ' if ( iquod .eq. 0 ) then write(6,*) & 'Cruise_ID Latitde Longitde YYYY MM DD Time'// & ' Cast #levels' write(6,800) ccruise,rlat,rlon,iyear,month,iday, & time,iuniq,nlevels else write(6,*) &'Cruise_ID Latitde latunc Longitd longunc YYYY MM DD'// &' Time Cast #levels' write(6,8000) ccruise,rlat,rlatunc,rlon,rlonunc, & iyear,month,iday,time,iuniq,nlevels endif write(6,*) ' ' write(6,*) 'Number of variables in this cast: ',nvar_loc 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 ( nsp_origc .gt. 0 ) then write(6,'(a)') 'Originators Cruise Code: ',origc(1:nsp_origc) endif if ( nsp_origs .gt. 0 ) then write(6,'(a)') 'Originators Station Code: ',origs(1:nsp_origs) 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_loc write(6,'(a)') 'Primary Investigator: ', * cpi_loc(n)(1:nsp_cpi(n)) write(6,'(a)') ' for variable: ', * cpivar_loc(n)(1:nsp_cpivar(n)) 505 continue if ( npi_loc .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 code will be defined after profile c c Note: If "nvar = 0", biology only cast. c c************************************************************** c format(5x,1a,5x,10(3x,i2,11x)) 801 format(5x,"z fo",4x,10(i2,8x,"fo",3x)) 851 format(5x,"z U",5x,"fo",4x,10(i2,7x,"U",10x,"fo",3x)) if (nvar .gt. 0) then if ( iquod .eq. 0 ) then write(6,801) (ivar_loc(n),n=1,nvar_loc) else write(6,851) (ivar_loc(n),n=1,nvar_loc) endif 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_loc)), and error flags for each c variables (iderror(n,1..nvar_loc)) c c************************************************************** 802 format(f7.1,1x,i1,i1,14(f9.3,' (',i1,') ',i1,i1)) 852 format(f7.1,1x,'[',f6.3,']',1x,i1,i1,14(f9.3, * ' [',f6.3,'] ',' (',i1,') ',i1,i1)) do 80 n=1,nlevels if ( iquod .eq. 0 ) then write(6,802) depth(n),iderror(n,0),iorigflag(n,0), & (temp(n,ivar_loc(j)),msig(n,ivar_loc(j)), & iderror(n,ivar_loc(j)),iorigflag(n,ivar_loc(j)), & j=1,nvar_loc) else write(6,852) depth(n),xunc(n,0),iderror(n,0), & iorigflag(n,0), & (temp(n,ivar_loc(j)),xunc(n,ivar_loc(j)), & msig(n,ivar_loc(j)),iderror(n,ivar_loc(j)), & iorigflag(n,ivar_loc(j)),j=1,nvar_loc) endif 80 continue write(6,*) ' ' c*************************************************************** c c PRINT ENTIRE-PROFILE ERROR FLAGS c ------------------------------------ c c*************************************************************** 8021 format('VarFlag: ',11x,11(i1,14x)) write(6,8021)(ierror(ivar_loc(j)),j=1,nvar_loc) write(6,*) ' ' endif !- "if (nvar_loc .gt. 0) then" c*************************************************************** c c PRINT SECONDARY HEADERS c ----------------------- c c*************************************************************** do 85 n=1,nsec_loc call clearstring(cformout,28) nx=isecorder_loc(n) if (isectype_loc(n) .eq. NF_CHAR ) then cformout=cform1003 call insertnum('X',lencvar(nx),cformout,28) call insertnum('Y',nspsec_loc(n),cformout,28) write(6,cformout) cvarname(nx)(1:lencvar(nx)), * cvalsec_loc(n)(1:nspsec_loc(n)) elseif ( isectype_loc(n) .eq. NF_INT .or. * isectype_loc(n) .eq. NF_SHORT .or. * isectype_loc(n) .eq. NF_BYTE ) then cformout=cform803 call insertnum('X',lencvar(nx),cformout,28) write(6,cformout) cvarname(nx)(1:lencvar(nx)), * ivalsec_loc(n) else cformout=cform903 call insertnum('X',lencvar(nx),cformout,28) write(6,cformout) cvarname(nx)(1:lencvar(nx)), * xvalsec_loc(n) endif 85 continue return end