From 80e5e7300729b28a31f290dd05ba208b58f82982 Mon Sep 17 00:00:00 2001 From: Jeff Schacter Date: Thu, 22 Apr 1999 22:50:43 +0000 Subject: [PATCH] D3D specific tdi library etc. --- d3dshr/Makefile | 28 ++ d3dshr/mdsptdata.f | 801 +++++++++++++++++++++++++++++++++++++++++++ d3dshr/mdsptdata.inc | 181 ++++++++++ 3 files changed, 1010 insertions(+) create mode 100644 d3dshr/Makefile create mode 100644 d3dshr/mdsptdata.f create mode 100644 d3dshr/mdsptdata.inc diff --git a/d3dshr/Makefile b/d3dshr/Makefile new file mode 100644 index 0000000000..deaacf5e64 --- /dev/null +++ b/d3dshr/Makefile @@ -0,0 +1,28 @@ +include $(MAKE_OPTIONS) + +D3DLIB = /c/osf/lib + +OBJECTS = \ + mdsptdata.o + +mdslib : ../shlib ../shlib/libMdsD3D.$(SHARE_TYPE) + +../shlib : + mkdir ../shlib + +mdsptdata.o : mdsptdata.f + f77 -c -g -I. -o $@ mdsptdata.f + +../shlib/libMdsD3D.$(SHARE_TYPE) : $(OBJECTS) + $(LD) -o $@ $(LD_SHARED_LIB_OPTIONS) $(OBJECTS) -L$(D3DLIB) -ld3 -lc -lfor + +clean : + - rm *.o + - rm ../shlib/libMdsD3D.$(SHARE_TYPE) + - rm .depend + +.depend : + find *.c -exec $(MAKE_DEPEND) + +include $(DEPEND) + diff --git a/d3dshr/mdsptdata.f b/d3dshr/mdsptdata.f new file mode 100644 index 0000000000..f5d03de056 --- /dev/null +++ b/d3dshr/mdsptdata.f @@ -0,0 +1,801 @@ +c========================================================================== +C MDSPTDATA - adapted from IPTREAD +C IPTREAD CM Greenfield 24-FEB-1993 +C Modified 03-MAR-1993 +C Generic subroutine to call PTDATA and return data for arbitrary +C signal names. +C +C To just get headers without data, use shot = -shot +C +C For DFI's which do not have the "new multiple domain timing system," +C an error will be returned unless the DFI information has been included +C in subroutine DFI_DECODE, below. +C +C CAUTION - This has not been tested for every pointname! Use at your +C own risk! +C +C The PTDATA system is documented in DOC:PTDATA.DOC and DOC:DFI_*.DOC +C========================================================================== +C +C NPT = IPTREAD(SHOT,POINTNAME,F,T,N,SDATE,STIME,IER) +C +C Variable descriptions: +C +C IPTREAD I*4 Returns number of data points read +C +C SHOT I*4 Shot number (input) - negative to just read header +C POINTNAME C*10 Pointname (input) +C F R*4 Data (output) +C T R*4 Timebase (output) in msec +C N I*4 Maximum number of points, dimension of F and T (input) +C SDATE C*10 Shot date DDNN-YYYY (output) +C STIME C*8 Shot time HH:MM:SS (output) +C IER I*4 PTDATA error code. See PTDATA_ERRORS, below. +C +C Other data is available, to access it include READ_PTDATA.INC in the +C calling program. +C========================================================================== + integer*4 function MDSPTREAD(shot,pointname,f,t,n,sdate,stime, + > units,ier) +c integer*4 function MDSPTREAD(shot,pointname,f,t,n,sdate,stime,ier) +c implicit none + integer n + include 'mdsptdata.inc' + integer shot + character pointname*10, sdate*10, stime*8 + real t(n), f(n) + integer*4 DFI_DECODE, ier + character*4 units +C Array for conversion of dates to useful format + character*3 months(12) + data months / 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', + 1 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC' / +C First try call type 12. If that's invalid for the DFI, repeat with type 2 + parameter (ntype=2) + integer*4 type(0:ntype) + data type /6,12,2/ + + MDSPTREAD = 0 + + ier = 35 + itype = 0 + + do while ((ier.eq.35).and.(itype.lt.ntype)) + itype = itype + 1 + if(shot.lt.0)then ! Read header only + itype=0 + IARRAY.NREQ = 0 + else ! Read header and data + IARRAY.NREQ = min(LEN_DATA,n) ! NOTE!!!! If n>LEN_DATA, PTDATA is only asked for LEN_DATA points, +c ! but user is asking for n points. Therefore trap error in TDI function + endif + IARRAY.START = 1 + IARRAY.INC = 1 + ASCII.NREQ = LEN_HDR + INT16.NREQ = LEN_HDR + INT32.NREQ = LEN_HDR + REAL32.NREQ = LEN_HDR + call ptdata_(type(itype),jiabs(shot),%ref('.PLA'), + 2 %ref(pointname), + 1 data,ier,iarray,rarray,ascii,int16,int32,real32) + +C This should NEVER happen, but just in case... + if((itype.eq.0).and.(ier.eq.35))itype=ntype + + enddo + +C Write data and time to SDATE and STIME + write(SDATE,100)IARRAY.DAY, months(IARRAY.MONTH), IARRAY.YEAR + write(STIME,110)IARRAY.HOUR, IARRAY.MINUTE, IARRAY.SECOND + +C If PTDATA call failed, or we just wanted to read headers, then return + + if ((shot.lt.0).or.((ier.ne.0).and.(ier.ne.4))) return +C Else: +C If "multiple domain timing" info not include, perform special +C handling depending on the DFI + if (itype.eq.2) then + MDSptread=DFI_DECODE(f,t,n,ier1) + if (ier1.ne.0) ier=ier1 + return + endif + +C Copy timebase data to t array +C Multiply data by calibration factors and treat appropriately +C depending on word size->signed/unsigned and data type + MDSptread = min(IARRAY.NRET,n) + +C if(IARRAY.WORD.le.12)then ! If data size LE 12 bits, unsigned +C The documentation says unsigned up to 12 bits, but the only 16 bit data +C I can find, PINJ, looks to be unsigned as well. + + if(IARRAY.WORD.le.16)then ! If data size LE 16 bits, unsigned + rsn = -1 + else + rsn = +1 + endif + fac = RARRAY.IN*RARRAY.RCG ! Factor = calibration + RC gain + + do i=1,MDSptread + +C Is data INTEGER or REAL? + if (IARRAY.DTYPE(1:2).EQ.'IN') then + y = DATA.INT32(i) ! Integer data + elseif (IARRAY.DTYPE(1:2).EQ.'RE') then + y = DATA.REAL32(i) ! Real data + endif + f(i) = fac*(RARRAY.OFF+rsn*y) + t(i) = 1000.0*RARRAY.TIME(i) + enddo + + units=iarray.units + return + 100 format(I2.2,a3,'-',I4.4) + 110 format(I2.2,':',I2.2,':',I2.2) + end + + +c------------------------------------------------------------------------------- + + integer*4 function DFI_DECODE(f,t,n,ier) +C Data Format Index (DFI) specific PTDATA decoding +C ============================================================ +C List of supported DFI's + parameter (SPRED_ = 147) + parameter (LOGFNR = 155) + parameter (BOLOCAL = 1143) + parameter (PRAD = 1144) +C ============================================================ + integer n + real f(n), t(n) + include 'mdsptdata.inc' + integer SPRED_DECODE + logical okay + ier = 0 + if(IARRAY.DFI.eq.SPRED_)then + DFI_DECODE = SPRED_DECODE(t,f,n) + if(DFI_DECODE.lt.0)ier=DFI_DECODE + elseif(IARRAY.DFI.eq.LOGFNR)then + DFI_DECODE = min(n,IARRAY.NRET/2) + do i=1,DFI_DECODE + t(i) = DATA.REAL32(i) + f(i) = DATA.REAL32(i+DFI_DECODE) + enddo + elseif((IARRAY.DFI.eq.BOLOCAL).or.(IARRAY.DFI.eq.PRAD))then + DFI_DECODE = min(n,IARRAY.NRET/2) + do i=1,DFI_DECODE + t(i) = DATA.REAL32(i+DFI_DECODE) + f(i) = DATA.REAL32(i) + enddo + else + ier = -1 + endif +C Cut off extra times at end of data arrays + i=2 + okay = .TRUE. + do while ((i.le.DFI_DECODE).and.okay) + okay = t(i).gt.t(i-1) + if(okay)i=i+1 + enddo + DFI_DECODE=i-1 + return + end + +c------------------------------------------------------------------------------- + + subroutine PTDATA_ERRMES(ier) + parameter (n=1) + include 'mdsptdata.inc' + character string*80 + if(ier.eq.-1)then + type 100,IARRAY.DFI + elseif(ier.ge.0)then + call MDSPTERROR(ier,string) + call str$trim(string,string,len) + type 110,ier,string(1:len) + endif + return + 100 format(' UNSUPPORTED DFI TYPE: ',i5) + 110 format(' PTDATA ',i2,': ',a) + end + + +c------------------------------------------------------------------------------- + +C PTDATA_ERRORS +C Returns a string corresponding to a given PTDATA error code + subroutine MDSPTERROR(error,string) + character string*50 + integer error + if(error.lt.0)then + string='error in DFI_DECODE' + elseif(error.eq.0)then + string='no errors' + elseif(error.eq.1)then + string='pointname does not exist for this shot' + elseif(error.eq.3)then + string='shot-source not found on disk' + elseif(error.eq.4)then + string='fewer data points returned than requested.' + elseif(error.eq.5)then + string='unrecoverable file access error' + elseif(error.eq.7)then + string='invalid shot number (<0 or >999999)' + elseif(error.eq.14)then + string='invalid call type' + elseif(error.eq.20)then + string='error allocating/deallocating buffer space for pointname' + elseif(error.eq.21)then + string='error getting node name or unknown node name' + elseif(error.eq.22)then + string='error opening network link connection' + elseif(error.eq.23)then + string='error writing shot number to remote node' + elseif(error.eq.24)then + string='error reading shot status from remote node' + elseif(error.eq.25)then + string='error reading data from remote node' + elseif(error.eq.30)then + string='digitizer delta time .LE. 0 or requested delta time .LE. 0' + elseif(error.eq.31)then + string='number of data points requested is less than 1' + elseif(error.eq.32)then + string='invalid integer bits/word in fixed header' + elseif(error.eq.34)then + string='for call type 2,7,12, start or delta point less than 1' + elseif(error.eq.35)then + string='data format index is inconsistent with calling type' + elseif(error.eq.36)then + string='pointname requires special non ptdata handling of the timing.' + elseif(error.eq.37)then + string='data format index is inconsistent with calling type' + elseif(error.eq.40)then + string='pointname size was too big to be processed.' + elseif(error.eq.41)then + string='pointname size less than fixed header size' + elseif(error.eq.42)then + string='pointname size less than header word count' + elseif(error.eq.43)then + string='fixed+variable header greater than header word count' + elseif(error.eq.44)then + string='one or more variable header counts is negative' + elseif(error.eq.45)then + string='header word size from Modcomp not a multiple of 128' + elseif(error.eq.50)then + string='data file directory inconsistent with fixed header' + elseif(error.eq.53)then + string='invalid data type in fixed header' + elseif(error.eq.60)then + string='Modcomp error - fatal acquisition error No data was acquired' + elseif(error.eq.61)then + string='Modcomp error - I/O error in writing disk file.' + elseif(error.eq.62)then + string='Modcomp error - database error.' + elseif(error.eq.63)then + string='Modcomp error - processing inconsistencies.' + elseif(error.eq.64)then + string='Modcomp error - transfer error' + elseif(error.eq.70)then + string='Invalid PTDATA version on MULTIFLOW' + elseif(error.eq.71)then + string='MULTIFLOW error opening network link.' + elseif(error.eq.72)then + string='MULTIFLOW error writing to network link.' + elseif(error.eq.73)then + string='MULTIFLOW error reading from network link.' + elseif(error.eq.74)then + string='Allocation error on VAX' + else + string='Unknown error' + endif + return + end + +c------------------------------------------------------------------------------- + + integer function SPRED_DECODE(t,f,n) + integer n + real t(n), f(n) + logical str_compare + character name*10 + include 'mdsptdata.inc' +C First, put the data into the "SPRED" structure + do j=1,1024 + SPRED.TIME(j) = 1000.0*DATA.REAL32(j) + enddo + SPRED.NLINES = INT32.HDR(1) + SPRED.NPTS = INT32.HDR(2) + do i=1,SPRED.NLINES + n1 = 10*(i-1)+1 + n2 = n1+9 + call STR$TRIM(SPRED.NAME(i),ASCII.HDR(n1:n2),l) + call STR$UPCASE(SPRED.NAME(i),SPRED.NAME(i)) + n1 = 22*(i-1)+241 + n2 = n1+21 + call STR$TRIM(SPRED.LABEL(i),ASCII.HDR(n1:n2),l) + do j=1,SPRED.NPTS + SPRED.BRIGHTNESS(j,i) = DATA.REAL32(j+1024*i) + enddo + enddo +C Should we query for a pointname to read? + if(SPRED_QFLAG)then + type 100 + type 110,(SPRED.NAME(i),i=1,SPRED.NLINES) + type 120 + accept '(a)',SPRED_NAME + endif +C Look for SPRED_NAME in the list + call str$trim(SPRED_NAME,SPRED_NAME,len) + call str$upcase(SPRED_NAME,SPRED_NAME) + i=1 + do while ((i.le.SPRED.NLINES).and. + 1 (.not.str_compare(SPRED_NAME,SPRED.NAME(i)))) + i=i+1 + enddo + + if (i.gt.SPRED.NLINES) then + type '('' Not found: "'',a,''"'')',SPRED_NAME(1:len) + SPRED_IND = -1 + SPRED_DECODE=-2 + return + endif + SPRED_IND = i + SPRED_DECODE = SPRED.NPTS + do j=1,SPRED_DECODE + t(j) = SPRED.TIME(j) + f(j) = SPRED.BRIGHTNESS(j,i) + enddo + return + 100 format(' The following SPRED names are available: ') + 110 format(6(1x,1a10)) + 120 format($,' Enter name >> ') + end + +c------------------------------------------------------------------------------- + + logical function str_compare(str1,str2) + character str1*(*), str2*(*) + character*256 a,b + str_compare = .FALSE. + call str$trim(a,str1,la) + call str$trim(b,str2,lb) + if((la.eq.lb).and.(a.eq.b))str_compare=.TRUE. + return + end + + +c------------------------------------------------------------------------------- + + integer*4 function MDSPTNPTS(shot,pointname,ier) + +c implicit none + parameter (n=1) + include 'mdsptdata.inc' + integer shot + integer*4 word + character pointname*10 + integer*4 ier + real frac + + IARRAY.NREQ = 0 + + IARRAY.START = 1 + IARRAY.INC = 1 + ASCII.NREQ = LEN_HDR + INT16.NREQ = LEN_HDR + INT32.NREQ = LEN_HDR + REAL32.NREQ = LEN_HDR + + call ptdata_(6,shot,%ref('.PLA'),%ref(pointname), + 1 data,ier,iarray,rarray,ascii,int16,int32,real32) + + word=iarray.word + if ((word.gt.8).and.(word.lt.16)) word=16 + +c 10 and 12 bit data counted as 16 bits to calculate number of points +c example signal: 15LS_V_ACC from NB shot 65310 + + frac = 0 + if (word.gt.0) frac = 16./word + +c NBVAC33LT point for examine has iarray.word=8 and iarray.num16=8192 +c for a total number of points = 16384. + + mdsptnpts = iarray.num16*frac + + return + end + +c---------------------------------------------------------------------------- + + subroutine mdsptheadsize(shot,pointname,ier,size) + +c implicit none + parameter (n=1) + include 'mdsptdata.inc' + + integer shot + character pointname*10 + integer*4 ier + integer*4 size(6) + + IARRAY.NREQ = 0 + + IARRAY.START = 1 + IARRAY.INC = 1 + ASCII.NREQ = LEN_HDR + INT16.NREQ = LEN_HDR + INT32.NREQ = LEN_HDR + REAL32.NREQ = LEN_HDR + + call ptdata_(6,shot,%ref('.PLA'),%ref(pointname), + 1 data,ier,iarray,rarray,ascii,int16,int32,real32) + + size(1)=iarray.nasch ! character string should be 4* this value + size(2)=iarray.n16ih + size(3)=iarray.n32ih + size(4)=iarray.n32rh + size(5)=9 + if (iarray.hwords .gt. IFIX_SIZE) then + size(6)=IFIX_SIZE + else + size(6)=iarray.hwords + end if + size(7)=iarray.n64rh + + return + end + +c------------------------------------------------------------------------------- + + subroutine mdsptheada(shot,pointname,ier,apass) + +c implicit none + parameter (n=1) + include 'mdsptdata.inc' + + integer shot + character pointname*10 + integer*4 ier + character*(*) apass + + IARRAY.NREQ = 0 + + IARRAY.START = 1 + IARRAY.INC = 1 + ASCII.NREQ = LEN_HDR + INT16.NREQ = 0 + INT32.NREQ = 0 + REAL32.NREQ = 0 + + call ptdata_(6,shot,%ref('.PLA'),%ref(pointname), + 1 data,ier,iarray,rarray,ascii,int16,int32,real32) + + if ((ier.ne.0).and.(ascii.nret.gt.0)) ier=0 + apass=ascii.hdr + return + end + + +c------------------------------------------------------------------------------- + + subroutine mdsptheadi16(shot,pointname,ier,i16pass) + +c implicit none + parameter (n=1) + include 'mdsptdata.inc' + + integer shot + character pointname*10 + integer*4 ier + integer i16pass(*) + + IARRAY.NREQ = 0 + + IARRAY.START = 1 + IARRAY.INC = 1 + ASCII.NREQ = 0 + INT16.NREQ = LEN_HDR + INT32.NREQ = 0 + REAL32.NREQ = 0 + + call ptdata_(6,shot,%ref('.PLA'),%ref(pointname), + 1 data,ier,iarray,rarray,ascii,int16,int32,real32) + + if ((ier.ne.0).and.(int16.nret.gt.0)) ier=0 + do i=1,int16.nret + i16pass(i)=int16.hdr(i) + enddo + + return + end + +c------------------------------------------------------------------------------- + + subroutine mdsptheadi32(shot,pointname,ier,i32pass) + +c implicit none + parameter (n=1) + include 'mdsptdata.inc' + + integer shot + character pointname*10 + integer*4 ier + integer*4 i32pass(*) + + IARRAY.NREQ = 0 + + IARRAY.START = 1 + IARRAY.INC = 1 + ASCII.NREQ = 0 + INT16.NREQ = 0 + INT32.NREQ = LEN_HDR + REAL32.NREQ = 0 + + call ptdata_(6,shot,%ref('.PLA'),%ref(pointname), + 1 data,ier,iarray,rarray,ascii,int16,int32,real32) + + if ((ier.ne.0).and.(int32.nret.gt.0)) ier=0 + do i=1,int32.nret + i32pass(i)=int32.hdr(i) + enddo + + return + end + + +c------------------------------------------------------------------------------- + + subroutine mdsptheadr32(shot,pointname,ier,r32pass) + +c implicit none + parameter (n=1) + include 'mdsptdata.inc' + + integer shot + character pointname*10 + integer*4 ier + real*4 r32pass(*) + + IARRAY.NREQ = 0 + + IARRAY.START = 1 + IARRAY.INC = 1 + ASCII.NREQ = 0 + INT16.NREQ = 0 + INT32.NREQ = 0 + REAL32.NREQ = LEN_HDR + + call ptdata_(6,shot,%ref('.PLA'),%ref(pointname), + 1 data,ier,iarray,rarray,ascii,int16,int32,real32) + + if ((ier.ne.0).and.(real32.nret.gt.0)) ier=0 + do i=1,real32.nret + r32pass(i)=real32.hdr(i) + print *,r32pass(i) + enddo + + return + end + + +c------------------------------------------------------------------------------- + + subroutine mdsptheadifix(shot,pointname,ier,ifixpass) + +c implicit none + parameter (n=1) + include 'mdsptdata.inc' + + integer shot + character pointname*10 + integer*4 ier + integer*4 ifixpass(*) + integer ifixloop + +c record /PT_ASCII/ apass +c record /PT_INT16/ i16pass +c record /PT_REAL32/ r32pass + + IARRAY.NREQ = 0 + + IARRAY.START = 1 + IARRAY.INC = 1 + ASCII.NREQ = LEN_HDR + INT16.NREQ = LEN_HDR + INT32.NREQ = LEN_HDR + REAL32.NREQ = LEN_HDR + + call ptdata_(6,shot,%ref('.PLA'),%ref(pointname), + 1 data,ier,iarray,rarray,ascii,int16,int32,real32) + + if (iarray.hwords .gt. IFIX_SIZE) then + ifixloop=IFIX_SIZE + else + ifixloop=iarray.hwords + end if + + if ((ier.ne.0).and.(iarray.hwords.gt.0)) ier=0 + do i=1,ifixloop + ifixpass(i)=iarray.ifix(i) + enddo + + return + end + + +c------------------------------------------------------------------------------- + + subroutine mdsptheadunits(shot,pointname,ier,units) + +c implicit none + parameter (n=1) + include 'mdsptdata.inc' + + integer shot + character pointname*10 + integer*4 ier + character*4 units + + IARRAY.NREQ = 0 + + IARRAY.START = 1 + IARRAY.INC = 1 + ASCII.NREQ = LEN_HDR + INT16.NREQ = LEN_HDR + INT32.NREQ = LEN_HDR + REAL32.NREQ = LEN_HDR + + call ptdata_(6,shot,%ref('.PLA'),%ref(pointname), + 1 data,ier,iarray,rarray,ascii,int16,int32,real32) + + units = iarray.units + + return + end + + +c------------------------------------------------------------------------------- + + subroutine mdsptheadrfix(shot,pointname,ier,rfixpass) + +c implicit none + parameter (n=1) + include 'mdsptdata.inc' + + integer shot + character pointname*10 + integer*4 ier + real*4 rfixpass(*) + +c record /PT_ASCII/ apass +c record /PT_INT16/ i16pass +c record /PT_REAL32/ r32pass + + IARRAY.NREQ = 0 + + IARRAY.START = 1 + IARRAY.INC = 1 + ASCII.NREQ = LEN_HDR + INT16.NREQ = LEN_HDR + INT32.NREQ = LEN_HDR + REAL32.NREQ = LEN_HDR + + call ptdata_(6,shot,%ref('.PLA'),%ref(pointname), + 1 data,ier,iarray,rarray,ascii,int16,int32,real32) + + if ((ier.ne.0).and.(rarray.rcg.ne.0.0)) ier=0 + do i=1,9 + rfixpass(i)=rarray.rfix(i) + enddo + return + end + + +c---------------------------------------------------------------------------- + + subroutine mdsptcomments(shot,ier,cx) + + include 'mdsptdata.inc' + + integer shot + integer*4 ier + integer*2 IDAT(256) + CHARACTER*512 COMMENTS + character*512 cx + equivalence (idat,comments) + + IARRAY.NREQ = 256 + + IARRAY.START = 1 + IARRAY.INC = 1 + ASCII.NREQ = LEN_HDR + INT16.NREQ = LEN_HDR + INT32.NREQ = LEN_HDR + REAL32.NREQ = LEN_HDR + + call ptdata_(2,shot,%ref('.PLA'),%ref('COMMENTS '), + 1 idat,ier,iarray,rarray,ascii,int16,int32,real32) + + do i=1,512 + cx(i:i) = comments(i:i) + enddo + + end + +c---------------------------------------------------------------------------- + program test1 + + parameter nmax=524288 + external MDSptread + real t(nmax),f(nmax) + character pointname*10, sdate*10, stime*8, units*4 + integer shot,ier,npt + character*512 comments + +c shot=73010 +c pointname='33LS_V_ACC' + shot=96021 + pointname='IP ' + + + npt = mdsptnpts(shot,pointname,ier) + + write (6,*) 'NPT: ',npt + write (6,*) 'IER: ',ier + + + npt = mdsptread(shot,pointname,f,t,npt,sdate,stime,units,ier) + + write (6,*) 'NPT: ',npt + write (6,*) 'IER: ',ier + write (6,*) 'UNITS: ',units + + do i=1,npt + write (6,*) i,f(i),t(i) + enddo + + call mdsptcomments(shot,ier,comments) + write (6,*) 'COMMENTS: ',comments + + end + +c---------------------------------------------------------------------------- + subroutine test2 + + integer shot + character pointname*10 + integer*4 ier + integer i16pass(10) + integer*4 i32pass(1) + real*4 r32pass(26) + real*4 rfixpass(9) + integer*4 ifixpass(50) + character*30 apass + integer size(7) + character *4 units + + shot=94268 + pointname='IP ' + call mdsptheadsize(shot,pointname,ier,size) + print *,'SIZE: ',size + + call mdsptheadA(shot,pointname,ier,apass) + call mdsptheadi16(shot,pointname,ier,i16pass) + call mdsptheadi32(shot,pointname,ier,i32pass) + call mdsptheadr32(shot,pointname,ier,r32pass) + call mdsptheadrfix(shot,pointname,ier,rfixpass) + call mdsptheadifix(shot,pointname,ier,ifixpass) + + print *,'SHOT: ',shot,' POINTNAME: ',pointname + print *,'IER: ',ier + print *,'APASS: ',apass + print *,'R32PASS: ',r32pass + print *,'IFIXPASS: ',ifixpass + print *,'RFIXPASS: ',rfixpass + + units=' ' + call mdsptheadunits(shot,pointname,ier,units) + print *,'UNITS: -->',units,'<--',ier + + end diff --git a/d3dshr/mdsptdata.inc b/d3dshr/mdsptdata.inc new file mode 100644 index 0000000000..d130bb743a --- /dev/null +++ b/d3dshr/mdsptdata.inc @@ -0,0 +1,181 @@ +C ******************* CM Greenfield 24-FEB-1993 +C * READ_PTDATA.INC * Revised 03-MAR-1993 +C ******************* +C +C Data structure definitions for PTDATA +C See DOC:PTDATA.DOC +c parameter (LEN_DATA=262140) ! Length of data array in bytes + parameter (LEN_DATA=524288) ! Length of data array in bytes + parameter (LEN_HDR=255) ! Number of words for headers +C====================================================================== +C Define structure for DATA +c parameter (LEN_DATA_4=LEN_DATA/4) + parameter (LEN_DATA_4=65535) + parameter (IFIX_SIZE=50) + STRUCTURE /PT_DATA/ + UNION + MAP + CHARACTER ASCII*(LEN_DATA_4) + CHARACTER ASCII2*(LEN_DATA_4) + CHARACTER ASCII3*(LEN_DATA_4) + CHARACTER ASCII4*(LEN_DATA_4) + END MAP + MAP +c INTEGER*4 INT32(LEN_DATA_4) + INTEGER*4 INT32(LEN_DATA) +c INTEGER*4 INT32(n) + END MAP + MAP +c REAL*4 REAL32(LEN_DATA_4) + REAL*4 REAL32(LEN_DATA) +c REAL*4 REAL32(n) + END MAP + END UNION + END STRUCTURE + + RECORD /PT_DATA/ DATA + COMMON /PT$$001/ DATA +C====================================================================== +C Define structure for IARRAY + STRUCTURE /PT_IARRAY/ + UNION + MAP + INTEGER*4 NREQ, ! Number of data points requested + 1 NRET, ! Number of data points returned + 2 START, ! Data start point for calls of type 2,7,12 + 3 INC, ! Increment between data points + 4 HFI, ! Header format index + 5 HWORDS ! Number of 16 bit words in header + CHARACTER*4 EXPTR, ! Experimentor + 1 PLTYPE ! Plasma type + INTEGER*4 SHOT ! Shot number + CHARACTER*4 EXPN, ! Experiment name - ASCII + 1 PHASE ! Phase - ASCII + CHARACTER*12 POINT ! Pointname + INTEGER*4 HOUR, ! Time of shot: hour + 1 MINUTE, ! minute + 2 SECOND, ! second + 3 MONTH, ! Date of shot: month + 4 DAY, ! day + 5 YEAR, ! year + 6 PTTYPE ! Point type - UNUSED ON VAX + CHARACTER*24 PDESC ! Point description + CHARACTER*4 UNITS ! Engineering units + INTEGER*4 REV, ! Number of revisions to pointname + 1 OFF, ! Zero offset + 2 DFI, ! Data format index + 3 NUM16, ! Number of words of 16 bit data + 4 WORD ! Number of bits in data word + CHARACTER*4 DTYPE ! Data type - 'IN ','RE ','AS ' + INTEGER*4 CVAL, ! Compression value 0=un, 17=comp + 1 NASCH, ! Number of words from ASCII variable header + 2 N16IH, ! Number of words from INT*2 variable header + 3 N32IH, ! Number of words from INT*4 variable header + 4 N32RH, ! Number of words from REAL*4 variable header + 5 N64RH ! Number of words from REAL*8 variable header + INTEGER*4 DUMMY(10) ! future use + END MAP + MAP + INTEGER*4 IFIX(IFIX_SIZE) + END MAP + END UNION + END STRUCTURE + + RECORD /PT_IARRAY/ IARRAY + COMMON /PT$$002/ IARRAY +C====================================================================== +C Define structure for RARRAY + STRUCTURE /PT_RARRAY/ + UNION + MAP + REAL*4 STREQ, ! Requested start time (seconds) + 1 DTREQ, ! Requested delta time (seconds) + 2 DTACT, ! Delta time actually used (seconds) + 3 IN, ! Inherent number - calibration factor#1 + 4 RCG, ! RC gain - calibration factor#2 + 5 OFF, ! Zero offset - same as IARRAY.OFF + 6 STACT, ! Start time actually used (seconds) + 7 STHED, ! Start time of data from fixed header + 8 DTHED, ! Delta time of data from fixed header + 9 UNUSED(10:20), +c A TIME(LEN_DATA_4) ! Time array in seconds + A TIME(LEN_DATA) ! Time array in seconds +c A TIME(n) ! Time array in seconds + END MAP + MAP + REAL*4 RFIX(LEN_DATA+19) + END MAP + END UNION + END STRUCTURE + + RECORD /PT_RARRAY/ RARRAY + COMMON /PT$$003/ RARRAY +C====================================================================== +C Define ASCII header + parameter (NASC_HDR=2*LEN_HDR) + STRUCTURE /PT_ASCII/ + INTEGER*4 NREQ, ! Number of words requested + 1 NRET ! Number of words returned + CHARACTER*2 HDR*(NASC_HDR) ! ASCII header + END STRUCTURE + + RECORD /PT_ASCII/ ASCII + COMMON /PT$$004/ ASCII +C====================================================================== +C Define INT16 header + STRUCTURE /PT_INT16/ + INTEGER*4 NREQ, ! Number of words requested + 1 NRET, ! Number of words returned + 2 HDR(LEN_HDR) ! INT16 header + END STRUCTURE + + RECORD /PT_INT16/ INT16 + COMMON /PT$$005/ INT16 +C====================================================================== +C Define INT32 header + STRUCTURE /PT_INT32/ + INTEGER*4 NREQ, ! Number of words requested + 1 NRET, ! Number of words returned + 2 HDR(LEN_HDR) ! INT32 header + END STRUCTURE + + RECORD /PT_INT32/ INT32 + COMMON /PT$$006/ INT32 +C====================================================================== +C Define REAL32 header + STRUCTURE /PT_REAL32/ + REAL*4 NREQ, ! Number of words requested + 1 NRET, ! Number of words returned + 2 HDR(LEN_HDR) ! REAL32 header + END STRUCTURE + + RECORD /PT_REAL32/ REAL32 + COMMON /PT$$007/ REAL32 +C====================================================================== +C====================================================================== +C +C PFI SPECIFIC DATA STRUCTURES +C +C====================================================================== +C SPRED: PFI #147 + STRUCTURE /IPTREAD_SPRED/ + CHARACTER*10 NAME(24) ! 10 character name of wavelength array + ! (used to identify/extract desired subset + ! of data from full data block) + CHARACTER*22 LABEL(24) ! 22 character array label for plot; + ! LABEL contains additional identifying + ! information + REAL*4 TIME(1024), ! time (msec) + 1 BRIGHTNESS(1024,24) ! up to 1024 data points for up to 24 spectral lines + + INTEGER*4 NLINES, ! Number of lines (max. 24) + 1 NPTS ! Number of points for each line (max. 1024) + END STRUCTURE + + RECORD /IPTREAD_SPRED/ SPRED + + LOGICAL SPRED_QFLAG ! If TRUE, user will be queried for SPRED pointname. + CHARACTER*10 SPRED_NAME ! Name of line to use + INTEGER SPRED_IND + + COMMON /PT$010/ SPRED, SPRED_QFLAG, SPRED_IND, SPRED_NAME