Subroutine GetVal (Tstnam,Nvar,Insnam,Varnam,Values,X,Y,Z) c c GetVal reads LIP-data and delivers these data in array Values. c c Parameter type length I/O description c Tstnam C* 1 I testidentification c Nvar I 1 I number of requested values c Insnam C* Nvar I array with instrument id's c Varnam C* Nvar I array with variable names c Values R Nvar O array with values c X,Y,Z R Nvar O coordinates of instrument c c 0.0 File name (=test identification) c for i until Nvar c 1.0 Read SERIES c 2.0 Find Instrument name c 3.0 Read Variable name c 3.1 Read value of Variable c 3.2 Read value of X c 3.3 Read value of Y c 3.4 Read value of Z c Integer Nvar Real Values(Nvar),X(Nvar),Y(Nvar),Z(Nvar) Character*(*) Tstnam,Insnam(Nvar),Varnam(Nvar) c Integer i,ii,ind,iostat,j,k,l,lfn,lin,lvn,u1,maxvar Parameter (maxvar=100) Logical exist,ready(maxvar),xflag(maxvar),double,compl Character*72 line c c 0.0 File name (=test identification) c -------------------------------- c lfn = INDEX (Tstnam,' ')-1 If (lfn.EQ.-1) lfn = LEN (Tstnam) Inquire (file=Tstnam(1:lfn),exist=exist) If (.NOT.exist) Then Write (*,'(A,A,A)') ' File :',Tstnam(1:lfn),' does not exist' cc Stop Endif u1 = 1 Open (file=Tstnam(1:lfn),unit=u1,form='FORMATTED',iostat=iostat, . status='OLD') If (iostat.NE.0) Goto 999 c ---file = O.K. c c 1.0 Read SERIES c ----------- c double = .FALSE. compl = .TRUE. Do 080 i=1,Nvar-1 Do 070 j=i+1,Nvar If (insnam(i).EQ.insnam(j)) double = .TRUE. 70 Continue 80 Continue Do 090 i=1,maxvar ready(i) = .FALSE. xflag(i) = .FALSE. 90 Continue j = 0 100 Continue If (j.EQ.Nvar) Goto 1000 i = 0 Read (u1,'(A)',iostat=iostat) line If (iostat.NE.0) Goto 998 ind = INDEX (line,'SERIES') If (ind.EQ.0) Goto 100 ind = INDEX (line,'END') If (ind.GT.0) Goto 100 c ---SERIES = O.K. c c 2.0 Find Instrument name c -------------------- c 200 Continue 210 i = i+1 If (ready(i)) Goto 210 If (i.GT.Nvar) Goto 100 lin = INDEX (Insnam(i),' ')-1 If (lin.EQ.-1) lin = LEN (Insnam(i)) ind = INDEX (line,Insnam(i)(1:lin)) If (ind.EQ.0) Goto 200 c ---Insnam = O.K. c c 3.0 Read Variable name c ------------------ c lvn = INDEX (Varnam(i),' ')-1 If (lvn.EQ.-1) lvn = LEN (Varnam(i)) l = 0 300 Continue Read (u1,'(A)',iostat=iostat) line l = l+1 ind = INDEX (line,'END') If (ind.GT.0) Then If (double) Then Do 310 k=1,l Backspace u1 310 Continue Do 320 k=i+1,Nvar If (Insnam(i)(1:lin).EQ.Insnam(k)(1:lin)) Then i = k Goto 300 Endif 320 Continue Else If (iostat.NE.0) Goto 997 Do 330 k=1,l Backspace u1 330 Continue compl = .FALSE. Goto 340 c ---Varnam = NOT O.K. c ---Try to find X.Y.Z Endif Else ind = INDEX (line,Varnam(i)(1:lvn)) If (ind.EQ.0) Goto 300 Endif c ---Varnam = O.K. c c 3.1 Read value of Variable c ---------------------- c ind = INDEX (line,'VALUE=') Read (line(ind+6:ind+19),'(E14.6)') values(i) c ---Value = O.K. c c 3.2 Read value of X c --------------- c 340 Continue Read (u1,'(A)',iostat=iostat) line If (iostat.NE.0) Goto 999 ind = INDEX (line,'X') If (ind.GT.0) Then ind = INDEX (line,'VALUE=') Read (line(ind+6:ind+19),'(E14.6)') X(i) c ---X = O.K. c c 3.3 Read value of Y c --------------- c Read (u1,'(A)',iostat=iostat) line If (iostat.NE.0) Goto 999 ind = INDEX (line,'Y') If (ind.GT.0) Then ind = INDEX (line,'VALUE=') Read (line(ind+6:ind+19),'(E14.6)') Y(i) c ---Y = O.K. c c 3.4 Read value of Z c --------------- c Read (u1,'(A)',iostat=iostat) line If (iostat.NE.0) Goto 999 ind = INDEX (line,'Z') If (ind.GT.0) Then ind = INDEX (line,'VALUE=') Read (line(ind+6:ind+19),'(E14.6)') Z(i) c ---Z = O.K. If (compl) Then j = j+1 ready(i) = .TRUE. Else compl = .TRUE. Endif Else Write (*,'(A)') ' Z not found' cc Stop Endif Else Write (*,'(A)') ' Y not found' cc Stop Endif Else ind = INDEX (line,'END:SERIES') If (ind.EQ.0) Then Goto 340 Else xflag(i) = .TRUE. ready(i) = .TRUE. j = j+1 Endif Endif Goto 100 997 Continue Write (*,'(A,A,A,A)') ' Name of Variable name ', . Varnam(i)(1:lvn), . ' not found on file : ',Tstnam(1:lfn) Goto 999 998 Continue Write (*,'(A,A,A,A)') ' Instrument id ', . Insnam(i)(1:lin), . ' not found on file : ',Tstnam(1:lfn) 999 Continue If (iostat.LT.0) Then Write (*,'(A,A)') ' End of file encountered on file : ', . Tstnam(1:lfn) cc Stop Else Write (*,'(A,A,A,I10)') ' Error encountered on file : ', . Tstnam(1:lfn),' error number : ', . iostat cc Stop Endif 1000 Continue Do 1010 i=1,Nvar If (xflag(i)) Then ii = i Goto 1020 Endif 1010 Continue Goto 1040 1020 Do 1030 i=1,Nvar If (Insnam(i).EQ.Insnam(ii)) Then If (.NOT.xflag(i)) Then X(ii) = X(i) Y(ii) = Y(i) Z(ii) = Z(i) xflag(ii) = .FALSE. Goto 1000 Endif Endif 1030 Continue 1040 Continue Close (u1) End