*
* $Id: pfhigz.F,v 1.2 1996/04/24 08:19:56 dinofm Exp $
*
* $Log: pfhigz.F,v $
* Revision 1.2  1996/04/24 08:19:56  dinofm
* Handling of two 'new' remote HIGZ command: IGCOLM and IPM4ID (that were
* previously dummied out on PIAF)
*
* Revision 1.1.1.1  1996/03/01 11:38:45  mclareni
* Paw
*
*
#include "paw/pilot.h"
*CMZ :  2.04/09 15/12/93  15.22.11  by  Fons Rademakers
*-- Author :    Alfred Nathaniel   02/05/93
      SUBROUTINE PFHIGZ(CHMESS,CHLINE,ISLAV,ISTAT)
************************************************************************
*                                                                      *
* Remote HIGZ procedure calls from the master server to the client or  *
* from a slave server to the master server. In case a slave calls the  *
* master, the master in turn makes an RPC to the client and, when      *
* necessary, relays the output parameter(s) back to the slave.         *
*                                                                      *
************************************************************************
*
#include "hbook/hcbook.inc"
#include "hbook/hcpiaf.inc"
*
      CHARACTER*(*) CHMESS, CHLINE
      REAL          RVAL(4)
      CHARACTER     CHMAIL*80, CHOPT*16, CHPID*32
*
*-- IGQ cache used on master server
*
      PARAMETER     (MAXOPT = 20)
      CHARACTER*4    IGOPT(MAXOPT)
      REAL           RGVAL(4,MAXOPT)
      INTEGER        NIGOPT, NIGPID, IC1DUM, INIID, INICOL
*
      SAVE           IGOPT, RGVAL, NIGOPT, NIGPID, INIID, INICOL
*
      ISTAT = 0
*
      IF (CHMESS.EQ.'IGPID') THEN
*
         READ(CHLINE,'(2I12,A,A)') ILEVI,IPID,CHOPT,CHPID
* When master server, relay only the first call to IGPID to the client
         IF (MASTPF) THEN
            IF (NIGPID .EQ. 0) THEN
               NIGPID = 1
               CALL PFSOCK(0)
               CALL IGPID(ILEVI,CHPID,IPID,CHOPT)
            ENDIF
         ELSE
            CALL IGPID(ILEVI,CHPID,IPID,CHOPT)
         ENDIF
*
      ELSEIF (CHMESS.EQ.'IGQ') THEN
*
         READ(CHLINE,'(E16.8,A)') RVAL(1),CHOPT
*
*-- When on master check if option values are already in cache, if they are
*-- don't go to client
*
         IF (MASTPF) THEN
            DO 10 I = 1, NIGOPT
               IF (CHOPT .EQ. IGOPT(I)) THEN
                  WRITE(CHMAIL,'(4E16.8)') (RGVAL(J,I),J=1,4)
                  CALL CZPUTA(CHMAIL,ISTAT)
                  RETURN
               ENDIF
   10       CONTINUE
         ENDIF
*
         IF (MASTPF) CALL PFSOCK(0)
         CALL IGQ(CHOPT,RVAL(1))
         WRITE(CHMAIL,'(4E16.8)') (RVAL(I),I=1,4)
         IF (MASTPF) CALL PFSOCK(ISLAV)
         CALL CZPUTA(CHMAIL,ISTAT)
*
*-- Fill the cache
*
         IF (MASTPF .AND. NIGOPT.LT.MAXOPT) THEN
            NIGOPT = NIGOPT + 1
            IGOPT(NIGOPT) = CHOPT
            DO 20 I = 1, 4
               RGVAL(I,NIGOPT) = RVAL(I)
   20       CONTINUE
         ENDIF
*
      ELSEIF (CHMESS.EQ.'IGSET') THEN
*
         READ(CHLINE,'(E16.8,A)') RVAL(1),CHOPT
         IF (MASTPF) CALL PFSOCK(0)
         CALL IGSET(CHOPT,RVAL(1))
*
      ELSEIF (CHMESS.EQ.'IGCOLM') THEN
*
         READ(CHLINE,'(I12,A)') IC2,CHOPT
         CALL CZGETA(CHMAIL,ISTAT)
         READ(CHMAIL,'(3E16.8)') X1,X2,Y1 
         CALL CZGETA(CHMAIL,ISTAT)
         READ(CHMAIL,'(3E16.8)') Y2,ZMIN,ZMAX 
         IF (MASTPF) THEN
            IF (INICOL.EQ.0) THEN
               INICOL = 1
               CALL PFSOCK(0)
               CALL IGCOLM(X1,X2,Y1,Y2,IC1DUM,IC2,ZMIN,ZMAX,CHOPT)
            ENDIF
         ELSE  
            CALL IGCOLM(X1,X2,Y1,Y2,IC1DUM,IC2,ZMIN,ZMAX,CHOPT)
         ENDIF
*
      ELSEIF (CHMESS.EQ.'IPL3') THEN
*
         READ(CHLINE,'(I12)') N
         NUH=0
         CALL FZIN(999,IHWORK,LPIAF,2,' ',NUH,0)
         IF (MASTPF) CALL PFSOCK(0)
         CALL IPL3(N,Q(LPIAF+1),Q(LPIAF+N+1),Q(LPIAF+N*2+1))
         CALL MZDROP(IHWORK,LPIAF,' ')
*
      ELSEIF (CHMESS.EQ.'IPL') THEN
*
         READ(CHLINE,'(I12)') N
         NUH=0
         CALL FZIN(999,IHWORK,LPIAF,2,' ',NUH,0)
         IF (MASTPF) CALL PFSOCK(0)
         CALL IPL(N,Q(LPIAF+1),Q(LPIAF+N+1))
         CALL MZDROP(IHWORK,LPIAF,' ')
*
      ELSEIF (CHMESS.EQ.'IPM') THEN
*
         READ(CHLINE,'(I12)') N
         NUH=0
         CALL FZIN(999,IHWORK,LPIAF,2,' ',NUH,0)
         IF (MASTPF) CALL PFSOCK(0)
         CALL IPM(N,Q(LPIAF+1),Q(LPIAF+N+1))
         CALL MZDROP(IHWORK,LPIAF,' ')
*
      ELSEIF (CHMESS.EQ.'IPMID') THEN
*
         READ(CHLINE,'(2I12)') N,LEVEL
         NUH=0
         CALL FZIN(999,IHWORK,LPIAF,2,' ',NUH,0)
         NUH=0
         CALL FZIN(999,IHWORK,LPIAF2,2,' ',NUH,0)
         IF (MASTPF) CALL PFSOCK(0)
         CALL IPMID(N,Q(LPIAF+1),Q(LPIAF+N+1),LEVEL,IQ(LPIAF2+1))
         CALL MZDROP(IHWORK,LPIAF,' ')
         CALL MZDROP(IHWORK,LPIAF2,' ')
*
      ELSEIF (CHMESS.EQ.'IPM3ID') THEN
*
         READ(CHLINE,'(2I12)') N,LEVEL
         NUH=0
         CALL FZIN(999,IHWORK,LPIAF,2,' ',NUH,0)
         NUH=0
         CALL FZIN(999,IHWORK,LPIAF2,2,' ',NUH,0)
         IF (MASTPF) CALL PFSOCK(0)
         CALL IPM3ID(N,Q(LPIAF+1),Q(LPIAF+N+1),Q(LPIAF+N*2+1),
     +          LEVEL,IQ(LPIAF2+1))
         CALL MZDROP(IHWORK,LPIAF,' ')
         CALL MZDROP(IHWORK,LPIAF2,' ')
*
      ELSEIF (CHMESS.EQ.'IPM4ID') THEN
*
         READ(CHLINE,'(2I12,2E15.9)') N,LEVEL,V,W
         NUH=0
         CALL FZIN(999,IHWORK,LPIAF,2,' ',NUH,0)
         NUH=0
         CALL FZIN(999,IHWORK,LPIAF2,2,' ',NUH,0)
         IF (MASTPF) THEN
            IF (INIID.EQ.0) THEN
*               INIID = 1
               CALL PFSOCK(0)
               CALL IPM4ID(N,Q(LPIAF+1),Q(LPIAF+N+1),Q(LPIAF+N*2+1),
     +                Q(LPIAF+N*3+1),V,W,LEVEL,IQ(LPIAF2+1))
            ENDIF
         ELSE  
            CALL IPM4ID(N,Q(LPIAF+1),Q(LPIAF+N+1),Q(LPIAF+N*2+1),
     +             Q(LPIAF+N*3+1),V,W,LEVEL,IQ(LPIAF2+1))
         ENDIF
         CALL MZDROP(IHWORK,LPIAF,' ')
         CALL MZDROP(IHWORK,LPIAF2,' ')
*
      ELSEIF (CHMESS.EQ.'ISPMCI') THEN
*
         READ(CHLINE,'(I12)') ICOLI
         IF (MASTPF) CALL PFSOCK(0)
         CALL ISPMCI(ICOLI)
*
      ELSEIF (CHMESS.EQ.'CLEAR') THEN
*
*-- Clear IGQ cache
*
         NIGOPT = 0
         NIGPID = 0
         INICOL = 0
         INIID  = 0
*
      ELSE
         PRINT *,' PFHIGZ:',CHMESS,'?? '
      ENDIF
*
      END