subroutine writehydro c c======================================================================= c === c This subroutine writes out the header information (ascii) for === c the hydrographic data. === c === c======================================================================= c c----------------------------------------------------------------------- c Define global data. c----------------------------------------------------------------------- c #include #include #include c c----------------------------------------------------------------------- c Define local data. c----------------------------------------------------------------------- c integer iday,iyday,iunit,iyear,lenstr,m,month,n integer lnblk,no_digit character*8 tchar character*11 dchar character*44 date_str character*80 fmt,text1,text2 c c======================================================================= c Write header information. ========================================= c======================================================================= c entry wrt_header (iunit) c c Title. c nhdr=1 call wrtstr(header(nhdr),' title = ',htitle) c c Number of stations or casts. c write (fmt,5) no_digit(nhobs) 5 format ('(i',i2,')') write(text1,fmt) nhobs nhdr=nhdr+1 call wrtstr(header(nhdr),' stations = ',text1) c c Starting and ending time. c call caldate(hstrday,dchar,tchar,iday,month,iyear,iyday) write(text1,10) hstrday,dchar,tchar 10 format(f11.4,', ',a,1x,a) nhdr=nhdr+1 call wrtstr(header(nhdr),' str_time = ',text1) c call caldate(hendday,dchar,tchar,iday,month,iyear,iyday) write(text1,10) hendday,dchar,tchar nhdr=nhdr+1 call wrtstr(header(nhdr),' end_time = ',text1) c c Julian day offset c write(text1,15) jdayoff 15 format(i10) nhdr=nhdr+1 call wrtstr(header(nhdr),' Jday_offset = ',text1) c c Longitude range. c write(text1,20) hlng_min 20 format(f9.4) nhdr=nhdr+1 call wrtstr(header(nhdr),' lng_min = ',text1) c write(text1,20) hlng_max nhdr=nhdr+1 call wrtstr(header(nhdr),' lng_max = ',text1) c c Latitude range. c write(text1,30) hlat_min 30 format(f8.4) nhdr=nhdr+1 call wrtstr(header(nhdr),' lat_min = ',text1) c write(text1,30) hlat_max nhdr=nhdr+1 call wrtstr(header(nhdr),' lat_max = ',text1) c c Format. c nhdr=nhdr+1 call wrtstr(header(nhdr),' format = ', * 'ascii, record interleaving') c c Instrument type. c lhfield(1)=.true. c text1 = ' ' if(axbt) then lhfield(2)=.true. lhfield(3)=.false. lenstr=lnblk(text1,len(text1)) text1=text1(1:lenstr)//' AXBT,' endif if(xbt) then lhfield(2)=.true. lhfield(3)=.false. lenstr=lnblk(text1,len(text1)) text1=text1(1:lenstr)//' XBT,' endif if(xbts) then lhfield(2)=.true. lhfield(3)=.true. lenstr=lnblk(text1,len(text1)) text1=text1(1:lenstr)//' XBTS,' endif if(ctd) then lhfield(2)=.true. lhfield(3)=.true. lenstr=lnblk(text1,len(text1)) text1=text1(1:lenstr)//' CTD,' endif if(xctd) then lhfield(2)=.true. lhfield(3)=.true. lenstr=lnblk(text1,len(text1)) text1=text1(1:lenstr)//' XCTD,' endif if(cm) then lhfield(4)=.true. lhfield(5)=.true. lenstr=lnblk(text1,len(text1)) text1=text1(1:lenstr)//' CM,' endif nhdr=nhdr+1 call wrtstr(header(nhdr),' type = ',text1) c c Fields and units. c text1 = ' ' text2 = ' ' if(lhfield(1)) then lenstr=lnblk(text1,len(text1)) text1=text1(1:lenstr)//' depth,' lenstr=lnblk(text2,len(text2)) text2=text2(1:lenstr)//' meter,' endif if(lhfield(2)) then lenstr=lnblk(text1,len(text1)) text1=text1(1:lenstr)//' temperature,' lenstr=lnblk(text2,len(text2)) text2=text2(1:lenstr)//' Celsius,' endif if(lhfield(3)) then lenstr=lnblk(text1,len(text1)) text1=text1(1:lenstr)//' salinity,' lenstr=lnblk(text2,len(text2)) text2=text2(1:lenstr)//' PSU,' endif if(lhfield(4)) then lenstr=lnblk(text1,len(text1)) text1=text1(1:lenstr)//' zonal velocity,' lenstr=lnblk(text2,len(text2)) text2=text2(1:lenstr)//' centimeter second-1,' endif if(lhfield(5)) then lenstr=lnblk(text1,len(text1)) text1=text1(1:lenstr)//' meridional velocity,' lenstr=lnblk(text2,len(text2)) text2=text2(1:lenstr)//' centimeter second-1,' endif nhdr=nhdr+1 call wrtstr(header(nhdr),' fields = ',text1) nhdr=nhdr+1 call wrtstr(header(nhdr),' units = ',text2) c c Creation date. c call get_date (date_str) nhdr=nhdr+1 call wrtstr(header(nhdr),' creation_date = ',date_str) c c End-of-header. c nhdr=nhdr+1 write(header(nhdr),40) 40 format('END') c c----------------------------------------------------------------------- c Write out header. c----------------------------------------------------------------------- c do 60 n=1,nhdr lenstr=lnblk(header(n),len(header(n))) write(iunit,50) header(n)(1:lenstr) 50 format(a) 60 continue c #ifdef sunflush c Flush output buffers. c call flush(iunit) c #endif return c c entry wrt_hydro (iunit) c c======================================================================= c === c This routine writes hydrographic data into output file. The data === c format is the adopted ascii format. === c === c======================================================================= c c Set some record header parameters. c if(ctd) then htype='''CTD: z t s''' elseif(xctd) then htype='''XCTD: z t s''' elseif(xbt) then htype='''XBT: z t''' elseif(xbts) then htype='''XBTS: z t s''' elseif(axbt) then htype='''AXBT: z t''' elseif(cm) then htype='''CM: z u v''' endif lenstr=lnblk(htype,len(htype)) c c Write information header. c write (fmt,900) nhvar write (iunit,fmt) nhvar,nhpts,castid,hlng,hlat,hdpth,htime, & (hscle(n),n=1,nhvar) write (iunit,901) hflag,htype(1:lenstr) c c Scale and write out hydrographic data. Data is scaled to integer c to compact output file. c do 70 n=1,nhpts ihdat(n)=nint(hdat(n,1)/hscle(1)) 70 continue write(iunit,902) (ihdat(n),n=1,nhpts) if(ctd.or.xctd.or.xbt.or.axbt.or.xbts.or.cm) then do 90 m=2,nhvar do 80 n=1,nhpts ihdat(n)=nint(hdat(n,m)/hscle(m)) 80 continue write(iunit,902) (ihdat(n),n=1,nhpts) 90 continue endif c c #ifdef sunflush c Flush output buffers. c call flush(iunit) c #endif 900 format ('(1x,i1,1x,i5,1x,i5,1x,f9.4,1x,f8.4,1x,f7.1,1x,f11.4,', & i10,'(1x,1pe8.2))') 901 format (1x,i2,1x,a) 902 format (10i6) return end