      SUBROUTINE DJ2000(DAY,I,J,K,JHR,MI,SEC)
CCP  COMPUTES CALENDER DATE FROM MODIFIED JULIAN DAY 2000
CC   VALID FOR DATES BETWEEN 1950/JAN/1 AND 2099/DEC/31.
CC   MJD(2000) = MJD(1950) - 18262.0 IS = 0 ON 2000/01/01 AT 00:00:00.
CC
CCI  (REAL*8) DAY = MOD. JULIAN DAY, REFERRED TO 2000 (MAY BE NEGATIVE).
CCO  (INTEGERS): I=YEAR, J=MONTH, K=DAY, JHR=HOUR, MI=MINUTE
CCO  (REAL*8): SEC=SECOND.
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/oalib/orblib/src/SCCS/s.dj2000.f	',
C     &'1.3	94/11/18 	ORBLIB\n'/
CC
      IMPLICIT REAL*8(A-H,O-Z)
CC  MAKE SURE TO ROUND-OFF ONLY DOWN, ALSO FOR NEGATIVE MJD:
      JDAY = DAY + 18262.D0
      L = (4000*(JDAY + 18204))/1461001
      N = JDAY - (1461*L)/4 + 18234
      M = (80*N)/2447
      K = N - (2447*M)/80
      JJ = M/11
      J = M + 2 - 12*JJ
      I = 1900 + L + JJ
      SEC = (DAY - DFLOAT(JDAY-18262))*24.D0
      JHR = SEC
      SEC = (SEC - DFLOAT(JHR))*6.D1
      MI = SEC
      SEC = (SEC - DFLOAT(MI))*6.D1
      RETURN
      END
 
 
 
 
      SUBROUTINE DRSORT(N,L,KEY,XP,X,IRET)
CCP ORIGINAL QUICKSORT SORTS A LIST OF ITEMS IN INCREASING ORDER
CCP OF A REAL*8 KEY (HOARE ALGORITHM 1961/1962)
CCC PROJ=GEN,SUBJ=NUM,UTIL=MULT,AUTH=SCHUETZ/SAB
CCI N      I4        NUMBER OF ITEMS TO BE SORTED (NOT GREATER THAN
CCI                  131072=2**17)
CCI L      I4        ITEM LENGTH
CCI KEY    I4        KEY LOCATION WITHIN THE ITEM (FIRST LOCATION IS 1)
CCI XP     R8      L WORKING AREA
CCI X      R8    L*N LIST OF ITEMS TO BE SORTED
CCO X      R8    L*N LIST OF SORTED ITEMS
CCO IRET   I4        RETURN CODE    0 IF OK
CCO                                 1 IF INVALID INPUT
CC-----------------------------------------------------------------------
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/oalib/attlib/src/SCCS/s.drsort.f	',
C     &'1.3	94/11/17 	ATTLIB\n'/
CC
      IMPLICIT INTEGER*4 (A-Z)
      DIMENSION LV(18),UV(18)
      REAL*8 XP(1),X(1),Y
CC-----------------------------------------------------------------------
CC
CC  INITIALISE PUSH-DOWN LIST
      IRET=1
      IF(KEY.LE.0.OR.KEY.GT.L.OR.N.LE.0.OR.N.GT.131072) GO TO 100
      IRET=0
      K=KEY-1
      L2=L*2
      LV(1)=1
      UV(1)=(N-1)*L+1
      P=1
CC
CC  PARTITION NEXT SEGMENT
10    CONTINUE
      IF(P.LT.1) GO TO 100
20    CONTINUE
      IF((UV(P)-LV(P)).GE.L) GO TO 30
      P=P-1
      GO TO 10
30    CONTINUE
      LP=LV(P)-L
      UP=UV(P)
CC
CC  CHOOSE BOUND
      Y=X(UP+K)
      DO 35 I=1,L
      JU=UP+I
      XP(I)=X(JU-1)
35    CONTINUE
CC
CC  MOVE LOWER POINTER
40    CONTINUE
      IF((UP-LP).LT.L2) GO TO 70
      LP=LP+L
      IF(X(LP+K).LE.Y) GO TO 40
      DO 45 I=1,L
      JU=UP+I
      JL=LP+I
      X(JU-1)=X(JL-1)
45    CONTINUE
CC
CC  MOVE UPPER POINTER
50    CONTINUE
      IF((UP-LP).LT.L2) GO TO 60
      UP=UP-L
      IF(X(UP+K).GE.Y) GO TO 50
      DO 55 I=1,L
      JL=LP+I
      JU=UP+I
      X(JL-1)=X(JU-1)
55    CONTINUE
      GO TO 40
CC
CC  FINISH UP
60    CONTINUE
      UP=UP-L
70    CONTINUE
      DO 75 I=1,L
      JU=UP+I
      X(JU-1)=XP(I)
75    CONTINUE
      IF((UP-LV(P)).GE.(UV(P)-UP)) GO TO 80
      LV(P+1)=LV(P)
      UV(P+1)=UP-L
      LV(P)=UP+L
      GO TO 90
80    CONTINUE
      LV(P+1)=UP+L
      UV(P+1)=UV(P)
      UV(P)=UP-L
90    CONTINUE
      P=P+1
      GO TO 20
100   CONTINUE
      RETURN
      END
 
 
 
 
      INTEGER FUNCTION GETUN (MINU, MAXU)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE GETUN                       |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  RETURNS THE FIRST FREE UNIT BETWEEN MINU AND MAXU TO OPEN A FILE  |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  MINU           I*4       MINIMUM UNIT TO SEARCH FOR               |
CC |  MAXU           I*4       MAXIMUM UNIT TO SEARCH FOR               |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  RETURNS A UNIT IN SUCCESS 0 IF FAILED                             |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  IMPLICIT FUNCTIONS ONLY                                                  |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/07 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/src/SCCS/s.getun.F	',
C     &'1.4	00/10/13 	OAD_IMSS\n'/
CC
      INTEGER MINU, MAXU
CC
CC    LOCAL VARIABLES
CC
      INTEGER TRY
      LOGICAL EX, OD
CC
      GETUN = 0
      IF (MINU.LE.0.OR.MAXU.LE.0.OR.MINU.GT.MAXU) THEN
         WRITE (0,*) 'GETUN::ERROR: Boundary units out of range'
         RETURN
      ENDIF
      DO 100 TRY=MINU, MAXU
         INQUIRE (UNIT = TRY, ERR = 10, EXIST = EX, OPENED = OD)
         IF (EX.AND.(.NOT.OD)) THEN
            GETUN = TRY
            RETURN
         ENDIF
 100  CONTINUE
      WRITE (0,*) 'GETUN::ERROR: No unit found'
      RETURN
 10   WRITE (0,*) 'GETUN::ERROR: when calling INQUIRE'
      RETURN
      END
 
 
 
 
      SUBROUTINE HERMDE (X, FS, DS, XI, NMAX, NMVARS, NFMAX, NSHIFT, 
     .                     N, NVARS, NDERS, F, IER)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE HERMDE                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  PERFORMS AN HERMITE INTERPOLATION (USING FUNCTION AND DERIVATIVE) |
CC |  OF A TABLE OF POINTS. THE INDEPENDENT VARIABLE OF POINT J IS      |
CC |  NORMALLY AT X(J), THE FUNCTION AT FS(1,J)..FS(NVARS,J) AND THE    |
CC |  DERIVATIVE AT DS(1,J)..DS(NVARS,J). HOWEVER, IF NSHIFT IS NOT     |
CC |  0, EVERYTHING IS SHIFTED: POINT J GOES TO X(J+NSHIFT)... THIS     |
CC |  IS DONE THIS WAY, SO THAT THE ARRAYS ARE CICLIC. IF IN A          |
CC |  SUBSEQUENT CALL THE FIRST POINT IS REMOVED AND A NEW POINT IS     |
CC |  ADDED, IT IS ENOUGHT TO PASS THE SHIFT, INSTEAD OF FILLING        |
CC |  AGAIN THE FULL TABLE.                                             |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  X(NMAX)            R*8    VECTOR OF INDEPENDENT VARIABLES (CYCLIC)|
CC |  FS(NMVARS, NMAX)   R*8    VECTOR OF DEPENDENT VARIABLES (CYCLIC)  |
CC |  DS(NMVARS, NMAX)   R*8    VECTOR OF DERIVATIVES (CYCLIC)          |
CC |  XI                 R*8    TIME TO FIND INTERPOLATE                |
CC |  NMAX               I*4    DIMENSION OF ARRAYS (-> N)              |
CC |  NMVARS             I*4    DIMENSION OF ARRAYS (-> NVARS)          |
CC |  NFMAX              I*4    DIMENSION OF ARRAYS (-> NDERS)          |
CC |  NSHIFT             I*4    NUMBER OF POINTS TO SHIFT               |
CC |  N                  I*4    NUMBER OF POINTS TO INTERPOLATE         |
CC |  NVARS              I*4    NUMBER OF DEPENDENT VARIABLES           |
CC |  NDERS              I*4    NUMBER OF DERIVATIVES TO COMPUTE        |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  F(NFMAX, *)       R*8    VECTOR OF INTERPOLATED FUNCTIONS         |
CC |                            AND DERIVATIVES                         |
CC |  IER                I*4    ERROR CODE, 0 FOR SUCCESS, NO ERRORS    |
CC |                            IDENTIFIED YET, BUT PARAMETER USED TO   |
CC |                            AVOID UPGRADES OF CLIENT SW IN THE      |
CC |                            FUTURE                                  |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  IMPLICIT FUNCTIONS ONLY                                           |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/16 --- CREATION                             |
CC |  V. Companys --- 98/04/17 --- CONVERT TO SUBROUTINE                |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC234567890123456789012345678901234567890123456789012345678901234567890123
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/math/interpolation/src/SCCS/s.hermde.F	',
C     &'1.5	01/11/21 	OAD_IMSS\n'/
CC
      INTEGER NMAX, NMVARS, NSHIFT, N, NVARS, IER, NDERS, NFMAX
      DOUBLE PRECISION X(NMAX), FS(NMVARS, NMAX), DS(NMVARS, NMAX),
     .                 XI, F(NFMAX,1)
      INTEGER IN, I, J, K, L, ID, ID1
CC
CC    DEFINING STATEMENT FUNCTION FOR COMPUTING THE INDEX
CC
      INTEGER NMAXDE
      PARAMETER (NMAXDE=10)
      DOUBLE PRECISION FAC1(0:NMAXDE), FAC2, SUM, FAC22
      DOUBLE PRECISION PHI0(0:NMAXDE), PHI1(0:NMAXDE)
      DOUBLE PRECISION NUMCOM (0:NMAXDE,0:NMAXDE)
      DATA NUMCOM/
     . 1.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 1.D0,
     . 1.D0, 1.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 1.D0,
     . 1.D0, 2.D0, 1.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 1.D0,
     . 1.D0, 3.D0, 3.D0, 1.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 1.D0,
     . 1.D0, 4.D0, 6.D0, 4.D0, 1.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 1.D0,
     . 1.D0, 5.D0,10.D0,10.D0, 5.D0, 1.D0, 0.D0, 0.D0, 0.D0, 0.D0, 1.D0,
     . 1.D0, 6.D0,15.D0,20.D0,15.D0, 6.D0, 1.D0, 0.D0, 0.D0, 0.D0, 1.D0,
     . 1.D0, 7.D0,21.D0,35.D0,35.D0,21.D0, 7.D0, 1.D0, 0.D0, 0.D0, 1.D0,
     . 1.D0, 8.D0,28.D0,56.D0,70.D0,56.D0,28.D0, 8.D0, 1.D0, 0.D0, 1.D0,
     . 1.D0, 9.D0,36.D0,84.D0,126.D0,126.D0,84.D0,36.D0,9.D0,1.D0, 1.D0,
     . 1.D0,10.D0,45.D0,120.D0,210.D0,252.D0,210.D0,120.D0,45.D0,10.D0,
     .   1.D0/
CC
      IN (J) = MOD (J + NMAX + NSHIFT - 1, NMAX) + 1
CC
CC    COMPUTE FAC1 = (X-X1)**2 * (X-X2)**2 ...
CC
      DO 5 I = 1,NVARS
         DO 5 ID=1,NDERS+1
            F(I, ID) = 0.D0
 5    CONTINUE
      J = IN(1)
      K = IN (N)
CC
CC   CHECKS WHETHER THE DATA IS INDEXED FROM J TO K OR BY THE TWO
CC   INTERVALS J TO NMAX AND 1 TO K
CC
      IF (K.GE.J) THEN
CC
CC   FOR EACH POINT
CC
         DO 200 I = J, K
CC
CC   COMPUTE PHI1, THE POLINOMIAL WHICH HAS 0 VALUES AT 
CC   ANY POINT AND 0 DERIVATIVES, EXCEPT FOR POINT I WHERE THE
CC   DERIVATIVE IS 1
CC
            FAC1(0) = 1.D0
            DO 10 ID=1,NDERS
               FAC1(ID) = 0.D0
 10         CONTINUE
            FAC2 = 1.D0
            DO 30 L=J,I-1
               DO 20 ID=NDERS,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 20            CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 30         CONTINUE
            DO 50 L=I+1,K
               DO 40 ID=NDERS,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 40            CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 50         CONTINUE
            FAC22 = FAC2 * FAC2
            DO 70 ID=0,NDERS
               PHI0(ID) = 0.D0
               DO 60 ID1=0, ID
                  PHI0(ID) = PHI0(ID) + NUMCOM(ID1,ID) * FAC1(ID1)
     .                                                 * FAC1(ID-ID1)
 60            CONTINUE
               PHI0(ID) = PHI0(ID) / FAC22
 70         CONTINUE
            DO 80 ID=NDERS,1, -1
               PHI1(ID) = PHI0(ID)*(XI-X(I))+DBLE(ID)*PHI0(ID-1)
 80         CONTINUE
            PHI1(0) = PHI0(0) * (XI - X(I))
CC
CC   COMPUTE PHI0, THE POLINOMIAL WHICH HAS 0 VALUES AT 
CC   ANY POINT EXCEPT FOR POINT I WHERE THE
CC   FUNCTION IS 1 AND 0 DERIVATIVES EVERYWHERE
CC
            SUM = 0.D0
            DO 100 L=J, I-1
               SUM=SUM+1.D0/(X(I)-X(L))
 100        CONTINUE
            DO 110 L=I+1, K
               SUM=SUM+1.D0/(X(I)-X(L))
 110        CONTINUE

            DO 120 ID=0,NDERS
               PHI0(ID)=PHI0(ID)-2.D0*SUM*PHI1(ID)
 120        CONTINUE
            DO 140 L=1,NVARS
               DO 130 ID=0,NDERS
                  F(L,ID+1)=F(L,ID+1)+PHI0(ID)*FS(L,I)+PHI1(ID)*DS(L,I)
 130           CONTINUE
 140        CONTINUE
 200     CONTINUE

      ELSE
CC
CC   THIS CASE IS THE SAME BUT TAKING INTO ACCOUNT 
CC   THAT THE TABLE IS SPLITED IN TWO PIECES, FROM J TO NMAX
CC   AND FROM 1 TO K
CC
         DO 400 I = J, NMAX
            FAC1(0) = 1.D0
            DO 210 ID=1,NDERS
               FAC1(ID) = 0.D0
 210        CONTINUE
            FAC2 = 1.D0
            DO 230 L=J,I-1
               DO 220 ID=NDERS,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 220            CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 230        CONTINUE
            DO 250 L=I+1,NMAX
               DO 240 ID=NDERS,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 240           CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 250        CONTINUE
            DO 270 L=1,K
               DO 260 ID=NDERS,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 260           CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 270        CONTINUE
            FAC22 = FAC2 * FAC2
            DO 290 ID=0,NDERS
               PHI0(ID) = 0.D0
               DO 280 ID1=0, ID
                  PHI0(ID) = PHI0(ID) + NUMCOM(ID1,ID) * FAC1(ID1)
     .                                                 * FAC1(ID-ID1)
 280           CONTINUE
               PHI0(ID) = PHI0(ID) / FAC22
 290        CONTINUE
            DO 300 ID=NDERS,1, -1
               PHI1(ID) = PHI0(ID)*(XI-X(I))+DBLE(ID)*PHI0(ID-1)
 300        CONTINUE
            PHI1(0) = PHI0(0) * (XI - X(I))
            SUM = 0.D0
            DO 310 L=J, I-1
               SUM=SUM+1.D0/(X(I)-X(L))
 310        CONTINUE
            DO 320 L=I+1, NMAX
               SUM=SUM+1.D0/(X(I)-X(L))
 320        CONTINUE
            DO 330 L=1, K
               SUM=SUM+1.D0/(X(I)-X(L))
 330        CONTINUE

            DO 340 ID=0,NDERS
               PHI0(ID)=PHI0(ID)-2.D0*SUM*PHI1(ID)
 340        CONTINUE
            DO 360 L=1, NVARS
               DO 350 ID=0, NDERS
                  F(L,ID+1)=F(L,ID+1)+PHI0(ID)*FS(L,I)+PHI1(ID)*DS(L,I)
 350           CONTINUE
 360        CONTINUE
 400     CONTINUE

         DO 700 I = 1, K
            FAC1(0) = 1.D0
            DO 500 ID=1,NDERS
               FAC1(ID) = 0.D0
 500        CONTINUE
            FAC2 = 1.D0
            DO 520 L=J,NMAX
               DO 510 ID=NDERS,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 510           CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 520           CONTINUE
            DO 540 L=1,I-1
               DO 530 ID=NDERS,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 530           CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 540           CONTINUE
            DO 560 L=I+1,K
               DO 550 ID=NDERS,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 550           CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 560           CONTINUE
            FAC22 = FAC2 * FAC2
            DO 580 ID=0,NDERS
               PHI0(ID) = 0.D0
               DO 570 ID1=0, ID
                  PHI0(ID) = PHI0(ID) + NUMCOM(ID1,ID) * FAC1(ID1)
     .                                                 * FAC1(ID-ID1)
 570           CONTINUE
               PHI0(ID) = PHI0(ID) / FAC22
 580        CONTINUE
            DO 590 ID=NDERS,1, -1
               PHI1(ID) = PHI0(ID)*(XI-X(I))+DBLE(ID)*PHI0(ID-1)
 590        CONTINUE
            PHI1(0) = PHI0(0) * (XI - X(I))
            SUM = 0.D0

            DO 600 L=J, NMAX
               SUM=SUM+1.D0/(X(I)-X(L))
 600        CONTINUE
            DO 610 L=1, I-1
               SUM=SUM+1.D0/(X(I)-X(L))
 610        CONTINUE
            DO 620 L=I+1, K
               SUM=SUM+1.D0/(X(I)-X(L))
 620        CONTINUE

            DO 630 ID=0,NDERS
               PHI0(ID)=PHI0(ID)-2.D0*SUM*PHI1(ID)
 630        CONTINUE
            DO 660 L=1, NVARS
               DO 650 ID=0, NDERS
                  F(L,ID+1)=F(L,ID+1)+PHI0(ID)*FS(L,I)+PHI1(ID)*DS(L,I)
 650           CONTINUE
 660        CONTINUE
 700     CONTINUE

      ENDIF
      IER = 0
      RETURN
      END
































 
 
 
 
      SUBROUTINE JD2000(DAY,JEAR,MONTH,KDAY,JHR,MI,SEC)
CCP GIVES THE NEW MOD. JULIAN DAY (MJD=0.0 ON 2000/JAN/1 AT 0:00:00)
CCP FOR INPUT CALENDAR DATES BETWEEN 1950/JAN/1 AND 2099/DEC/31.
CC
CC   MJD(2000) = MJD(1950) - 18262.0
CC
CCI  (INT*4) JEAR = YEAR WITH 2 OR 4 DIGITS; 2 DIGITS => 1950 TO 2049
CCI  (INT*4) MONTH = MONTH
CCI  (INT*4) KDAY = DAY
CCI  (INT*4) JHR = HOUR
CCI  (INT*4) MI = MINUTE
CCI  (REAL*8) SEC = SECOND.
CCO  (REAL*8) DAY = MOD. JUL. DAY, REFERRED TO 2000.
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/oalib/orblib/src/SCCS/s.jd2000.f	',
C     &'1.3	94/11/18 	ORBLIB\n'/
CC
      IMPLICIT REAL*8(A-H,O-Z)
      JJ = (14 - MONTH)/12
      L = JEAR - JJ - 1900*(JEAR/1900) + 100*(2000/(JEAR+1951))
      DAY = KDAY-36496+(1461*L)/4+(367*(MONTH-2+JJ*12))/12
      DAY = DAY + (DFLOAT((JHR*60 + MI)*60) + SEC)/864.D2
      RETURN
      END
 
 
 
 
      SUBROUTINE LAGRDE (X, FS, XI, NMAX, NMVARS, NFMAX, NSHIFT, 
     .                     N, NVARS, NDER, F, IER)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE LAGRDE                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | APR 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  PERFORMS A LAGRANGE INTERPOLATION                                 |
CC |  OF A TABLE OF POINTS. THE INDEPENDENT VARIABLE OF POINT J IS      |
CC |  NORMALLY AT X(J), THE FUNCTION AT FS(1,J)..FS(NVARS,J)            |
CC |  HOWEVER, IF NSHIFT IS NOT                                         |
CC |  0, EVERYTHING IS SHIFTED: POINT J GOES TO X(J+NSHIFT)... THIS     |
CC |  IS DONE THIS WAY, SO THAT THE ARRAYS ARE CICLIC. IF IN A          |
CC |  SUBSEQUENT CALL THE FIRST POINT IS REMOVED AND A NEW POINT IS     |
CC |  ADDED, IT IS ENOUGHT TO PASS THE SHIFT, INSTEAD OF FILLING        |
CC |  COMPARED WITH ORBLIB VERSION IT ALLOWS CICLIC ARRAYS, AND MAKES   |
CC |  LESS IF STATEMENTS                                                |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  X(NMAX)            R*8    VECTOR OF INDEPENDENT VARIABLES (CYCLIC)|
CC |  FS(NMVARS, NMAX)   R*8    VECTOR OF DEPENDENT VARIABLES (CYCLIC)  |
CC |  XI                 R*8    TIME TO FIND INTERPOLATE                |
CC |  NMAX               I*4    DIMENSION OF ARRAYS                     |
CC |  NMVARS             I*4    DIMENSION OF ARRAYS                     |
CC |  NFMAX             I*4    DIMENSION OF ARRAYS                     |
CC |  N                  I*4    NUMBER OF POINTS TO INTERPOLATE         |
CC |  NDER               I*4    MAXIMUM ORDER OF DERTIVATIVES           |
CC |  NVARS              I*4    NUMBER OF DEPENDENT VARIABLES           |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  F(NFMAX, *)       R*8    VECTOR OF INTERPOLATED FUNCTIONS        |
CC |                            AND THEIR DERIVATIVES                   |
CC |  FD(NMVARS)         R*8    VECTOR OF DERIVATIVES OF                |
CC |                            INTERPOLATED FUNCTIONS(CYCLIC)          |
CC |  IER                I*4    ERROR CODE, 0 IN SUCCESS. NO FAILURE    |
CC |                            CASES IMPLEMENTED YET                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  IMPLICIT FUNCTIONS ONLY                                           |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/16 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/math/interpolation/src/SCCS/s.lagrde.F	',
C     &'1.2	00/07/14 	OAD_IMSS\n'/
      INTEGER  NMAX, NMVARS, NSHIFT, N, NVARS, IER, NFMAX
      DOUBLE PRECISION X(NMAX), FS(NMVARS, NMAX),
     .                 XI, F(NFMAX,1)
      INTEGER IN, I, J, K, L, ID, NDER
CC
CC    DEFINING STATEMENT FUNCTION FOR COMPUTING THE INDEX
CC
      INTEGER NMAXDE
      PARAMETER (NMAXDE=10)
      DOUBLE PRECISION FAC1(0:NMAXDE), FAC2, PHI0(0:NMAXDE)
      IN (J) = MOD (J + NMAX + NSHIFT - 1, NMAX) + 1
CC
CC
      DO 5 I = 1,NVARS
         DO 2 ID=1,NDER+1
            F(I, ID) = 0.D0
 2       CONTINUE
 5    CONTINUE
      J = IN(1)
      K = IN (N)
      IF (K.GE.J) THEN
CC
CC   FOR EACH POINT
CC
         DO 90 I = J, K
CC
CC   COMPUTE PHI0, THE POLINOMIAL WHICH HAS 0 VALUES AT 
CC   ANY POINT EXCEPT FOR POINT I WHERE THE
CC   FUNCTION IS 1
CC
            FAC1(0) = 1.D0
            DO 10 ID=1,NDER
               FAC1(ID) = 0.D0
 10         CONTINUE
            FAC2 = 1.D0
            DO 30 L=J,I-1
               DO 20 ID=NDER,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 20            CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 30         CONTINUE
            DO 50 L=I+1,K
               DO 40 ID=NDER,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 40            CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 50         CONTINUE
            DO 60 ID=0,NDER
               PHI0(ID) = FAC1(ID) / FAC2
 60         CONTINUE
            DO 80 L=1,NVARS
               DO 80 ID=0,NDER
                  F(L, ID+1) = F(L, ID+1) + PHI0(ID) * FS (L,I)
 80         CONTINUE
 90      CONTINUE
      ELSE
CC
CC   THIS CASE IS THE SAME BUT HAVING INTO ACCOUNT 
CC   THAT THE TABLE IS SPLITED IN TWO PIECES, FROM J TO NMAX
CC   AND FROM 1 TO K
CC
         DO 200 I = J, NMAX
            FAC1(0) = 1.D0
            DO 110 ID=1,NDER
               FAC1(ID) = 0.D0
 110        CONTINUE
            FAC2 = 1.D0
            DO 130 L=J,I-1
               DO 120 ID=NDER,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 120           CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 130        CONTINUE
            DO 150 L=I+1,NMAX
               DO 140 ID=NDER,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 140           CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 150        CONTINUE
            DO 170 L=1,K
               DO 160 ID=NDER,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 160           CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 170        CONTINUE
            DO 180 ID=0,NDER
               PHI0(ID) = FAC1(ID) / FAC2
 180        CONTINUE
            DO 190 L=1,NVARS
               DO 190 ID=0,NDER
                  F(L, ID+1) = F(L, ID+1) + PHI0(ID) * FS (L,I)
 190        CONTINUE
 200     CONTINUE
         DO 290 I = 1, K
            FAC1(0) = 1.D0
            DO 205 ID=1,NDER
               FAC1(ID) = 0.D0
 205        CONTINUE
            FAC2 = 1.D0
            DO 220 L=J,NMAX
               DO 210 ID=NDER,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 210           CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 220        CONTINUE
            DO 240 L=1,I-1
               DO 230 ID=NDER,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 230           CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 240        CONTINUE
            DO 260 L=I+1,K
               DO 250 ID=NDER,1, -1
                  FAC1(ID) = FAC1(ID)*(XI-X(L))+DBLE(ID)*FAC1(ID-1)
 250           CONTINUE
               FAC1(0) = FAC1(0) * (XI - X(L))
               FAC2 = FAC2 * (X(I) - X(L))
 260        CONTINUE
            DO 270 ID=0,NDER
               PHI0(ID) = FAC1(ID) / FAC2
 270        CONTINUE
            DO 280 L=1,NVARS
               DO 280 ID=0,NDER
                  F(L, ID+1) = F(L, ID+1) + PHI0(ID) * FS (L,I)
 280        CONTINUE
 290      CONTINUE
      ENDIF
      IER = 0
      RETURN
      END
 
 
 
 
      SUBROUTINE QDRATE (Q, QD, QN, OMG)
CC
CCP    CALCULATE S/C RATE FROM QUATERNION AND ITS DERIVATIVE AND
CCP    NORMALISE QUATERNION
CC
CCC    PROJ=GEN,SUBJ=ATT,UTIL=GEN,AUTH=U.HERFORT TOS-G/FDD/IMSS
CCC    02/03/19
CC
CC     CALLING SEQUENCE:
CC     INPUT:
CCI    Q         R*8(4)      UNNORMALISED QUATERNION
CCI    QD        R*8(4)      TIME DERIVATIVE OF QUATERNION (1/DAY)
CC
CC     OUTPUT:
CCO    QN        R*8(4)      NORMALISED QUATERNION
CCO    OMG       R*8(3)      RATE IN S/C FRAME (RAD/S)

CC     HEADER VARIABLES
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imsatt/atthist/attfil/src/SCCS/s.qdrate.F	',
C     &'1.1	02/03/19 	IMSS_FDD\n'/
CC
      DOUBLE PRECISION Q(4), QD(4), QN(4), OMG(3)

CC     LOCAL VARIABLES
      DOUBLE PRECISION FAC1, FAC2, FAC3, QNRM2, QDD(4)
      INTEGER I

CC     TWICE THE NUMBER OF DAYS IN A SECOND
      PARAMETER (FAC3=2D0/(24D0*3600D0))

CC     CALCULATE NORMALISATION FACTORS
      QNRM2 = Q(1)**2 + Q(2)**2 + Q(3)**2 + Q(4)**2
      FAC1 = 1D0/SQRT(QNRM2)
      FAC2 = (Q(1)*QD(1) + Q(2)*QD(2) + Q(3)*QD(3) + Q(4)*QD(4))/QNRM2

CC     CALCULATE NORMALISED QUATERNION AND TWICE ITS DERIVATIVE.
CC     TRANSFORM DERIVATIVE FROM 1/DAY TO 1/SEC.
      DO 10 I = 1, 4
         QDD(I) = FAC1*FAC3*(QD(I)-FAC2*Q(I))
         QN(I)  = FAC1*Q(I)
 10   CONTINUE

CC     CALCULATE RATE. IN THE S/C FRAME THE ANGULAR RATE
CC     IS GIVEN BY OMEGA = 2 Q^(-1) QDOT.
      OMG(1) = QN(4)*QDD(1) - QN(1)*QDD(4) + QN(3)*QDD(2) - QN(2)*QDD(3)
      OMG(2) = QN(1)*QDD(3) - QN(3)*QDD(1) + QN(4)*QDD(2) - QN(2)*QDD(4)
      OMG(3) = QN(2)*QDD(1) - QN(1)*QDD(2) + QN(4)*QDD(3) - QN(3)*QDD(4)

      END
 
 
 
 
      SUBROUTINE QUANRM (Q0, Q1)
CC
CCP    NORMALISES QUATERNION
CC
CC     CALLING SEQUENCE:
CC     INPUT:
CCI    Q0        R*8(4)      QUATERNION TO BE NORMALISED
CC
CC     OUTPUT:
CCO    Q1        R*8(4)      NORMALISED QUATERNION

CC     HEADER VARIABLES
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imsatt/atthist/attfil/src/SCCS/s.quanrm.F	',
C     &'1.1	02/03/19 	IMSS_FDD\n'/
CC
      DOUBLE PRECISION Q0(4), Q1(4)

CC     LOCAL VARIABLES
      DOUBLE PRECISION FAC

      FAC = 1D0/SQRT(Q0(1)**2 + Q0(2)**2 + Q0(3)**2 + Q0(4)**2)
      Q1(1) = FAC*Q0(1)
      Q1(2) = FAC*Q0(2)
      Q1(3) = FAC*Q0(3)
      Q1(4) = FAC*Q0(4)

      END
 
 
 
 
      SUBROUTINE RAFCL (IF, IER)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE RAFCL            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  CLOSES AN ATTITUDE FILE PREVIOUSLY OPEN FOR READING WITH RAFOP.   |
CC |  THE TOTAL NUMBER OF ORBIT FILES IS LIMITED, BECAUSE OF CONSTANT   |
CC |  LENGTH OF FORTRAN ARRAYS. USING THIS SUBROUTINE, FREES MEMORY     |
CC |  USED BY THE CURRENT ATTITUDE FILE.                                |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER FOR ATTITUDE FILE, AS         |
CC |                           RETURNED BY RAFOP                        |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  IER            I*4       ERROR CODE, NON-ZERO IF ERROR            |
CC |                           1 = NOT ABLE TO CLOSE FILE               |
CC |                           2 = INVALID IDENTIFIER                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  rafsh.inc debugf.inc                                              |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  RIFCL                                                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imsatt/atthist/attfil/src/SCCS/s.rafcl.F	',
C     &'1.2	01/08/03 	IMSS_FDD\n'/
CC
      INTEGER IF, IER
CC
CC    LOCAL VARIABLES
CC
      INTEGER IUNER
      LOGICAL PR
CC
CC    CALLING
CC
      INTEGER RIFCL
CC
CC    INCLUDE
CC
C +----------------------+--------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA      |
C +----------------------|--------------------------+
C |   FDD                |  V. Companys             |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  DATA TO BE SHARED BETWEEN RAF?? FUNCTIONS. THIS INCLUDE FILE      |
C |  SHOULD BE CONSIDERED HIDDEN TO THE USER. USER SHOULD NEVER        |
C |  INCLUDE IT (THERE IS NO NEED).                                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFILP:                                                            |
C |    FTBEG()    R*8   START TIME OF ORBIT FILE                       |
C |    FTEND()    R*8   END TIME OF ORBIT FILE                         |
C |    LIF()      R*8   IDENTIFIERS FOR INTERFILE FUNCTION             |
C |    CURBLK()   I*4   CURRENT BLOCK BEING READ                       |
C |    POINTS()   I*4   NUMBER OF POINTS TO INTERPOLATE                |
C |    FRA()      I*4   REFERENCE FRAME OF CURRENT BLOCK               |
C |    FVARS()    I*4   NUMBER OF VARIABLES IN FILE                    |
C |    ITSC()     I*4   TIME SCALES                                    |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rafsh(2)
C      DATA SCCS_INFO_rafsh
C     &/'@(#)/home/imsatt/atthist/attfil/inc/SCCS/s.rafsh.inc	',
C     &'1.3	01/11/08 	IMSS_FDD\n'/
C
      INTEGER MAXUN
      PARAMETER (MAXUN = 8)
C
      DOUBLE PRECISION FTBEG(MAXUN), FTEND(MAXUN)
      INTEGER CURBLK(MAXUN), POINTS(MAXUN), FRA(MAXUN),
     .        FVARS(MAXUN), ITSC(MAXUN)

      COMMON /RAFP/ FTBEG, FTEND, CURBLK, POINTS, 
     .               FRA, FVARS, ITSC
C ======================================================================
C INCLUDE FILE DEBUGF
C ======================================================================
C      CHARACTER*68 SCCS_INFO_debugf(2)
C     &/'@(#)/home/imlib/gen/errors/inc/SCCS/s.debugf.inc	',
C     &'1.1	98/04/21 	OAD_IMSS\n'/
C
      INTEGER      IDEBUG
      COMMON/ DEBUG/ IDEBUG(10)
C
CB    / DEBUG/ DEBUG FLAGS
CV    IF IDEBUG(1).NE.0 : TRACE MESSAGES ARE GENERATED AND WRITTEN
CV                        (FOR DEBUGGING, INTERMEDIATE OUTPUT...)
CV    IDEBUG(9)         : IT CONTROLS THE SEVERITY FOR THE MESSAGES 
CV                        OUTPUT
CV                        0 MEANS THAT REPEAT, ERROR AND
CV                          WARNING MESSAGES ARE WRITTEN
CV                        1 MEANS THAT ONLY REPEAT AND 
CV                          ERROR MESSAGES ARE WRITTEN
CV                        2 ONLY ERROR MESSAGES ARE WRITTEN
CV                        3 ERROR MESSAGES ARE NOT WRITTEN  
CV    IDEBUG(10)        : UNIT WHERE MESSAGES ARE GOING TO BE DISPLAYED
CV                        NEGATIVE UNIT MEANS UNIT 0 (UNIX STDERR)
CV                        TO LOGICAL UNIT NUMBER = IDEBUG(10).
CV                        0 MEANS NO MESSAGE WRITTEN
CV    IDEBUG(3)...IDEBUG(9) ARE CURRENTLY UNUSED.
CC
CC   FIX ONCE FOR EVER THE ERROR UNIT
CC
      IF (IDEBUG(10).LT.0) THEN
         IUNER = 0
      ELSE IF (IDEBUG(10).EQ.0) THEN
         IUNER = -1
      ELSE
         IUNER = IDEBUG(10)
      ENDIF
      PR = (IDEBUG(9).LT.3).AND.(IUNER.GE.0) 
      IF (IF .LT.1 .OR. IF .GT. MAXUN)
     .   THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E RAFCL. INVALID IDENTIFIER'
         ENDIF
         IER = 2
         RETURN
      ENDIF
CC
CC   CHECK IF UNIT ALREADY IN USE
CC
      IF (0 .EQ. RIFCL(IF)) THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E RAFCL: NOT ABLE TO CLOSE FILE'
         ENDIF
         IER = 1
         RETURN
      ENDIF
      IER = 0
      RETURN
      END
      
      
 
 
 
 
      SUBROUTINE RAFOP (IUNIT, FNAME, IORDER,NVARS, IFRAME,
     .                         ITSCAL, TBEG, TEND,IF, IER)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE RAFOP            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  OPENS AN ATTITUDE FILE FOR READING. AND GIVES RELEVANT            |
CC |  INFORMATION.                                                      |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IUNIT(1/3)     I*4       UNIT TO WHERE FILE MUST BE OPENED.       |
CC |                           IF UNIT = 0 THEN UNIT IS EXPECTED TO BE  |
CC |                           A VECTOR OF 3 COMPONENTS. UNIT(2) AND    |
CC |                           UNIT(3) GIVE THEN A RANGE TO SEARCH FOR  |
CC |                           FOR POSSIBLE UNITS                       |
CC |  FNAME          C*132     NAME OF THE FILE TO BE OPENED.           |
CC |  IORDER         I*4       ORDER OF INTERPOLATION REQUIRED. THE     |
CC |                           NUMBER OF POINTS TO BE TAKEN TO THE LEFT |
CC |                           AND TO THE RIGHT IS COMPUTED FROM THIS   |
CC |                           ORDER. IN GENERAL, THE ACTUAL ORDER      |
CC |                           USED WILL BE .GE. IORDER. ONLY IF NOT    |
CC |                           ENOUGHT POINTS ARE AVAILABLE, THE ORDER  |
CC |                           MAY BECOME .LT. IORDER (START            |
CC |                           AND END OF INTERVALS) ORIGINATING SOME   |
CC |                           DEGRADATION OF THE QUALITY OF            |
CC |                           INTERPOLATION                            |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  NVARS          I*4       NUMBER OF VARIABLES                      |
CC |  IFRAME         I*4       DEFAULT REFERENCE FRAME. CURRENTLY NOT   |
CC |                           USED AND EQUATORIAL J2000 SHALL BE USED  |
CC |                           IT IS FORESEEN FOR FUTURE EXTENSIONS     |
CC |  ITSCAL         I*4       TIME SCALE ID                            |
CC |                           0 : TDB (BARYCENTRIC DYNAMIC TIME)       |
CC |                               IN MJD2000 FORMAT                    |
CC |  TBEG           R*8       EARLIEST TIME IN THE ATTITUDE FILE       |
CC |  TEND           R*8       LATEST TIME IN THE ATTITUDE FILE         |
CC |                           ATTENTION: ATTITUDE FILE MAY HAVE GAPS   |
CC |  IF             I*4       FILE IDENTIFIER TO BE USED IN SUBSEQUENT |
CC |                           CALLS OF SUBROUTINES OF THE FORM RAF??   |
CC |                           0 IF FAILED TO OPEN FILE                 |
CC |  IER            I*4       ERROR CODE, NON-ZERO IF ERROR            |
CC |                           1 = FAILED OPENING FILE                  |
CC |                           2 = UNABLE TO GET ADDITIONAL PARAMETERS  |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  rafsh.inc   TO RESOLVE FORTRAN UNITS AND INTERPOLATION FILE IDS   |
CC |  debugf.inc   ERROR PRINTING OPTIONS                               |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  RIFOP, RGETHE, RINFO                                              |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imsatt/atthist/attfil/src/SCCS/s.rafop.F	',
C     &'1.3	01/11/08 	IMSS_FDD\n'/
CC
      INTEGER IUNIT,IORDER, ITSCAL, IFRAME, IER,IF
      CHARACTER*132 FNAME
      DOUBLE PRECISION TBEG, TEND
CC
CC    LOCAL VARIABLES
      INTEGER IUNER, NDERS, NVARS, BUF(2), RGETHE, IDUMTY
      LOGICAL PR
CC
CC    CALLING...
CC
      INTEGER RIFOP, RINFO
CC
CC
CC    INCLUDE FILES
CC
C +----------------------+--------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA      |
C +----------------------|--------------------------+
C |   FDD                |  V. Companys             |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  DATA TO BE SHARED BETWEEN RAF?? FUNCTIONS. THIS INCLUDE FILE      |
C |  SHOULD BE CONSIDERED HIDDEN TO THE USER. USER SHOULD NEVER        |
C |  INCLUDE IT (THERE IS NO NEED).                                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFILP:                                                            |
C |    FTBEG()    R*8   START TIME OF ORBIT FILE                       |
C |    FTEND()    R*8   END TIME OF ORBIT FILE                         |
C |    LIF()      R*8   IDENTIFIERS FOR INTERFILE FUNCTION             |
C |    CURBLK()   I*4   CURRENT BLOCK BEING READ                       |
C |    POINTS()   I*4   NUMBER OF POINTS TO INTERPOLATE                |
C |    FRA()      I*4   REFERENCE FRAME OF CURRENT BLOCK               |
C |    FVARS()    I*4   NUMBER OF VARIABLES IN FILE                    |
C |    ITSC()     I*4   TIME SCALES                                    |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rafsh(2)
C      DATA SCCS_INFO_rafsh
C     &/'@(#)/home/imsatt/atthist/attfil/inc/SCCS/s.rafsh.inc	',
C     &'1.3	01/11/08 	IMSS_FDD\n'/
C
      INTEGER MAXUN
      PARAMETER (MAXUN = 8)
C
      DOUBLE PRECISION FTBEG(MAXUN), FTEND(MAXUN)
      INTEGER CURBLK(MAXUN), POINTS(MAXUN), FRA(MAXUN),
     .        FVARS(MAXUN), ITSC(MAXUN)

      COMMON /RAFP/ FTBEG, FTEND, CURBLK, POINTS, 
     .               FRA, FVARS, ITSC
C ======================================================================
C INCLUDE FILE DEBUGF
C ======================================================================
C      CHARACTER*68 SCCS_INFO_debugf(2)
C     &/'@(#)/home/imlib/gen/errors/inc/SCCS/s.debugf.inc	',
C     &'1.1	98/04/21 	OAD_IMSS\n'/
C
      INTEGER      IDEBUG
      COMMON/ DEBUG/ IDEBUG(10)
C
CB    / DEBUG/ DEBUG FLAGS
CV    IF IDEBUG(1).NE.0 : TRACE MESSAGES ARE GENERATED AND WRITTEN
CV                        (FOR DEBUGGING, INTERMEDIATE OUTPUT...)
CV    IDEBUG(9)         : IT CONTROLS THE SEVERITY FOR THE MESSAGES 
CV                        OUTPUT
CV                        0 MEANS THAT REPEAT, ERROR AND
CV                          WARNING MESSAGES ARE WRITTEN
CV                        1 MEANS THAT ONLY REPEAT AND 
CV                          ERROR MESSAGES ARE WRITTEN
CV                        2 ONLY ERROR MESSAGES ARE WRITTEN
CV                        3 ERROR MESSAGES ARE NOT WRITTEN  
CV    IDEBUG(10)        : UNIT WHERE MESSAGES ARE GOING TO BE DISPLAYED
CV                        NEGATIVE UNIT MEANS UNIT 0 (UNIX STDERR)
CV                        TO LOGICAL UNIT NUMBER = IDEBUG(10).
CV                        0 MEANS NO MESSAGE WRITTEN
CV    IDEBUG(3)...IDEBUG(9) ARE CURRENTLY UNUSED.

      IFRAME = 0
      ITSCAL = 0
      IER = 0
      IF (IDEBUG(10).LT.0) THEN
         IUNER = 0
      ELSE IF (IDEBUG(10).EQ.0) THEN
         IUNER = -1
      ELSE
         IUNER = IDEBUG(10)
      ENDIF
      PR = (IDEBUG(9).LT.3).AND.(IUNER.GE.0) 
CC
CC   OPEN FILE
CC
      IF = RIFOP (IUNIT, FNAME)
      IF (IF.EQ.0) THEN
         IER = 1
         IF (PR) THEN
         WRITE (IUNER, *) 'E RAFOP. NOT ABLE TO OPEN FILE'
         ENDIF
         IF = 0
         RETURN
      ENDIF
CC
CC

      IF (0.EQ.RINFO (IF, NVARS, NDERS, IDUMTY, TBEG, TEND)) THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E RAFOP. UNABLE TO GET PARAMETERS'
         ENDIF
         IER = 2
         RETURN
      ENDIF
      IF (NVARS.NE.7.AND.NVARS.NE.4) THEN 
        IF (PR) THEN
         WRITE (IUNER, *) 'E RAFOP. FILE NOT VALID'
         ENDIF
         IER = 3
         RETURN
      ENDIF
      FVARS (IF) = NVARS
      FTBEG(IF) = TBEG
      FTEND(IF) = TEND
      CURBLK(IF) = 0
      FRA(IF) = 0
CC      CEN(IF) = 0
      POINTS(IF) = IORDER / (NDERS+ 1) / 2 + 1
      IF (0.EQ.RGETHE (IF, BUF, 13, 3)) THEN
          IF (PR) THEN
          WRITE (IUNER, *) 'E RAFOP. UNABLE TO GET PARAMETERS'
          ENDIF
          IER = 2
          RETURN
       ENDIF
       IFRAME = BUF (1)
       ITSCAL = BUF (2)
      RETURN
      END
      
      

 
 
 
 
      SUBROUTINE RAFRR (IF, TIME, STATE, IFRAME,IER)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE RAFRR            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+
CC |   MODIFIED BY U. HERFORT TO CALCULATE ANGULAR   |
CC |   RATES FROM DERIVATIVES OF QUATERNIONS IF THEY |
CC |   ARE NOT INCLUDED IN THE FILE.                 |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  RETRIEVES ATTITUDE QUATERNION AND RATES FROM ATTITUDE FILE.       |
CC |  THE ATTITUDE FILE HAS BEEN OPENED WITH SUBROUTINE RAFOP           |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER FOR ATTITUDE FILE, AS         |
CC |                           RETURNED BY RAFOP                        |
CC |  TIME           R*8       TIME TO RETRIEVE DATA IN                 |
CC |                           TDB TIME SCALE AND MJD2000 TIME FORMAT   |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  STATE(7)       R*8       STATE(1..4):                             |
CC |                           ATTITUDE QUATERNION SPECIFYING THE       |
CC |                           ROTATION FROM 'IFRAME' TO S/C MECHANICAL |
CC |                           FRAME.                                   |
CC |                           SCALAR COMPONENT OF QUATERNION           |
CC |                           IS STATE(4).                             |
CC |                           UNIT: NONE                               |
CC |                           STATE(5..7):                             |
CC |                           ANGULAR RATE OF S/C MECHANICAL FRAME     |
CC |                           W.R.T. 'IFRAME' EXPRESSED IN S/C FRAME.  |
CC |                           UNIT: 1/S                                |
CC |  IFRAME         I*4       REFERENCE FRAME ID FOR RETURNED DATA     |
CC |                           0: J2000                                 |
CC |  IER            I*4:      RETURN CODE.                             |
CC |                           0:  OK                                   |
CC |                           2:  TIME TO EARLY                        |
CC |                           3:  TIME TO LATE                         |
CC |                           4:  TIME IN A GAP                        |
CC |                           5:  ERROR GETTING ADDITIONAL PARAMETERS  |
CC |                           6:  INVALID IDENTIFIER                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  rafsh.inc debugf.inc                                              |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  RRERED, RGETBL                                                    |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imsatt/atthist/attfil/src/SCCS/s.rafrr.F	',
C     &'1.7	02/05/03 	IMSS_FDD\n'/
CC
      INTEGER IF, IFRAME,IER
      DOUBLE PRECISION TIME, STATE(7)
CC
CC    LOCAL VARIABLES
      INTEGER IUNER,NDERS,I,NTOP
      LOGICAL PR
      DOUBLE PRECISION XSTATE(8)
CC
CC    CALLING
CC
      INTEGER RRERED
      EXTERNAL RRERED
CC
CC    INCLUDE
CC
C +----------------------+--------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA      |
C +----------------------|--------------------------+
C |   FDD                |  V. Companys             |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  DATA TO BE SHARED BETWEEN RAF?? FUNCTIONS. THIS INCLUDE FILE      |
C |  SHOULD BE CONSIDERED HIDDEN TO THE USER. USER SHOULD NEVER        |
C |  INCLUDE IT (THERE IS NO NEED).                                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFILP:                                                            |
C |    FTBEG()    R*8   START TIME OF ORBIT FILE                       |
C |    FTEND()    R*8   END TIME OF ORBIT FILE                         |
C |    LIF()      R*8   IDENTIFIERS FOR INTERFILE FUNCTION             |
C |    CURBLK()   I*4   CURRENT BLOCK BEING READ                       |
C |    POINTS()   I*4   NUMBER OF POINTS TO INTERPOLATE                |
C |    FRA()      I*4   REFERENCE FRAME OF CURRENT BLOCK               |
C |    FVARS()    I*4   NUMBER OF VARIABLES IN FILE                    |
C |    ITSC()     I*4   TIME SCALES                                    |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rafsh(2)
C      DATA SCCS_INFO_rafsh
C     &/'@(#)/home/imsatt/atthist/attfil/inc/SCCS/s.rafsh.inc	',
C     &'1.3	01/11/08 	IMSS_FDD\n'/
C
      INTEGER MAXUN
      PARAMETER (MAXUN = 8)
C
      DOUBLE PRECISION FTBEG(MAXUN), FTEND(MAXUN)
      INTEGER CURBLK(MAXUN), POINTS(MAXUN), FRA(MAXUN),
     .        FVARS(MAXUN), ITSC(MAXUN)

      COMMON /RAFP/ FTBEG, FTEND, CURBLK, POINTS, 
     .               FRA, FVARS, ITSC
C ======================================================================
C INCLUDE FILE DEBUGF
C ======================================================================
C      CHARACTER*68 SCCS_INFO_debugf(2)
C     &/'@(#)/home/imlib/gen/errors/inc/SCCS/s.debugf.inc	',
C     &'1.1	98/04/21 	OAD_IMSS\n'/
C
      INTEGER      IDEBUG
      COMMON/ DEBUG/ IDEBUG(10)
C
CB    / DEBUG/ DEBUG FLAGS
CV    IF IDEBUG(1).NE.0 : TRACE MESSAGES ARE GENERATED AND WRITTEN
CV                        (FOR DEBUGGING, INTERMEDIATE OUTPUT...)
CV    IDEBUG(9)         : IT CONTROLS THE SEVERITY FOR THE MESSAGES 
CV                        OUTPUT
CV                        0 MEANS THAT REPEAT, ERROR AND
CV                          WARNING MESSAGES ARE WRITTEN
CV                        1 MEANS THAT ONLY REPEAT AND 
CV                          ERROR MESSAGES ARE WRITTEN
CV                        2 ONLY ERROR MESSAGES ARE WRITTEN
CV                        3 ERROR MESSAGES ARE NOT WRITTEN  
CV    IDEBUG(10)        : UNIT WHERE MESSAGES ARE GOING TO BE DISPLAYED
CV                        NEGATIVE UNIT MEANS UNIT 0 (UNIX STDERR)
CV                        TO LOGICAL UNIT NUMBER = IDEBUG(10).
CV                        0 MEANS NO MESSAGE WRITTEN
CV    IDEBUG(3)...IDEBUG(9) ARE CURRENTLY UNUSED.
CC
CC   FIX ONCE FOR EVER THE ERROR UNIT
CC
      IF (IDEBUG(10).LT.0) THEN
         IUNER = 0
      ELSE IF (IDEBUG(10).EQ.0) THEN
         IUNER = -1
      ELSE
         IUNER = IDEBUG(10)
      ENDIF
      PR = (IDEBUG(9).LT.3).AND.(IUNER.GE.0)
      IF (IF .LT.1 .OR. IF .GT. MAXUN)
     .   THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E RAFRR. INVALID IDENTIFIER'
         ENDIF
         IER = 6
         RETURN
      ENDIF
      IFRAME = 0
      IF ((TIME-FTBEG(IF))*
     .    (TIME-FTEND(IF)).GT.0) THEN
         IF(TIME.GT.FTEND(IF)) THEN
            IF (PR) THEN
            WRITE (IUNER, *) 'E RAFRR. TIME TO LATE'
            ENDIF
            IER = 2
            RETURN
         ELSE
            IF (PR) THEN
            WRITE (IUNER, *) 'E RAFRR. TIME TO EARLY'
            ENDIF
            IER = 1
            RETURN
         ENDIF
      ENDIF
      NTOP = 0
CC     IF ANGULAR RATES ARE STORED IN INPUT FILE, THE VALUES IN THE FILE
CC     ARE USED. OTHERWISE RATES ARE CALCULATED FROM TEMPORAL DERIVATIVES
CC     OF QUATERNION.
      IF (FVARS(IF) .EQ. 7) THEN
         NDERS = 0
      ELSE
         NDERS = 1
      END IF
      IF (RRERED (IF, TIME, 0, NTOP,
     .   NDERS, POINTS(IF), XSTATE).EQ.0) THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E RAFRR. NOT ABLE TO COMPUTE ATTITUDE.'
         WRITE (IUNER, *) '         TIME MAY BE IN A GAP.'
         ENDIF
         IER = 3
         RETURN
      ENDIF

CC     IF ANGULAR VELOCITY STORED IN INPUT FILE, NORMALISE QUATERNION
CC     AND COPY RATE
      IF (FVARS(IF) .EQ. 7) THEN
         CALL QUANRM (XSTATE, STATE)
         DO 20 I = 5, 7
            STATE(I) = XSTATE(I)
 20      CONTINUE
      ELSE
CC     OTHERWISE, CALCULATE RATES FROM DERIVATIVES
         CALL QDRATE (XSTATE, XSTATE(5), STATE, STATE(5))
      END IF
      IER = 0

      RETURN
      END
 
 
 
 
      INTEGER FUNCTION RBINFO (IF, CBLOCK,TBBEG, TBEND)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE RINFO            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  GETS INFORMATION ON THE FILE POINTED TO IF (OPENED FOR READING)   |
CC |  THIS IS PROVIDED, TO AVOID USER ACCESSING COMMON BLOCKS           |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       INTERPOLATION FILE ID AS RETURNED BY     |
CC |                           RIFOP                                    |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  CBLOCK         I*4       RETURNS CURRENT BLOCK (ID). THE ID IS    |
CC |                           CURRENTLY THE FIRST RECORD NUMBER, BUT   |
CC |                           THIS IS IRRELEVANT. IT SHOULD ONLY BE    |
CC |                           USED TO ESTABLISH IF THE BLOCK HAS       |
CC |                           CHANGED, AND READ AGAIN HEADER           |
CC |                           PARAMETERS                               |
CC |  TBBEG          R*8       EARLIEST TIME IN CURRENT BLOCK           |
CC |  TBEND           R*8       LATEST TIME IN CURRENT BLOCK            |
CC |  IT RETURNS NON-ZERO IF OK, O OTHERWISE                            |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  rshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rbinfo.F	',
C     &'1.5	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF, CBLOCK
      DOUBLE PRECISION TBBEG, TBEND 
CC
CC    LOCAL VARIABLES
CC
CC    UNAVOIDABLE INCLUDE FILE TO RESERVE ENOUGH MEMORY (FORTRAN)
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
CC
CC    IN THE NEXT INCLUDE, COMMON DATA IS STORED, AS OPEN I FILES, 
CC    THE RECORD LENGTHS ...
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC
      CBLOCK = RCURB(IF)
      TBBEG = RBTBEG (IF)
      TBEND = RBTEND (IF)
      RBINFO = 1
      RETURN
      END
 
 
 
 
      SUBROUTINE RDGOTB(IFN, IGOTOB, IERROR)

CC============================= HEADER =================================
CCP----- PURPOSE -------------------------------------------------------
CCP  This routine can be used to go directly to any block in the case
CCP  where the block table has been calculated.
CCP  
CCC----- COMMENTS ------------------------------------------------------
CCC  Proj=gen, subj=cmd, util= int. file syst.
CCC  Auth= Jens Juul Yde, TOS-GFI,  2001
CCC
CCI----- ONLY INPUT VARIABLES ------------------------------------------
CCI  IFN: I*4. Identifyer to the used i-file (called IF in other subrt.)
CCI  IGOTOB: I*4. Block number of target block
CCI  
CCIO---- BOTH INPUT AND OUTPUT VARIABLES -------------------------------
CCIO  
CCO----- ONLY OUTPUT VARIABLES -----------------------------------------
CCO  IER:  = 0 if successful
CCO        = 1 Invalid identifier
CCO        = 2 block number out of range
CCO        = 3 error calling RGOTOB
CCO  
CCB----- COMMON BLOCKS -------------------------------------------------
CCB  'dimensions.inc'
CCB  'rshare.inc'
CCB  
CCS----- SUBROUTINES USED ----------------------------------------------
CCS  
CCS  RGOTOB
CCS    
CC============================= HEADER END =============================


CC--------------- VARIABLE DEFINITIONS ---------------------------------


CC---- Interface variables
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rdgotb.F	',
C     &'1.5	01/11/21 	IMSS_FDD\n'/
CC
      INTEGER           IFN, IGOTOB, IERROR

CC---- Local variables
      INTEGER           IRECNO, IER
      INTEGER IRECNR
      INTEGER I

CC---- Functions used
      INTEGER           RGOTOB
      INTEGER           RNEXTB

C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------


CC     Check if identifier is possible
         IF (IFN.LT.1 .OR. IFN.GT.MRFLS) THEN
            IF (PR.GT.0) WRITE (0,*) 
     .           'ERROR::RGOTOB: Invalid identifier IFN = ', IFN
            IERROR = 1
            RETURN
         ENDIF
         
CC     Check if the flag of the interpolation file is true (= in use)
         IF (RFLIST(IFN).EQ.0) THEN
            IF (PR.GT.0) WRITE (0,*) 
     .           'ERROR::RGOTOB: Invalid identifier IFN = ', IFN
            IERROR = 1
            RETURN
         ENDIF

CC---- If block table available, then calculate the timewise next block
CC     using the index table and go there directly
      IF (LBTFLG(IFN)) THEN

CC---------------Make rank list for the elements of the trailer --------
         
         
CC     Check if the block number is positive and within the number of
CC     blocks in the file
         IF (IGOTOB .LT. 1 .OR. IGOTOB .GT. IBTLEN(IFN)) THEN
            IF (PR.GT.0) WRITE (0,*) 
     .           'ERROR::RDGOTB: The block number ',IGOTOB,
     .           ' is out of range'
            IERROR = 2
            RETURN
         ENDIF
         
CC     Finding the record number of the wanted block
         IRECNO = IBTREC(IGOTOB, 2, IFN)

CC     The next step looks strange but is done because RGOTOB always
CC     adds one to the block number (because it was only made with the
CC     intension of jumping one block forward)
         NCURB(IFN) = IGOTOB - 1
         
CC     This call makes the jump to the desired block
         IER = RGOTOB(IFN, IRECNO)
         
CC     Check if there was any error trying to jump to block
         IF (IER .NE. 1) THEN
            IF (PR.GT.0) WRITE (0,*) 
     .           'ERROR::RDGOTB: Error calling RGOTOB'
            IERROR = 3
            RETURN
         ENDIF
         
CC     LOOP ....
      ELSE
         
CC     NOW GOTO THE VERY FIRST BLOCK
         NCURB(IFN)=0
         RCURB(IFN)=0
         
CC     FIND AND POSITION IN THE FIRST BLOCK
         IRECNR = RNEXTB(IFN)
         IF (0.GE.IRECNR) THEN
            IF (PR.GT.0) WRITE (0,*) 
     .           'ERROR::RDGOTB: Could not find first block'
            IERROR = 3
            RETURN
         ENDIF

         IF (0.EQ.RGOTOB(IFN,IRECNR)) THEN
            IF (PR.GT.0) WRITE (0,*) 
     .           'ERROR::RDGOTB: Failed moving to first block'
            IERROR = 3
            RETURN
         ENDIF
         
CC     CHECK IF CURRENT BLOCK ID (= 1ST RECORD IN BLOCK) IS STILL ZERO, 
CC     IF SO THERE IS NO RECORD IN THE FILE
         IF (RCURB(IFN).EQ.0)  THEN
            IF (PR.GT.0) WRITE (0,*) 
     .           'ERROR::RDGOTB: Failed moving to first block'
            IERROR = 3
            RETURN
         ENDIF
         
CC     LOOP UNTIL IBLK IS REACHED
         DO 100, I = I,IGOTOB
            
            IRECNR = RNEXTB(IFN)
            IF (0.GE.IRECNR) THEN
               IF (PR.GT.0) WRITE (0,*) 
     .              'ERROR::RDGOTB: Could not find next block'
               IERROR = 3
               RETURN
            ENDIF
            IF (0.EQ.RGOTOB(IFN,IRECNR)) THEN
               IF (PR.GT.0) WRITE (0,*) 
     .              'ERROR::RDGOTB: Failed moving to next block'
               IERROR = 3
               RETURN
         ENDIF
         
 100  CONTINUE
      ENDIF

CC-----------------------------------------------------------------------

      IERROR = 0 

      RETURN
      END




 
 
 
 
      INTEGER FUNCTION RGBLHE (IF, BUFFER, RE)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE RGBLHE                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  READS A BLOCK HEADER BUFFER FROM A FILE STARTING IN RECORD RE     |
CC |  THE REASON TO CREATE TWO FUNCTIONS, ONE FOR READ AND ONE FOR      |
CC |  WRITE FILES, IS TO ACHIEVE BETTER ENCAPSULATION (ALWAYS DIFFICULT |
CC |  IN FORTRAN. I CLARIFY THAT, SO THAT IT IS CLEAR THAT IT IS        |
CC |  INTENTIONALLY SO                                                  |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF      I*4    INTERPOLATION FILE NUMBER                          |
CC |  RE      I*4    RECORD TO START WITH                               |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  BUFFER  R*8    BUFFER CONTAINING HEADER                           |
CC |  RETURNS 1 IN SUCCESS 0 IN ERROR                                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  rshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  RIREC                                                             |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/09 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rgblhe.F	',
C     &'1.5	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF
      DOUBLE PRECISION BUFFER(1)
CC
CC    LOCAL VARIABLES
CC
      INTEGER I, J, IOS, RE
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC
CC    CALLING 
CC
      INTEGER RIREC
CC
CC
      RGBLHE = 0
      IF (IF.LT.1.OR.IF.GT.MRFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGBLHE: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (RFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGBLHE: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      J = 1
      DO 10 I = 0, RBLHSI(IF) - 1
         IOS = RIREC (IF, I + RE, BUFFER(J))
CC         READ (UNIT = RUNITS(IF), IOSTAT = IOS, REC = I + RE) 
CC     .      (BUFFER(K), K=J,J + RRECLS(IF)/8 - 1)
         IF (IOS .NE. 0) THEN
            IF (PR.GT.0) WRITE (0, *) 
     .       'ERROR::RGBLHE: Not able to read block header IOS = ',
     .                IOS
            RETURN
         ENDIF
         J = J + RRECLS(IF)/8
 10   CONTINUE
      RGBLHE = 1
      RETURN
      END

 
 
 
 
      INTEGER FUNCTION RGETBL (IF, BUF, POS, LENGTH)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE RGETBL                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  READS PART OF THE CURRENT BLOCK HEADER BUFFER FROM AN             |
CC |  INTERPOLATION FILE                                                |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF         I*4 INTERPOLATION FILE NUMBER                          |
CC |  POS        I*4 POSITION OF DATA IN 4* BYTES WORDS. IF POS         |
CC |                 IS 21, THE DATA IS GOING TO BE READ STARTING       |
CC |                 AT BYTE 81.                                        |
CC |  LENGTH     I*4 NUMBER OF 4BYTE WORDS TO BE COPIED                 |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  BUF(*)    I*4 BUFFER CONTAINING DATA GOT FROM HEADER              |
CC |  RETURNS 1 IN SUCCESS 0 IN ERROR                                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  rshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  RGHEAD                                                            |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/08 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rgetbl.F	',
C     &'1.6	02/01/24 	OAD_IMSS\n'/
CC
      INTEGER IF, BUF(1), POS, LENGTH
CC
CC    LOCAL VARIABLES
CC
      INTEGER I
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC
      INTEGER BLHEI (MAXBLK/4)
      EQUIVALENCE (BLHE, BLHEI)
CC
CC    CALLING
CC
      INTEGER RGBLHE
CC
      RGETBL = 0
      IF (IF.LT.1.OR.IF.GT.MRFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGETBL: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (RFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGETBL: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (POS.LT.1) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGETBL: POS must be positive'
         RETURN
      ENDIF
      IF (LENGTH.LT.1) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGETBL: Number of words ', LENGTH,
     .    'is to small'
         RETURN
      ENDIF
      IF (POS + LENGTH -1.GT.RRECLS(IF) * RBLHSI(IF) / 4) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGETBL: Cannot read so many words  ', LENGTH
         RETURN
      ENDIF
      IF (RLASTS(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGETBL: Tere is no block yet'
         RETURN
      ENDIF
CC
CC    RETRIEVE THE CURRENT HEADER
CC
      IF (0.EQ.RGBLHE (IF, BLHE, RCURB(IF))) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGETBL: Could not read file header'
         RETURN
      ENDIF
CC
CC    COPY THE RELEVANT PARAMETERS
CC
      DO 10 I = POS, POS + LENGTH -1
         BUF(I - POS + 1) = BLHEI (I)
 10   CONTINUE
      RGETBL = 1
      RETURN
      END


 
 
 
 
      INTEGER FUNCTION RGETHE (IF, BUF, POS, LENGTH)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE RGETHE                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  READS PART OF THE HEADER BUFFER FROM AN INTERPOLATION FILE        |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF         I*4 INTERPOLATION FILE NUMBER                          |
CC |  POS        I*4 POSITION OF DATA IN 4* BYTES WORDS. IF POS         |
CC |                 IS 21, THE DATA IS GOING TO BE READ STARTING       |
CC |                 AT BYTE 81.                                        |
CC |  LENGTH     I*4 NUMBER OF 4BYTE WORDS TO BE COPIED                 |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  BUF(*)     I*4 BUFFER CONTAINING DATA GOT FROM HEADER             |
CC |  RETURNS 1 IN SUCCESS 0 IN ERROR                                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  rshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  RGHEAD                                                            |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/08 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rgethe.F	',
C     &'1.6	02/01/24 	OAD_IMSS\n'/
CC
      INTEGER IF, BUF(1), POS, LENGTH
CC
CC    LOCAL VARIABLES
CC
      INTEGER I
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC
      INTEGER HEAINT(MAXHEA/4)
      EQUIVALENCE (HEABUF, HEAINT)
CC
CC    CALLING
CC
      INTEGER RGHEAD
CC
      RGETHE = 0
      IF (IF.LT.1.OR.IF.GT.MRFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGETHE: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (RFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGETHE: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (POS.LT.1) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGETHE: POS must be positive'
         RETURN
      ENDIF
      IF (LENGTH.LT.1) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGETHE: Number of words ', LENGTH,
     .    'is to small'
         RETURN
      ENDIF
      IF (POS + LENGTH -1.GT.RRECLS(IF) * RHSIZ(IF) / 4) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGETHE: Cannot read so many words  ', LENGTH
         RETURN
      ENDIF
CC
CC    RETRIEVE THE CURRENT HEADER
CC
      IF (0.EQ.RGHEAD (IF, HEABUF)) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGETHE: Could not read file header'
         RETURN
      ENDIF
CC
CC    COPY THE RELEVANT PARAMETERS
CC
      DO 10 I = POS, POS + LENGTH -1
         BUF(I - POS + 1) = HEAINT (I)
 10   CONTINUE
      RGETHE = 1
      RETURN
      END


 
 
 
 
      INTEGER FUNCTION RGETRE (IF, RE, BUFF)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE RGETRE                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  GETS A RECORD FROM INTERPOLATION FILE                             |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER AS RETURNED BY WIFOP          |
CC |  RE             I*4       RECORD NUMBER                            |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  BUFF(?)        R*8       BUFFER TO PUT THE RECORD IN              |
CC |  RETURNS ONE IF SUCCESS 0 IF FAILED                                |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  rshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  RIREC                                                             |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/12 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rgetre.F	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF, RE
      DOUBLE PRECISION BUFF(1)
CC
CC    LOCAL VARIABLES
CC
CC
      INTEGER IOS
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC
CC    CALLED FUNCTIONS
CC
      INTEGER RIREC
      RGETRE = 0
CC
CC    CONTROLS REMOVED, I ASSUME THAT THIS IS DONE
CC    IN THE UPPER LEVEL, TO IMPROVE PERFORMANCE. I LEAVE
CC    ANYWAY CODE COMENTED, JUST IN CASE
CC
CC      IF (IF.LT.1.OR.IF.GT.MRFLS) THEN
CC         IF (PR.GT.0) WRITE (0,*) 
CC     .    'ERROR::RGETRE: Invalid identifier IF = ', IF
CC         RETURN
CC      ENDIF
CC      IF (RFLIST(IF).EQ.0) THEN
CC         IF (PR.GT.0) WRITE (0,*) 
CC     .    'ERROR::RGETRE: Invalid identifier IF = ', IF
CC         RETURN
CC      ENDIF
CC      IF (RLASTS(IF).EQ.0) THEN
CC         IF (PR.GT.0) WRITE (0,*) 
CC     .    'ERROR::RGETRE: You must create a block first'
CC         RETURN
CC      ENDIF
      IF (RDERS(IF) .EQ. 0) THEN
         IOS = RIREC (IF, RE, BUFF(1))
CC         READ (UNIT = RUNITS(IF), IOSTAT = IOS, REC = RE) 
CC     .   (BUFF(I), I=1, RVARS(IF)+1)
         IF (IOS .NE. 0) THEN
            IF (PR.GT.0) WRITE (0, *) 
     .       'ERROR::RGETRE: Not able to read data record IOS = '
            RETURN
         ENDIF
      ELSE
         IOS = RIREC (IF, RE, BUFF(1))
CC         READ (UNIT = RUNITS(IF), IOSTAT = IOS, REC = RE) 
CC     .   (BUFF(I), I=1, 2 * RVARS(IF) + 1)
         IF (IOS .NE. 0) THEN
            IF (PR.GT.0) WRITE (0, *) 
     .       'ERROR::RGETRE: Not able to read data record IOS = '
            RETURN
         ENDIF
      ENDIF
      RGETRE = 1
      RETURN
      END
 
 
 
 
      INTEGER FUNCTION RGHEAD (IF, BUFFER)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE RGHEAD                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  READS THE HEADER BUFFER FROM AN IFILE OPENED FOR READING          |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF INTERPOLATION FILE NUMBER AS RETURNED BY RIFOP                 |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  BUFF    R*8    BUFFER CONTAINING HEADER                           |
CC |  RETURNS 1 IN SUCCESS 0 IN ERROR                                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  rshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  RIREC                                                             |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/09 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rghead.F	',
C     &'1.5	01/11/21 	OAD_IMSS\n'/
CC
      INTEGER IF
      DOUBLE PRECISION BUFFER(*)

CC
CC    LOCAL VARIABLES
CC
      DOUBLE PRECISION ELEM
      INTEGER IELEM(2)
      
      EQUIVALENCE (ELEM,IELEM)
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

      INTEGER I, J, K, IOS
CC
CC    CALLING
CC
      INTEGER RIREC
      RGHEAD = 0
      IF (IF.LT.1.OR.IF.GT.MRFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGHEAD: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (RFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGHEAD: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      J = 1
      I = 1
      RHSIZ(IF) = 100
CC
CC    DO WHILE IN STANDARD FORTRAN
CC
 5    CONTINUE
         IOS = RIREC (IF, I, BUFFER(J))
CC         READ (UNIT = RUNITS(IF), IOSTAT = IOS, REC = I) 
CC     .      (BUFFER(K), K=J,J + RRECLS(IF)/8 - 1)
         IF (IOS .NE. 0) THEN
            IF (PR.GT.0) WRITE (0, *) 
     .       'ERROR::RGHEAD: Not able to read header IOS = ',
     .                IOS
            RETURN
         ENDIF
         K = J + RRECLS(IF)/8
         IF (J.LE.3.AND.K.GT.3) THEN
CC
CC    IN THIS STEP THE HEADER SIZE HAS BEEN READ
CC
            ELEM = BUFFER(3)
            IF (0.EQ.MOD(IELEM(1),RRECLS(IF))) THEN 
               RHSIZ(IF) = IELEM(1)/RRECLS(IF)
            ELSE
               RHSIZ(IF) = IELEM(1)/RRECLS(IF) + 1
            ENDIF
         ENDIF
         J = K
         I = I + 1
         IF (RHSIZ(IF)-I) 10,5,5
 10   CONTINUE
CC
CC    NOW WE HAVE IF BUFFER THE HEADER, LET US TAKE 
CC    THE RELEVANT INFORMATION
CC
      IF (J.LE.6) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGHEAD: Invalid file. Header in incomplete'
         RETURN
      ENDIF
      ELEM = BUFFER (1)
      RVARS (IF) = IELEM (2)
      ELEM = BUFFER (2)
      RDERS (IF) = IELEM (1)
      RTYPES (IF) = IELEM (2)
      ELEM = BUFFER (3)
      IF (0.EQ.MOD(IELEM(2),RRECLS(IF))) THEN 
         RBLHSI(IF) = IELEM(2)/RRECLS(IF)
      ELSE
         RBLHSI(IF) = IELEM(2)/RRECLS(IF) + 1
      ENDIF
      ELEM = BUFFER (4)
      RLASTS (IF) = IELEM (1)
      RTBEG (IF) = BUFFER (5)
      RTEND (IF) = BUFFER (6)
      RGHEAD = 1
      RETURN
      END

 
 
 
 
      INTEGER FUNCTION RGOTOB (IF, RE)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE RGOTOB                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  POSITIONS IN A BLOCK STARTING AT RECORD RE                        |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER AS RETURNED BY WIFOP          |
CC |  RE             I*4       RECORD NUMBER WHERE THE BLOCK STARTS     |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  1 IN SUCCESS, 0 OTHERWISE                                         |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  rshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  RGBLHE                                                            |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC

CC
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rgotob.F	',
C     &'1.7	02/04/29 	IMSS_FDD\n'/
CC
      INTEGER IF, RE
CC
CC    LOCAL VARIABLES
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC
CC    CALLING
CC
      INTEGER RGBLHE
CC
      INTEGER BLHEI (MAXBLK/4)
      EQUIVALENCE (BLHE, BLHEI)
CC
      RGOTOB = 0
CC
      IF (IF.LT.1.OR.IF.GT.MRFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGOTOB: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (RFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGOTOB: Invalid identifier IF = ', IF
         RETURN
      ENDIF
CC
CC   DO A SIMPLE TEST IN RE (IT IS NOT SUFFICIENT BUT NECESSARY
CC
      IF(RLASTS(IF).LT.RE.OR.RE.LE.RHSIZ(IF)) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGOTOB: Record number out of range: ', RE
         RETURN
      ENDIF
CC
CC    READ THE BLOCK HEADER
CC
      IF (0.EQ.RGBLHE (IF, BLHE, RE)) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RGOTOB: Could not read header in ', RE
         RETURN
      ENDIF
CC
CC    EXTRACT PARAMETERS FROM THE HEADER
CC
      RCFR (IF) = BLHEI (1)
      RCLR (IF) = BLHEI (2)
      RCPB (IF) = BLHEI (3)
      RCNB (IF) = BLHEI (4)
      RBTBEG (IF) = BLHE (3)
      RBTEND (IF) = BLHE (4)
CC
CC
CC    PUT HERE INFORMATION RELATIVE TO INTERPOLATION...
CC
CC
      RCURB (IF) = RE
      RIVAL(IF) = 0
      RFRR(IF) = 0
      RLRR(IF) = 0
      RFRF(IF) = 1
      RLRF(IF) = 0

CC2    Counter of Block number 
CC2    (assuming only sequential advancing block read in rrerec and rrerec2)
CC2    (and initially 0 so that is set to 1 at first call)           

      NCURB(IF)=NCURB(IF)+1
CC2

      RGOTOB = 1      
      RETURN
      END

 
 
 
 
      INTEGER FUNCTION RIFCL (IF)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE RIFCL                       |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  CLOSES ONE INTERPOLATION FILE (IFILE) WHICH HAS BEEN OPENED       |
CC |  FOR READING. SETS PARAMETERS TO                                   |
CC |  ALLOW NEW USE OF SHARED MEMORY                                    |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF          I*4     IDENTIFIER FOR THE IFILE, AS RETURNED BY      |
CC |                      WIFOP.                                        |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  RETURNS 1 IN SUCCESS 0 IN ERROR                                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  wshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |                                                                    |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/17 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rifcl.F	',
C     &'1.6	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF
CC
CC    LOCAL VARIABLES
CC
      INTEGER IOS
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC
CC
CC  
      RIFCL = 0
      IF (IF.LT.1.OR.IF.GT.MRFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RIFCL: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (RFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RIFCL: Invalid identifier IF = ', IF
         RETURN
      ENDIF
CC
CC
      RFLIST (IF) = 0
CC
CC    CLOSING UNIT POINTED BY IF
CC
      CLOSE (UNIT = RUNITS(IF), IOSTAT = IOS)
CC
CC    CHECK RETURN CODE
CC
      IF (IOS.NE.0) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::RIFCL: Not able to close unit ', 
     .          RUNITS(IF)
         RETURN
      ENDIF
CC

CC---Resetting the block table flag to "FALSE"

      LBTFLG(IF) = .FALSE.

CC---block table modification end

      RIFCL = 1
      RETURN
      END
 
 
 
 
      INTEGER FUNCTION RIFOP (UNIT, FNAME)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE RIFOP                       |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  OPENS AN INTERPOLATION FILE FOR READING, AND IF POSSIBLE (STORAGE |
CC |  LIMITS) THEN A BLOCK TABLE IS CREATED.                            |
CC |  RETURNS AN IDENTIFIER FOR THE FILE, TO BE USED IN SUBSEQUENT      |
CC |  CALLS                                                             |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  UNIT(1/3)      I*4       UNIT TO WHERE FILE MUST BE OPENED.       |
CC |                           IF UNIT = 0 THEN UNIT IS EXPECTED TO BE  |
CC |                           A VECTOR OF 3 COMPONENTS. UNIT(2) AND    |
CC |                           UNIT(3) GIVE THEN A RANGE TO SEARCH FOR  |
CC |                           FOR POSSIBLE UNITS                       |
CC |  FNAME          C*132     NAME OF THE FILE TO BE OPENED.           |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  RETURNS AN IDENTIFIER FOR THE FILE, TO BE USE IN SUBSEQUENT CALLS |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  rshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  GETUN, RGHEAD, RTCRBT                                             |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/08 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rifop.F	',
C     &'1.13	02/03/28 	OAD_IMSS\n'/
CC
      INTEGER UNIT(*)
      CHARACTER*(*) FNAME
CC
CC    LOCAL VARIABLES
CC
      INTEGER UN, IOS, I, INIT, RECLON, NVARS, DERS, IER
      INTEGER RECNUM

      SAVE INIT
CC
CC    CALLING FUNCTIONS
CC
      INTEGER GETUN, RGHEAD
      INTEGER RNEXTB, RGOTOB
CC
CC    UNAVOIDABLE INCLUDE FILE TO RESERVE ENOUGH MEMORY (FORTRAN)
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
CC
CC    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
CC
CC
CC    THE SAME IN INTEGER, SEE EQUIVALENCE
CC
      INTEGER HEAINT(MAXHEA/4)
      EQUIVALENCE (HEABUF, HEAINT)     
CC
CC    IN THE NEXT INCLUDE, COMMON DATA IS STORED, AS OPEN I FILES, 
CC    THE RECORD LENGTHS ...
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------


      DATA INIT /0/

CC-----------------------------------------------------------------------
CC-----INITIALISATION
      IER = 0
CC
CC    FIRST CALL
CC
      IF (INIT.EQ.0) THEN
         DO 5 I = 1, MRFLS
            RFLIST(I) = 0
 5       CONTINUE
         INIT = 1
      ENDIF
CC 
CC
      RIFOP = 0
CC 
CC    FIRST TRY TO FIND A FREE UNIT. THIS IS DONE LIKE
CC    THAT, TO AVOID COLLISION WITH OTHER UNITS (12 EPHEMERIS...)
CC    OF COURSE, THERE IS NO  GUARANTEE THAT THE USER OF THE FILE
CC    DOES NOT TRY TO USE THE UNIT FOR SOMETHING ELSE LATER.
CC    
      IF (UNIT(1).NE.0) THEN    
         UN = GETUN (UNIT(1), UNIT(1))
      ELSE 
         UN = GETUN (UNIT(2), UNIT(3))
      ENDIF
      IF (UN .EQ. 0) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::WIFOP: Not able to get a free unit'
         RETURN
      ENDIF

CC     NOW CHECK IF THERE IS A NAME GIVEN. IF NOT, THEN OPEN WITH THE 
CC     STANDARD UNIT NAME.
CC     
CC    NOW TRY TO OPEN THE FILE IN UNIT, RECL IS COMPUTED FIRST. WE
CC    MUST USE CONSTANT RECL BECAUSE FORTRAN. EVEN FOR THE HEADER
CC    OF THE FILE WE MUST HAVE THE SAME RECL. THE HEADER WILL THEREFORE
CC    BE MADE OF AN INTEGER NUMBER OF RECORDS 
CC
      IF (FNAME.EQ.' ') THEN
         OPEN (UNIT = UN, ACCESS = 'DIRECT',
     .        RECL = 1, IOSTAT = IOS, STATUS = 'OLD')
      ELSE
         OPEN (UNIT = UN, FILE = FNAME, ACCESS = 'DIRECT',
     .        RECL = 1, IOSTAT = IOS, STATUS = 'OLD')
      ENDIF

CC
CC    CHECK IF THE OPEN WAS DONE SUCCESFULLY
CC
      IF (IOS .NE. 0) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::RIFOP: Not able to open file IOS = ',
     .                IOS
         RETURN
      ENDIF
CC
CC    CHECK IF THERE IS AN IFILE FREE
CC
      RIFOP = 0
      DO 20 I = MRFLS, 1, -1
         IF (RFLIST(I).EQ.0) RIFOP = I
 20   CONTINUE
      IF (RIFOP .EQ. 0) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::RIFOP: No IFILE free'
         CLOSE (UN)
         RETURN
      ENDIF
CC
CC    TRY TO GET THE RECORD LENGTH
      READ (UNIT = UN, IOSTAT = IOS, REC = 1) 
     .       RECLON
CC     .      RRECLS (RIFOP)
      IF (IOS .NE. 0) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::RIFOP: Not able to read file IOS = ',
     .                IOS
         RIFOP = 0
         CLOSE (UN)
         RETURN
      ENDIF
CC
CC    REOPEN WITH CORRECT RECORD LENGTH AS FROM NOW, THE FILE CAN BE 
CC    USED
CC
      CLOSE (UN)
      IF (FNAME.EQ.' ') THEN
         OPEN (UNIT = UN, ACCESS = 'DIRECT',
     .        RECL = RECLON, IOSTAT = IOS, STATUS = 'OLD')
      ELSE
         OPEN (UNIT = UN, FILE = FNAME, ACCESS = 'DIRECT',
     .        RECL = RECLON, IOSTAT = IOS, STATUS = 'OLD')
      ENDIF
      
      IF (IOS .NE. 0) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::RIFOP: Not able to open file IOS = ',
     .                IOS
         RIFOP = 0
         RETURN
      ENDIF
      READ (UNIT = UN, IOSTAT = IOS, REC = 1) 
     .       RECLON, NVARS, DERS
      IF (IOS .NE. 0) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::RIFOP: Not able to read file IOS = ',
     .                IOS
         CLOSE (UN)
         RIFOP = 0
         RETURN
      ENDIF
      RRECLS (RIFOP) = (1 + (1 + DERS) * NVARS) * 8

CC
CC    SET PARAMETERS OF FILE AND PREPARE HEADER BUFFER
CC
      RFLIST (RIFOP) = 1
      RUNITS (RIFOP) = UN
      RBUFFR(RIFOP) = 0
      RBUFLR(RIFOP) = 0
      RNLREC(RIFOP) = RECLON / RRECLS (RIFOP)


      IF (0.EQ.RGHEAD (RIFOP, HEABUF)) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::RIFOP: Not able to read header'
         CLOSE (UN)
         RFLIST (RIFOP) = 0
         RIFOP = 0
         RETURN
      ENDIF
      RCURB (RIFOP) = 0
      NCURB (RIFOP) = 0

CC---- Try to calculate the block table
CC     Also a flag is set to indicate if block table is available and the
CC     length of the i-file in blocks is calculated and stored.
CC     The block table is not essential to the program but increases
CC     execution speeds of many procedures.

      CALL RTCRBT(RIFOP, IER)
      IF (IER.EQ.0) THEN
        LBTFLG(RIFOP) = .TRUE.
      ELSE
        LBTFLG(RIFOP) = .FALSE.
      ENDIF

CC     Now go to first block. This is done because the block position
CC     after RTCRBT is the last block (if blocktable made) or block
CC     number IMXBLK (if too many blocks). Now go to block 1, to give
CC     a fixed starting situation.

      RCURB(RIFOP) = 0
      NCURB(RIFOP) = 0
      RECNUM = RNEXTB(RIFOP)
      IF (RECNUM .EQ. 0) GOTO 900
      IF (RECNUM .LT. 0) GOTO 900

      IER    = RGOTOB(RIFOP, RECNUM)
      IF (0.EQ.IER) THEN
         IF (PR.GT.0) WRITE (0, *)
     .   'ERROR::RIFOP: Not able to go to first block'
         RIFOP = 0
         RETURN
      ENDIF

CC---- End of block table part

 900  CONTINUE

      RETURN
      END
 
 
 
 
      INTEGER FUNCTION RINFO (IF, NVARS, NDERS,ITYPE,TBEG, TEND)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE RINFO            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  GETS INFORMATION ON THE FILE POINTED TO IF (OPENED FOR READING)   |
CC |  THIS IS PROVIDED, TO AVOID USER ACCESSING COMMON BLOCKS           |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       INTERPOLATION FILE ID AS RETURNED BY     |
CC |                           RIFOP                                    |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  NVARS          I*4       NUMBER OF VARIABLES STORED IN FILE       |
CC |  NDERS          I*4       1 IF DERIVATIVES STORED IN FILE          |
CC |                           0 OTHERWISE                              |
CC |  ITYPE          I*4       TYPE OF INTERPOLATION FILE               |
CC |  TBEG           R*8       EARLIEST TIME IN FILE                    |
CC |  TEND           R*8       LATEST TIME IN FILE                      |
CC |  IT RETURNS NON-ZERO IF OK, O OTHERWISE                            |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  rshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rinfo.F	',
C     &'1.6	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF, NVARS, NDERS, ITYPE
      DOUBLE PRECISION TBEG, TEND 
CC
CC    LOCAL VARIABLES
CC
CC    UNAVOIDABLE INCLUDE FILE TO RESERVE ENOUGHT MEMORY (FORTRAN)
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
CC
CC    IN THE NEXT INCLUDE, COMMON DATA IS STORED, AS OPEN I FILES, 
CC    THE RECORD LENGTHS ...
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC
      NVARS = RVARS (IF)
      NDERS = RDERS (IF)
      ITYPE = RTYPES(IF)
      TBEG = RTBEG (IF)
      TEND = RTEND (IF)
      RINFO = 1
      RETURN
      END
 
 
 
 
      INTEGER FUNCTION RIREC (IF, LREC, BUFFER)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE RIREC                       |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  READS A LOGICAL RECORD FROM FILE (OR BUFFER)                      |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF       I*4    INTERPOLATION FILE NUMBER                         |
CC |  LREC     I*4    LOGICAL RECORD TO WRITE                           |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  BUFFER() R*8    BUFFER CONTAINING HEADER                          |
CC |  RETURNS 0                                                         |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  rshare.inc                                                        |
CC |  dimensions.inc                                                    |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  IMPLICIT FUNCTIONS ONLY                                           |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/16 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.riorec.F	',
C     &'1.5	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF, LREC
CC
CC   LOCAL VARIABLES
CC
      INTEGER I, J, K, NREC, IOS
CC
CC    INCLUDING
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC
      DOUBLE PRECISION BUFFER(1)
      RIREC = 0
      IF (LREC.LT.RBUFFR(IF).OR.LREC.GT.RBUFLR(IF)) THEN
CC
CC    READ CURRENT RECORD
CC
         NREC = (LREC - 1) / RNLREC(IF) + 1
         READ (UNIT = RUNITS(IF), IOSTAT = IOS, REC = NREC) 
     .   (RFBUF (K, IF), K=1, RNLREC(IF)* RRECLS(IF)/8)
         IF (IOS.NE.0) THEN
            IF (PR.GT.0) WRITE (0,*) 
     .      'ERROR::RIREC: Error reading record'
            RIREC = IOS
            RETURN
         ENDIF
         RBUFFR(IF) = (NREC - 1) * RNLREC(IF) + 1
         RBUFLR(IF) = RBUFFR(IF) + RNLREC(IF) - 1
      ENDIF
CC
CC    READ FROM BUFFER
CC
      J = 1 + (LREC - RBUFFR(IF))* RRECLS(IF) / 8
      DO 10 I = 1, RRECLS(IF)/8
         BUFFER (I) = RFBUF (J, IF)
         J = J + 1
 10   CONTINUE
      RIREC = 0
      RETURN
      END


      INTEGER FUNCTION RIDOU (IF, LREC, DOU)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE RIDOU                       |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  READS THE FIRST DOUBLE OF LOGICAL RECORD FROM FILE (OR BUFFER)    |
CC |  IN THE FIRST DOUBLE USUALLY THE TIME IS STORED                    |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF       I*4    INTERPOLATION FILE NUMBER                         |
CC |  LREC     I*4    LOGICAL RECORD TO READ                            |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  DOU      R*8    BUFFER CONTAINING HEADER                          |
CC |  RETURNS 0                                                         |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  rshare.inc                                                        |
CC |  dimensions.inc                                                    |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  IMPLICIT FUNCTIONS ONLY                                           |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/16 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
      INTEGER IF, LREC
CC
CC   LOCAL VARIABLES
CC
      INTEGER J, K, NREC, IOS
CC
CC    INCLUDING
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC
      DOUBLE PRECISION DOU
      RIDOU = 0
      IF (LREC.LT.RBUFFR(IF).OR.LREC.GT.RBUFLR(IF)) THEN
CC
CC    READ CURRENT RECORD
CC
         NREC = (LREC - 1) / RNLREC(IF) + 1
         READ (UNIT = RUNITS(IF), IOSTAT = IOS, REC = NREC) 
     .   (RFBUF (K, IF), K=1, RNLREC(IF)* RRECLS(IF)/8)
         IF (IOS.NE.0) THEN
            IF (PR.GT.0) WRITE (0,*) 
     .      'ERROR::RIDOU: Error reading double'
            RIDOU = IOS
            RETURN
         ENDIF
         RBUFFR(IF) = (NREC - 1) * RNLREC(IF) + 1
         RBUFLR(IF) = RBUFFR(IF) + RNLREC(IF) - 1
      ENDIF
CC
CC    READ FROM BUFFER
CC
      J = 1 + (LREC - RBUFFR(IF))* RRECLS(IF) / 8
      DOU = RFBUF (J, IF)
      RIDOU = 0
      RETURN
      END
 
 
 
 
      INTEGER FUNCTION RNEXTB (IF)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE RNEXTB                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  POINTS TO NEXT BLOCK IN AN INTERPOLATION FILE OPEN FOR READ       |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER AS RETURNED BY WIFOP          |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  RETURNS NEXT BLOCK START RECORD (0 IF NOT EXISTING) <0 IN ERROR   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  rshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |                                                                    |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/09 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rnextb.F	',
C     &'1.6	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF
CC
CC    LOCAL VARIABLES
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC
      RNEXTB = -1
      IF (IF.LT.1.OR.IF.GT.MRFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RNEXTB: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (RFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::RNEXTB: Invalid identifier IF = ', IF
         RETURN
      ENDIF
CC
CC    IS THERE A BLOCK CURRENTLY OPEN? IF NOT GO TO THE FIRST BLOCK
CC
      IF (RCURB(IF).EQ.0) THEN
         RNEXTB = 1 + RHSIZ (IF)
      ELSE
         RNEXTB = RCNB (IF)
      ENDIF
CC
CC    IS THERE REALLY A BLOCK THERE?
CC
      IF (RNEXTB .EQ. 0 .OR. RNEXTB.GT. RLASTS(IF)) THEN
         RNEXTB = 0
         RETURN
      ENDIF
      RETURN
      END
 
 
 
 
      SUBROUTINE ROFCL (IF, IER)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE ROFCL            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  CLOSES AN ORBIT FILE PREVIOUSLY OPEN FOR READING WITH ROFOP. THE  |
CC |  TOTAL NUMBER OF ORBIT FILES IS LIMITED, BECAUSE OF CONSTANT       |
CC |  LENGTH OF FORTRAN ARRAYS. USING THIS SUBROUTINE, FREES MEMORY     |
CC |  USED BY THE CURRENT ORBIT FILE.                                   |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER FOR ORBIT FILE, AS RETURNED   |
CC |                           BY ROFOP                                 |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  IER            I*4       ERROR CODE, NON-ZERO IF ERROR            |
CC |                           1 = NOT ABLE TO CLOSE FILE               |
CC |                           2 = INVALID IDENTIFIER                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  rofsh.inc debugf.inc                                              |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  RIFCL                                                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imlib/orbit/orbfil/src/SCCS/s.rofcl.F	',
C     &'1.7	01/11/15 	IMSS_FDD\n'/
CC
      INTEGER IF, IER
CC
CC    LOCAL VARIABLES
CC
      INTEGER IUNER
      LOGICAL PR
CC
CC    CALLING
CC
      INTEGER RIFCL
CC
CC    INCLUDE
CC
C +----------------------+--------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA      |
C +----------------------|--------------------------+
C |   FDD                |  V. Companys             |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  DATA TO BE SHARED BETWEEN ROF?? FUNCTIONS. THIS INCLUDE FILE      |
C |  SHOULD BE CONSIDERED HIDDEN TO THE USER. USER SHOULD NEVER        |
C |  INCLUDE IT (THERE IS NO NEED).                                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFILP:                                                            |
C |    FTBEG()    R*8   START TIME OF ORBIT FILE                       |
C |    FTEND()    R*8   END TIME OF ORBIT FILE                         |
C |    LIF()      R*8   IDENTIFIERS FOR INTERFILE FUNCTION             |
C |    CURBLK() I*4   CURRENT BLOCK BEING READ                       |
C |    POINTS()   I*4   NUMBER OF POINTS TO INTERPOLATE                |
C |    FRA()      I*4   REFERENCE FRAME OF CURRENT BLOCK               |
C |    CEN()      I*4   REFERENCE BODY OF CURRENT BLOCK                |
C |    FVARS()    I*4   NUMBER OF VARIABLES IN FILE                    |
C |    ITSC()     I*4   TIME SCALES                                    |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_rofsh(2)
C     &/'@(#)/home/imlib/orbit/orbfil/inc/SCCS/s.rofsh.inc	',
C     &'1.7	01/11/15 	IMSS_FDD\n'/
C
      INTEGER MAXUN
      PARAMETER (MAXUN = 8)
C
      DOUBLE PRECISION FTBEG(MAXUN), FTEND(MAXUN)
      INTEGER CURBLK(MAXUN), POINTS(MAXUN), FRA(MAXUN),
     .        CEN(MAXUN), FVARS(MAXUN), ITSC(MAXUN)

      COMMON /ROFP/ FTBEG, FTEND, CURBLK, POINTS, 
     .               FRA, CEN, FVARS, ITSC





C ======================================================================
C INCLUDE FILE DEBUGF
C ======================================================================
C      CHARACTER*68 SCCS_INFO_debugf(2)
C     &/'@(#)/home/imlib/gen/errors/inc/SCCS/s.debugf.inc	',
C     &'1.1	98/04/21 	OAD_IMSS\n'/
C
      INTEGER      IDEBUG
      COMMON/ DEBUG/ IDEBUG(10)
C
CB    / DEBUG/ DEBUG FLAGS
CV    IF IDEBUG(1).NE.0 : TRACE MESSAGES ARE GENERATED AND WRITTEN
CV                        (FOR DEBUGGING, INTERMEDIATE OUTPUT...)
CV    IDEBUG(9)         : IT CONTROLS THE SEVERITY FOR THE MESSAGES 
CV                        OUTPUT
CV                        0 MEANS THAT REPEAT, ERROR AND
CV                          WARNING MESSAGES ARE WRITTEN
CV                        1 MEANS THAT ONLY REPEAT AND 
CV                          ERROR MESSAGES ARE WRITTEN
CV                        2 ONLY ERROR MESSAGES ARE WRITTEN
CV                        3 ERROR MESSAGES ARE NOT WRITTEN  
CV    IDEBUG(10)        : UNIT WHERE MESSAGES ARE GOING TO BE DISPLAYED
CV                        NEGATIVE UNIT MEANS UNIT 0 (UNIX STDERR)
CV                        TO LOGICAL UNIT NUMBER = IDEBUG(10).
CV                        0 MEANS NO MESSAGE WRITTEN
CV    IDEBUG(3)...IDEBUG(9) ARE CURRENTLY UNUSED.
CC
CC   FIX ONCE FOR EVER THE ERROR UNIT
CC
      IF (IDEBUG(10).LT.0) THEN
         IUNER = 0
      ELSE IF (IDEBUG(10).EQ.0) THEN
         IUNER = -1
      ELSE
         IUNER = IDEBUG(10)
      ENDIF
      PR = (IDEBUG(9).LT.3).AND.(IUNER.GE.0) 
      IF (IF .LT.1 .OR. IF .GT. MAXUN)
     .   THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E ROFCL. INVALID IDENTIFIER'
         ENDIF
         IER = 2
         RETURN
      ENDIF
CC
CC   CHECK IF UNIT ALREADY IN USE
CC
      IF (0.EQ. RIFCL(IF)) THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E ROFCL: NOT ABLE TO CLOSE FILE'
         ENDIF
         IER = 1
         RETURN
      ENDIF
      IER = 0
      RETURN
      END
      
      
 
 
 
 
      SUBROUTINE ROFOP (IUNIT, FNAME, IORDER, NVARS, IFRAME, IBODY,
     .                         ITSCAL, TBEG, TEND,IF, IER)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE ROFOP            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  OPENS AN ORBIT FILE FOR READING AND GIVES RELEVANT INFORMATION.   |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IUNIT(3)       I*4       UNIT TO WHERE FILE SHALL BE OPENED       |
CC |                           IF IUNIT(1) GREATER THAN 0:              |
CC |                             FILE SHALL BE OPENED TO UNIT IUNIT(1)  |
CC |                           IF IUNIT(1) EQUALS 0:                    |
CC |                             FILE SHALL BE OPENED TO A FREE UNIT    |
CC |                             BETWEEN IUNIT(2) AND IUNIT(3)          |
CC |                           IUNIT(1) LESS THAN 0 IS NOT ALLOWED      |
CC |  FNAME          C*132     NAME OF THE FILE TO BE OPENED.           |
CC |  IORDER         I*4       ORDER OF INTERPOLATION REQUIRED. THE     |
CC |                           NUMBER OF POINTS TO BE TAKEN TO THE LEFT |
CC |                           AND TO THE RIGHT IS COMPUTED FROM THIS   |
CC |                           ORDER. IN GENERAL, THE ACTUAL ORDER      |
CC |                           USED WILL BE GREATER OR EQUAL IORDER.    |
CC |                           ONLY IF NOT ENOUGH  POINTS ARE AVAILABLE,|
CC |                           THE ORDER MAY BECOME LESS THAN IORDER    |
CC |                           (E.G AT START AND END OF INTERVALS)      |
CC |                           ORIGINATING SOME DEGRADATION IN THE      |
CC |                           QUALITY OF INTERPOLATION                 |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  NVARS          I*4       NUMBER OF VARIABLES STORED IN ORBIT FILE |
CC |                           3:  ONLY POSITION IS STORED              |
CC |                           6:  POSITION AND VELOCITY ARE STORED     |
CC |                           42: POSITION, VELOCITY AND VARIATIONALS  |
CC |                               ARE STORED                           |
CC |  IFRAME         I*4       DEFAULT REFERENCE FRAME ID (FOR INFO)    |
CC |                           0: MEAN EQUATOR AND EQUINOX OF J2000.0   |
CC |                           1: MEAN ECLIPTIC AND EQUINOX OF J2000.0  |
CC |                           2: MEAN EQUATOR AND EQUINOX OF B1950.0   |
CC |                           3: MEAN ECLIPTIC AND EQUINOX OF B1950.0  |
CC |  IBODY          I*4       DEFAULT REFERENCE BODY ID (FOR INFO)     |
CC |                           0: BARY-CENTRE OF THE SOLAR SYSTEM       |
CC |                           1: MERCURY                               |
CC |                           2: VENUS                                 |
CC |                           3: EARTH                                 |
CC |                           4: MARS                                  |
CC |                           5: JUPITER                               |
CC |                           6: SATURN                                |
CC |                           7: URANUS                                |
CC |                           8: NEPTUNE                               |
CC |                           9: PLUTO                                 |
CC |                           10: MOON                                 |
CC |                           11: SUN                                  |
CC |  ITSCAL         I*4       TIME SCALE ID                            |
CC |                           0 : TDB (BARYCENTRIC DYNAMICAL TIME)     |
CC |                               IN MJD2000 FORMAT                    |
CC |  TBEG           R*8       EARLIEST TIME IN THE ORBIT FILE          |
CC |  TEND           R*8       LATEST TIME IN THE ORBIT FILE            |
CC |                           ATTENTION: ORBIT FILE MAY HAVE GAPS      |
CC |  IF             I*4       FILE IDENTIFIER TO BE USED IN SUBSEQUENT |
CC |                           CALLS TO ORBIT FILE ACCESS SUBROUTINES   |
CC |                           0 IF FAILED TO OPEN FILE                 |
CC |  IER            I*4       ERROR CODE, NON-ZERO IF ERROR            |
CC |                           1 = UNABLE TO OPEN FILE                  |
CC |                           2 = UNABLE TO GET ADDITIONAL PARAMETERS  |
CC |                           3 = TOO MANY FILES OPEN                  |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  rofsh.inc   TO RESOLVE FORTRAN UNITS AND INTERPOLATION FILE IDS   |
CC |  debugf.inc   ERROR PRINTING OPTIONS                               |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  RIFOP, RGETHE, RINFO, RIFCL                                       |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imlib/orbit/orbfil/src/SCCS/s.rofop.F	',
C     &'1.15	01/11/15 	IMSS_FDD\n'/
CC
      INTEGER IUNIT, NVARS, IORDER, IFRAME, IBODY, ITSCAL, IER,IF
      CHARACTER*132 FNAME
      DOUBLE PRECISION TBEG, TEND
CC
CC    LOCAL VARIABLES
      INTEGER BUF(3), IUNER, NDERS, IDUMTY
      LOGICAL PR
CC
CC    CALLING...
CC
      INTEGER RIFOP, RGETHE, RINFO, RIFCL
CC
CC
CC    INCLUDE FILES
CC
C +----------------------+--------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA      |
C +----------------------|--------------------------+
C |   FDD                |  V. Companys             |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  DATA TO BE SHARED BETWEEN ROF?? FUNCTIONS. THIS INCLUDE FILE      |
C |  SHOULD BE CONSIDERED HIDDEN TO THE USER. USER SHOULD NEVER        |
C |  INCLUDE IT (THERE IS NO NEED).                                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFILP:                                                            |
C |    FTBEG()    R*8   START TIME OF ORBIT FILE                       |
C |    FTEND()    R*8   END TIME OF ORBIT FILE                         |
C |    LIF()      R*8   IDENTIFIERS FOR INTERFILE FUNCTION             |
C |    CURBLK() I*4   CURRENT BLOCK BEING READ                       |
C |    POINTS()   I*4   NUMBER OF POINTS TO INTERPOLATE                |
C |    FRA()      I*4   REFERENCE FRAME OF CURRENT BLOCK               |
C |    CEN()      I*4   REFERENCE BODY OF CURRENT BLOCK                |
C |    FVARS()    I*4   NUMBER OF VARIABLES IN FILE                    |
C |    ITSC()     I*4   TIME SCALES                                    |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_rofsh(2)
C     &/'@(#)/home/imlib/orbit/orbfil/inc/SCCS/s.rofsh.inc	',
C     &'1.7	01/11/15 	IMSS_FDD\n'/
C
      INTEGER MAXUN
      PARAMETER (MAXUN = 8)
C
      DOUBLE PRECISION FTBEG(MAXUN), FTEND(MAXUN)
      INTEGER CURBLK(MAXUN), POINTS(MAXUN), FRA(MAXUN),
     .        CEN(MAXUN), FVARS(MAXUN), ITSC(MAXUN)

      COMMON /ROFP/ FTBEG, FTEND, CURBLK, POINTS, 
     .               FRA, CEN, FVARS, ITSC





C ======================================================================
C INCLUDE FILE DEBUGF
C ======================================================================
C      CHARACTER*68 SCCS_INFO_debugf(2)
C     &/'@(#)/home/imlib/gen/errors/inc/SCCS/s.debugf.inc	',
C     &'1.1	98/04/21 	OAD_IMSS\n'/
C
      INTEGER      IDEBUG
      COMMON/ DEBUG/ IDEBUG(10)
C
CB    / DEBUG/ DEBUG FLAGS
CV    IF IDEBUG(1).NE.0 : TRACE MESSAGES ARE GENERATED AND WRITTEN
CV                        (FOR DEBUGGING, INTERMEDIATE OUTPUT...)
CV    IDEBUG(9)         : IT CONTROLS THE SEVERITY FOR THE MESSAGES 
CV                        OUTPUT
CV                        0 MEANS THAT REPEAT, ERROR AND
CV                          WARNING MESSAGES ARE WRITTEN
CV                        1 MEANS THAT ONLY REPEAT AND 
CV                          ERROR MESSAGES ARE WRITTEN
CV                        2 ONLY ERROR MESSAGES ARE WRITTEN
CV                        3 ERROR MESSAGES ARE NOT WRITTEN  
CV    IDEBUG(10)        : UNIT WHERE MESSAGES ARE GOING TO BE DISPLAYED
CV                        NEGATIVE UNIT MEANS UNIT 0 (UNIX STDERR)
CV                        TO LOGICAL UNIT NUMBER = IDEBUG(10).
CV                        0 MEANS NO MESSAGE WRITTEN
CV    IDEBUG(3)...IDEBUG(9) ARE CURRENTLY UNUSED.
CC
CC    INIT
CC
      IER = 0
      IF (IDEBUG(10).LT.0) THEN
         IUNER = 0
      ELSE IF (IDEBUG(10).EQ.0) THEN
         IUNER = -1
      ELSE
         IUNER = IDEBUG(10)
      ENDIF
      PR = (IDEBUG(9).LT.3).AND.(IUNER.GE.0) 
CC
CC   OPEN FILE
CC
      IF = RIFOP (IUNIT, FNAME)
      IF (IF.GT.MAXUN) THEN
         IER = RIFCL (IF)
         IER = 3
         IF = 0
         IF (PR) THEN
         WRITE (IUNER, *) 'E ROFOP. TO MANY ORBIT FILES OPEN'
         ENDIF
         RETURN 
      ENDIF
      IF (IF.EQ.0) THEN
         IER = 1
         IF (PR) THEN
         WRITE (IUNER, *) 'E ROFOP. NOT ABLE TO OPEN FILE'
         ENDIF
         RETURN
      ENDIF
CC
CC

      IF (0.EQ.RINFO (IF, NVARS, NDERS, IDUMTY, TBEG, TEND)) THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E ROFOP. UNABLE TO GET PARAMETERS'
         ENDIF
         IER = 2
         RETURN
      ENDIF
      FVARS (IF) = NVARS
      FTBEG(IF) = TBEG
      FTEND(IF) = TEND
      CURBLK(IF) = 0
      FRA(IF) = 0
      CEN(IF) = 0
      POINTS(IF) = IORDER / (NDERS+ 1) / 2 + 1
      IF (0.EQ.RGETHE (IF, BUF, 13, 3)) THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E ROFOP. UNABLE TO GET PARAMETERS'
         ENDIF
         IER = 2
         RETURN
      ENDIF
      IFRAME = BUF (1)
      IBODY = BUF (2)
      ITSCAL = BUF (3)
      RETURN
      END
      
      

 
 
 
 
      SUBROUTINE ROFRR (IF, TIME, STATE, IFRAME, IBODY, IER)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE ROFRR            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  RETRIEVES STATE FROM ORBIT FILE. THE ORBIT FILE HAS BEEN OPENED   |
CC |  WITH SUBROUTINE ROFOP.                                            |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER FOR ORBIT FILE, AS RETURNED   |
CC |                           BY ROFOP                                 |
CC |  TIME           R*8       TIME TO RETRIEVE THE STATE IN TDB TIME   |
CC |                           SCALE AND MJD2000 TIME FORMAT            |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  STATE(6)       R*8       STATE VECTOR GIVEN IN REFERENCE FRAME    |
CC |                           'IFRAME' AND RELATIVE TO REFERENCE BODY  |
CC |                           'IBODY'.                                 |
CC |                           STATE(1..3):                             |
CC |                           POSITION IN KM                           |
CC |                           STATE(4..6):                             |
CC |                           VELOCITY IN KM/S                         |
CC |  IFRAME         I*4       REFERENCE FRAME ID FOR RETURNED STATE    |
CC |                           0: MEAN EQUATOR AND EQUINOX OF J2000.0   |
CC |                           1: MEAN ECLIPTIC AND EQUINOX OF J2000.0  |
CC |                           2: MEAN EQUATOR AND EQUINOX OF B1950.0   |
CC |                           3: MEAN ECLIPTIC AND EQUINOX OF B1950.0  |
CC |  IBODY          I*4       REFERENCE BODY ID  FOR RETURNED STATE    |
CC |                           0: BARY-CENTRE OF THE SOLAR SYSTEM       |
CC |                           1: MERCURY                               |
CC |                           2: VENUS                                 |
CC |                           3: EARTH                                 |
CC |                           4: MARS                                  |
CC |                           5: JUPITER                               |
CC |                           6: SATURN                                |
CC |                           7: URANUS                                |
CC |                           8: NEPTUNE                               |
CC |                           9: PLUTO                                 |
CC |                           10: MOON                                 |
CC |                           11: SUN                                  |
CC |  IER            I*4:      RETURN CODE. ZERO IF OK                  |
CC |                           1:  TIME TO EARLY                        |
CC |                           2:  TIME TO LATE                         |
CC |                           3:  TIME IN A GAP                        |
CC |                           4:  ERROR GETTING ADDITIONAL PARAMETERS  |
CC |                           5:  ERROR CAN'T READ BLOCK HEADER        |
CC |                           6:  INVALID IDENTIFIER                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  rofsh.inc debugf.inc                                              |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  RRERED, RGETBL                                                    |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imlib/orbit/orbfil/src/SCCS/s.rofrr.F	',
C     &'1.12	02/04/30 	IMSS_FDD\n'/
CC
      INTEGER IF, IFRAME, IBODY, IER
      DOUBLE PRECISION TIME, STATE(1)
CC
CC    LOCAL VARIABLES
      INTEGER BUF(2), IUNER, CB
      LOGICAL PR
      DOUBLE PRECISION TE, TB
      INTEGER NBLOCK,NTOP,NDERS


CC
CC    CALLING
CC
      INTEGER RBINFO, RRERED, RGETBL
CC
CC    INCLUDE
CC
C +----------------------+--------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA      |
C +----------------------|--------------------------+
C |   FDD                |  V. Companys             |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  DATA TO BE SHARED BETWEEN ROF?? FUNCTIONS. THIS INCLUDE FILE      |
C |  SHOULD BE CONSIDERED HIDDEN TO THE USER. USER SHOULD NEVER        |
C |  INCLUDE IT (THERE IS NO NEED).                                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFILP:                                                            |
C |    FTBEG()    R*8   START TIME OF ORBIT FILE                       |
C |    FTEND()    R*8   END TIME OF ORBIT FILE                         |
C |    LIF()      R*8   IDENTIFIERS FOR INTERFILE FUNCTION             |
C |    CURBLK() I*4   CURRENT BLOCK BEING READ                       |
C |    POINTS()   I*4   NUMBER OF POINTS TO INTERPOLATE                |
C |    FRA()      I*4   REFERENCE FRAME OF CURRENT BLOCK               |
C |    CEN()      I*4   REFERENCE BODY OF CURRENT BLOCK                |
C |    FVARS()    I*4   NUMBER OF VARIABLES IN FILE                    |
C |    ITSC()     I*4   TIME SCALES                                    |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_rofsh(2)
C     &/'@(#)/home/imlib/orbit/orbfil/inc/SCCS/s.rofsh.inc	',
C     &'1.7	01/11/15 	IMSS_FDD\n'/
C
      INTEGER MAXUN
      PARAMETER (MAXUN = 8)
C
      DOUBLE PRECISION FTBEG(MAXUN), FTEND(MAXUN)
      INTEGER CURBLK(MAXUN), POINTS(MAXUN), FRA(MAXUN),
     .        CEN(MAXUN), FVARS(MAXUN), ITSC(MAXUN)

      COMMON /ROFP/ FTBEG, FTEND, CURBLK, POINTS, 
     .               FRA, CEN, FVARS, ITSC





C ======================================================================
C INCLUDE FILE DEBUGF
C ======================================================================
C      CHARACTER*68 SCCS_INFO_debugf(2)
C     &/'@(#)/home/imlib/gen/errors/inc/SCCS/s.debugf.inc	',
C     &'1.1	98/04/21 	OAD_IMSS\n'/
C
      INTEGER      IDEBUG
      COMMON/ DEBUG/ IDEBUG(10)
C
CB    / DEBUG/ DEBUG FLAGS
CV    IF IDEBUG(1).NE.0 : TRACE MESSAGES ARE GENERATED AND WRITTEN
CV                        (FOR DEBUGGING, INTERMEDIATE OUTPUT...)
CV    IDEBUG(9)         : IT CONTROLS THE SEVERITY FOR THE MESSAGES 
CV                        OUTPUT
CV                        0 MEANS THAT REPEAT, ERROR AND
CV                          WARNING MESSAGES ARE WRITTEN
CV                        1 MEANS THAT ONLY REPEAT AND 
CV                          ERROR MESSAGES ARE WRITTEN
CV                        2 ONLY ERROR MESSAGES ARE WRITTEN
CV                        3 ERROR MESSAGES ARE NOT WRITTEN  
CV    IDEBUG(10)        : UNIT WHERE MESSAGES ARE GOING TO BE DISPLAYED
CV                        NEGATIVE UNIT MEANS UNIT 0 (UNIX STDERR)
CV                        TO LOGICAL UNIT NUMBER = IDEBUG(10).
CV                        0 MEANS NO MESSAGE WRITTEN
CV    IDEBUG(3)...IDEBUG(9) ARE CURRENTLY UNUSED.

CC     INITIALIZE
      NBLOCK = 0
      NTOP = 0
      NDERS = 0

CC   FIX ONCE FOR EVER THE ERROR UNIT
CC
      IF (IDEBUG(10).LT.0) THEN
         IUNER = 0
      ELSE IF (IDEBUG(10).EQ.0) THEN
         IUNER = -1
      ELSE
         IUNER = IDEBUG(10)
      ENDIF
      PR = (IDEBUG(9).LT.3).AND.(IUNER.GE.0)
      IF (IF .LT.1 .OR. IF .GT. MAXUN)
     .   THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E ROFRR. INVALID IDENTIFIER'
         ENDIF
         IER = 6
         RETURN
      ENDIF
      IF ((TIME-FTBEG(IF))*
     .    (TIME-FTEND(IF)).GT.0) THEN
         IF(TIME.GT.FTEND(IF)) THEN
            IF (PR) THEN
            WRITE (IUNER, *) 'E ROFRR. TIME TO LATE'
            ENDIF
            IER = 2
            RETURN
         ELSE
            IF (PR) THEN
            WRITE (IUNER, *) 'E ROFRR. TIME TO EARLY'
            ENDIF
            IER = 1
            RETURN
         ENDIF
      ENDIF
      IF (RRERED (IF, TIME,
     .     NBLOCK,NTOP,NDERS, POINTS(IF), STATE).EQ.0) THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E ROFRR. NOT ABLE TO COMPUTE STATE.'
         WRITE (IUNER, *) '         TIME MAY BE IN A GAP.'
         ENDIF
         IER = 3
         RETURN
      ENDIF
      IF (0.EQ.RBINFO (IF, CB, TB, TE)) THEN
         IF (PR) THEN
         WRITE (IUNER, *) 
     .    'E ROFRR. FAILED GETTING ADDITIONAL PARAMETERS.'
         ENDIF
         IER = 4
         RETURN
      ENDIF
      IF (CURBLK(IF).NE.CB) THEN
         IF (0.EQ.RGETBL (IF, BUF, 9, 2)) THEN
            IF (PR) THEN
            WRITE (IUNER, *) 
     .      'E ROFRR. CAN''T READ BLOCK HEADER.'
            ENDIF
            IER = 5
            RETURN
         ENDIF
         FRA(IF) = BUF(1)
         CEN(IF) = BUF(2)
         CURBLK(IF) = CB
      ENDIF
      IFRAME = FRA(IF)
      IBODY = CEN(IF)
      IER = 0
      RETURN
      END
      
      
 
 
 
 
      INTEGER FUNCTION RRERED (IF, TIME, NBLOCK,NTOP,NDERS,NHPS, STATE)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE RRERED                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  GIVEN A TIME, IT SEARCHES FOR A BLOCK IN AN INTERPOLATION FILE,   |
CC |  AND READS THOSE RECORDS NECESSARY TO PERFORM AN INTERPOLATION     |
CC |  OF THE REQUIRED ORDER. THEN IT MAKES THE INTERPOLATION ITSELF     |
CC |  IT KEEPS THE DATA FOR SUBSEQUENT CALLS. IT RETURNS INTERPOLATED   |
CC |  STATE                                                             |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER AS RETURNED BY RIFOP          |
CC |  TIME           R*8       TIME TO RETURN STATE VECTOR              |
CC |  NBLOCK         I*4       NUMBER OF BLOCK, IF .EQ. 0,              |
CC |                           THEN NO SPECIFIC BLOCK IS CHOSEN, ANY    |
CC |                           BLOCK IS FOUND WITH THE REQUIRED DATA    |
CC |                           COULD THEN BE CHOSEN.                    |
CC |  NTOP           I*4       TOPOLOGY FLAG                            |
CC |                           DECIDES, IF THE BLOCKS ARE CONSIDERED AS |
CC |                           0 = BOTH  SIDED      CLOSED: [A,B]       |
CC |                           1 = RIGHT SIDED HALF CLOSED: ]A,B]       |
CC |                           2 = LEFT  SIDED HALF CLOSED: [A,B[       |
CC |                           3 = BOTH  SIDED        OPEN: ]A,B[       |
CC |  NDERS          I*4       THE NUMBER OF DERIVATIVES, THAT SHALL BE |
CC |                           HANDED BACK                              |
CC |  NHPS           I*4       HALF THE NUMBER OF THE POINTS TO TAKE    |
CC |                           TO INTERPOLATE                           |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  STATE         R*8        AS INTERPOLATED FROM DATA IN THE FILE    |
CC |  1 IN SUCCESS, 0 OTHERWISE                                         |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  rshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  RGETRE, RGOTOB, RNEXTB, RIDOU, LAGRDE, HERMDE, RTFNDB             |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/12 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
CC
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rrered.F	',
C     &'1.8	02/07/09 	IMSS_FDD\n'/
CC
      INTEGER IF, NTOP, NBLOCK, NHPS, NDERS, IER
      DOUBLE PRECISION TIME, STATE(1)
CC
CC    LOCAL VARIABLES
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC
      DOUBLE PRECISION REC1 (MNUMVA * 2 + 1), REC2 (MNUMVA * 2 + 1),
     .                 REC3 (MNUMVA * 2 + 1)
      INTEGER I1,I2,I3, RECNUM, I, J, K, L, M, NN, NL, N

      DOUBLE PRECISION  BTMIN, BTMAX
CC
CC     Used in block table modification:
      INTEGER IRSBLN, IERROR
CC
CC    CALLING
CC
      INTEGER RGETRE, RGOTOB, RNEXTB, RIDOU
CC
CC    DEFINITION OF A STATEMENT FUNCTION TO COMPUTE THE INDEX OF A ROW IN
CC    THE CYCLIC TABLES (RX AND RDITAB)
CC
      INTEGER IN
      IN (J) = MOD (J + RFRF(IF) -2 + 2 * MRMAXT, MRMAXT) + 1
CC     
      RRERED = 0
      IF (IF.LT.1.OR.IF.GT.MRFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .        'ERROR::RRERED: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (RFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .        'ERROR::RRERED: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      
CC     CHECK NBLOCK FOR BEEING >= 0
      IF ( NBLOCK .LT. 0 ) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .        'ERROR::RRERED: Number of block not positive ',NBLOCK 
         RETURN
      ENDIF

CC     
CC     IF A BLOCK IS ALREADY OPEN, CHECK IF TIME CORRESPONDS
CC     TO BLOCK
CC
CC     
CC     NOW TEST IF THE CURRENT BLOCK USES ASCENDING OR DESCENDING TIME
CC     LINES AND FIND THE LOWEST AND HIGHEST TIME FOR THE BLOCK

      IF (RBTBEG(IF) .LE. RBTEND(IF)) THEN
         BTMIN = RBTBEG(IF)
         BTMAX = RBTEND(IF)
      ELSE
         BTMIN = RBTEND(IF)
         BTMAX = RBTBEG(IF)
      ENDIF

CC     HAS ANY BLOCK HEADER BEEN READ?
CC     
      IF (0.NE.RCURB(IF)) THEN
         
CC     FIND THE RIGHT BLOCK DEPENDING ON THE APPROPRIATE CASE 

         IF     (NTOP .EQ. 0) THEN
CC     BOTH  SIDED      CLOSED: [A,B] 
            IF (.NOT.(     (TIME .GE. BTMIN)
     .                .AND.(TIME .LE. BTMAX)) )THEN
               RCURB(IF) = 0
               NCURB(IF) = 0
            ENDIF

         ELSEIF (NTOP .EQ. 1) THEN
CC     RIGHT SIDED HALF CLOSED: ]A,B]
            IF (.NOT.(     (TIME .GT. BTMIN)
     .                .AND.(TIME .LE. BTMAX)) )THEN
               RCURB(IF) = 0
               NCURB(IF) = 0
            ENDIF

         ELSEIF (NTOP .EQ. 2) THEN
CC     LEFT  SIDED HALF CLOSED: [A,B[
            IF (.NOT.(     (TIME .GE. BTMIN)
     .                .AND.(TIME .LT. BTMAX)) )THEN
               RCURB(IF) = 0
               NCURB(IF) = 0
            ENDIF

         ELSEIF (NTOP .EQ. 3) THEN
CC     BOTH  SIDED        OPEN: ]A,B[
            IF (.NOT.(     (TIME .GT. BTMIN)
     .                .AND.(TIME .LT. BTMAX)) )THEN
               RCURB(IF) = 0
               NCURB(IF) = 0
           ENDIF

         ELSE
CC     ERROR
            IF (PR.GT.0) WRITE (0,*)
     .           'ERROR::RRERED: Topology Flag not valid: NTOP =',NTOP
            RETURN
         ENDIF

CC     IF THE TIME IS IN THAT BLOCK, TEST IF IT IS THE RIGHT BLOCK,
CC     IF NOT LET THE SEARCH START (OTHERWISE WE WOULD SEARCH ANYWAYS...)
         IF( (NBLOCK .GT.0) .AND. (NCURB(IF).NE.NBLOCK) ) THEN
            RCURB(IF) = 0
            NCURB(IF) = 0
         ENDIF
      ENDIF



CC     Check if time is in current block (in that case is RCURB not reset
CC     to zero) - otherwise search for it
      IF (RCURB(IF).EQ.0) THEN
         
CC---- Block table exists - then go directly to block
         IF (LBTFLG(IF) .EQV. .TRUE.) THEN
            
            IF ( NBLOCK .GT. 0 ) THEN
               CALL RDGOTB(IF, NBLOCK, IERROR)
               IF (IERROR.NE.0) THEN
                  IF (PR.GT.0) WRITE (0,*)
     .             'ERROR::RRERED: Failed moving block (using RDGOTB)'
                  RETURN
               ENDIF 
CC     WE HAVE TO TEST FOR THE TIME NOW.
CC     THIS IS DONE BEST BY USING THE NTOP STRUCTURE STARTING IN LINE 16.
CC     ALTHOUGH A SECOND BLOCK TEST WILL BE DONE,
CC     THIS SAVES QUIET SOME DOUBLED CODE.
               GOTO 10

            ELSE
               CALL RTFNDB(IF, TIME, NTOP, IRSBLN, IERROR)
               IF (IERROR.NE.0) THEN
                  IF (PR.GT.0) WRITE (0,*)
     .             'ERROR::RRERED: Failed finding block (using RTFNDB)'
                  RETURN
               ENDIF
            ENDIF
            
CC---- otherwise do as earlier - simple walk-through-blocks search
         ELSE

CC
CC    FORTRAN 77 STYLE LOOP
CC
CC    INITIALISATION
CC
            RECNUM = RNEXTB(IF)
            IF (0.GE.RECNUM) THEN
               IF (PR.GT.0) WRITE (0,*)
     .              'ERROR::RRERED: Could not find first block'
               RETURN
            ENDIF
            IF (0.EQ.RGOTOB(IF,RECNUM)) THEN
               IF (PR.GT.0) WRITE (0,*)
     .              'ERROR::RRERED: Could not find first block'
               RETURN
            ENDIF
CC
 10         CONTINUE
CC
CC    BODY
CC
CC
CC    CHECK
CC
CC     NOW TEST IF THE CURRENT BLOCK USES ASCENDING OR DESCENDING TIME
CC     LINES AND FIND THE LOWEST AND HIGHEST TIME FOR THE BLOCK

            IF (RBTBEG(IF) .LE. RBTEND(IF)) THEN
               BTMIN = RBTBEG(IF)
               BTMAX = RBTEND(IF)
            ELSE
               BTMIN = RBTEND(IF)
               BTMAX = RBTBEG(IF)
            ENDIF

            IF (RCURB(IF)) 15,15,16
 15         IF (PR.GT.0) WRITE (0,*)
     .      'ERROR::RRERED: Could not find time in file'
            RETURN

CC     FIND THE RIGHT BLOCK DEPENDING ON THE APPROPRIATE CASE 

 16      IF (NTOP .EQ. 0) THEN
CC     BOTH  SIDED      CLOSED: [A,B] 
            IF (.NOT.(     (TIME .GE. BTMIN)
     .                .AND.(TIME .LE. BTMAX)) )THEN
               GOTO 17
            ELSE
               GOTO 20
            ENDIF

         ELSEIF (NTOP .EQ. 1) THEN
CC     RIGHT SIDED HALF CLOSED: ]A,B]
            IF (.NOT.(     (TIME .GT. BTMIN)
     .                .AND.(TIME .LE. BTMAX)) )THEN
               GOTO 17
            ELSE
               GOTO 20
            ENDIF

         ELSEIF (NTOP .EQ. 2) THEN
CC     LEFT  SIDED HALF CLOSED: [A,B[
            IF (.NOT.(     (TIME .GE. BTMIN)
     .                .AND.(TIME .LT. BTMAX)) )THEN
               GOTO 17
            ELSE
               GOTO 20
            ENDIF

         ELSEIF (NTOP .EQ. 3) THEN
CC     BOTH  SIDED        OPEN: ]A,B[
            IF (.NOT.(     (TIME .GT. BTMIN)
     .                .AND.(TIME .LT. BTMAX)) )THEN
               GOTO 17
            ELSE
               GOTO 20
            ENDIF

         ELSE
CC     ERROR
            IF (PR.GT.0) WRITE (0,*)
     .           'ERROR::RRERED: Topology Flag not valid: NTOP =',NTOP
            RETURN
         ENDIF
CC
CC    ITERATIONS
CC
 17      RECNUM = RNEXTB(IF)
         IF (0.GE.RECNUM) THEN
            IF (PR.GT.0) WRITE (0,*)
     .     'ERROR::RRERED: Time outside file span / not in spec. block'
            RETURN
         ENDIF
         IF (0.EQ.RGOTOB(IF,RECNUM)) THEN
            IF (PR.GT.0) WRITE (0,*)
     .   'ERROR::RRERED: Failed moving block / Time not in spec. block'
            RETURN
         ENDIF
         GO TO 10
 20      CONTINUE

CC     WE HAVE NOW A BLOCK, AND THE TIME IS IN THE BLOCK INTERVAL,
CC     BUT IS IT THE RIGHT BLOCK ? IF NOT GO TO THE NEXT ONE ...
         IF( (NBLOCK .GT. 0) .AND. (NCURB(IF).NE.NBLOCK) ) GOTO 17
      ENDIF
      ENDIF
CC
CC
CC    CONSTRUCT INTERPOLATION TABLE, IN CASE THIS IS NOT
CC    DONE YET
CC    FIRST LOCALISE THE NEAREST RECORD
CC
      IF (RFRR(IF).EQ.0) THEN
CC
CC    NOTHING IS READ YET
CC
CC    FIRST AND LAST DO NOT NEED TO BE READ
CC
         I1 = RCFR (IF)
         I3 = RCLR (IF)
         REC1(1) = RBTBEG (IF)
         REC3(1) = RBTEND (IF)
 30      CONTINUE
            IF (I1.LT.RBUFFR(IF).AND.RBUFFR(IF).LT.I3) THEN
               IF (0.NE.RIDOU(IF,RBUFFR(IF),REC2)) THEN
                  IF (PR.GT.0) WRITE (0,*)
     .            'ERROR::RRERED: Failed reading record'
                  RETURN
               ENDIF
               IF ((TIME-REC1(1))*(TIME-REC2(1)).LE.0.D0) THEN
                  I3 = RBUFFR(IF)
                  REC3(1) = REC2(1)
               ELSE
                  I1 = RBUFFR(IF)
                  REC1(1) = REC2(1)
               ENDIF
            ENDIF
            IF (I1.LT.RBUFLR(IF).AND.RBUFLR(IF).LT.I3) THEN
               IF (0.NE.RIDOU(IF,RBUFLR(IF),REC2)) THEN
                  IF (PR.GT.0) WRITE (0,*)
     .            'ERROR::RRERED: Failed reading record'
                  RETURN
               ENDIF
               IF ((TIME-REC1(1))*(TIME-REC2(1)).LE.0.D0) THEN
                  I3 = RBUFLR(IF)
                  REC3(1) = REC2(1)
               ELSE
                  I1 = RBUFLR(IF)
                  REC1(1) = REC2(1)
               ENDIF
            ENDIF
            IF (I3-I1-1) 40,40,31
 31         I2 = (I1 + I3) / 2
            IF (0.NE.RIDOU(IF,I2,REC2)) THEN
               IF (PR.GT.0) WRITE (0,*)
     .         'ERROR::RRERED: Failed reading record'
               RETURN
            ENDIF
            IF ((TIME-REC1(1))*(TIME-REC2(1)).LE.0.D0) THEN
               I3 = I2
               REC3(1) = REC2(1)
            ELSE
               I1 = I2
               REC1(1) = REC2(1)
            ENDIF
            GO TO 30
 40      CONTINUE
CC
CC    NOW READ
CC
         J = 1
         DO 50 I = MAX(I3 - NHPS,RCFR (IF)), 
     .             MIN(I1 + NHPS,RCLR (IF))
            IF (0.EQ.RGETRE(IF,I,REC2)) THEN
                IF (PR.GT.0) WRITE (0,*)
     .          'ERROR::RRERED: Failed reading record'
                RETURN
            ENDIF
            K = IN (J)
            RX(K,IF) = REC2 (1)
            DO 45 L = 1, RVARS(IF)
               RFS (L, K, IF) = REC2(L+1)
 45         CONTINUE 
            IF (RDERS(IF).NE.0) THEN
               DO 46 L = 1, RVARS(IF)
                  RDS (L, K, IF) = REC2(L+RVARS(IF)+1)
 46            CONTINUE 
            ENDIF
            J = J + 1
 50      CONTINUE
         RFRR(IF) = MAX(I3 - NHPS,RCFR (IF))
         RLRR(IF) = MIN(I1 + NHPS,RCLR (IF))
         J = J - 1
         RLRF(IF) = IN (J)
         RFTR(IF) = RX (IN(1), IF)
         RLTR(IF) = RX (IN(J), IF)
CC
CC    TABLE IS COMPLETE NOW
CC
         
      ELSE IF ((TIME - RBTBEG (IF)) * (TIME - RFTR(IF)).LE.0) THEN
CC
CC    SOMETHING IS READ, AFTER DESIRED TIME
CC
         I1 = RCFR (IF)
         I3 = RFRR (IF)
         REC1(1) = RBTBEG (IF)
         REC3(1) = RFTR(IF)
 60      CONTINUE
            IF (I1.LT.RBUFFR(IF).AND.RBUFFR(IF).LT.I3) THEN
               IF (0.NE.RIDOU(IF,RBUFFR(IF),REC2)) THEN
                  IF (PR.GT.0) WRITE (0,*)
     .            'ERROR::RRERED: Failed reading record'
                  RETURN
               ENDIF
               IF ((TIME-REC1(1))*(TIME-REC2(1)).LE.0.D0) THEN
                  I3 = RBUFFR(IF)
                  REC3(1) = REC2(1)
               ELSE
                  I1 = RBUFFR(IF)
                  REC1(1) = REC2(1)
               ENDIF
            ENDIF
            IF (I1.LT.RBUFLR(IF).AND.RBUFLR(IF).LT.I3) THEN
               IF (0.NE.RIDOU(IF,RBUFLR(IF),REC2)) THEN
                  IF (PR.GT.0) WRITE (0,*)
     .            'ERROR::RRERED: Failed reading record'
                  RETURN
               ENDIF
               IF ((TIME-REC1(1))*(TIME-REC2(1)).LE.0.D0) THEN
                  I3 = RBUFLR(IF)
                  REC3(1) = REC2(1)
               ELSE
                  I1 = RBUFLR(IF)
                  REC1(1) = REC2(1)
               ENDIF
            ENDIF
            IF (I3-I1-1) 70,70,61
 61         I2 = (I1 + I3) / 2
            IF (0.NE.RIDOU(IF,I2,REC2)) THEN
               IF (PR.GT.0) WRITE (0,*)
     .         'ERROR::RRERED: Failed reading record'
               RETURN
            ENDIF
            IF ((TIME-REC1(1))*(TIME-REC2(1)).LE.0.D0) THEN
               I3 = I2
               REC3(1) = REC2(1)
            ELSE
               I1 = I2
               REC1(1) = REC2(1)
            ENDIF
            GO TO 60
 70      CONTINUE
CC
CC    NOW READ
CC
         J = 0
         DO 80 I = MIN(I1 + NHPS,RFRR (IF)-1),
     .             MAX(I3 - NHPS,RCFR (IF)), -1
            IF (0.EQ.RGETRE(IF,I,REC2)) THEN
                IF (PR.GT.0) WRITE (0,*)
     .          'ERROR::RRERED: Failed reading record'
                RETURN
            ENDIF
            K = IN (J)
            RX(K, IF) = REC2 (1)
            DO 75 L = 1, RVARS(IF)
               RFS (L, K, IF) = REC2(L+1)
 75         CONTINUE 
            IF (RDERS(IF).NE.0) THEN
               DO 76 L = 1, RVARS(IF)
                  RDS (L, K, IF) = REC2(L+RVARS(IF)+1)
 76            CONTINUE 
            ENDIF
            J = J - 1
 80      CONTINUE
         J = J + 1
         IF (I1+NHPS.LT.RFRR(IF)) THEN
            RLRF(IF) = IN(0)
         ELSE
            M = I1 + NHPS - RFRR(IF) + 1
            RLRF(IF) = MIN (IN(M), RLRF(IF))
         ENDIF
         RFRF(IF) = IN (J)
         RFRR(IF) = MAX(I3 - NHPS,RCFR (IF))
         RLRR(IF) = MIN(I1 + NHPS,RLRR (IF))
         RFTR(IF) = RX (RFRF(IF), IF)
         RLTR(IF) = RX (RLRF(IF), IF)
CC
CC    TABLE IS COMPLETE NOW
CC
      ELSE IF ((TIME - RBTEND (IF)) * (TIME - RLTR(IF)).LE.0) THEN
CC
CC    SOMETHING IS READ, BEFORE DESIRED TIME
CC
         I1 = RLRR (IF)
         I3 = RCLR (IF)
         REC1(1) = RLTR (IF)
         REC3(1) = RBTEND(IF)
 90      CONTINUE
            IF (I1.LT.RBUFFR(IF).AND.RBUFFR(IF).LT.I3) THEN
               IF (0.NE.RIDOU(IF,RBUFFR(IF),REC2)) THEN
                  IF (PR.GT.0) WRITE (0,*)
     .            'ERROR::RRERED: Failed reading record'
                  RETURN
               ENDIF
               IF ((TIME-REC1(1))*(TIME-REC2(1)).LE.0.D0) THEN
                  I3 = RBUFFR(IF)
                  REC3(1) = REC2(1)
               ELSE
                  I1 = RBUFFR(IF)
                  REC1(1) = REC2(1)
               ENDIF
            ENDIF
            IF (I1.LT.RBUFLR(IF).AND.RBUFLR(IF).LT.I3) THEN
               IF (0.NE.RIDOU(IF,RBUFLR(IF),REC2)) THEN
                  IF (PR.GT.0) WRITE (0,*)
     .            'ERROR::RRERED: Failed reading record'
                  RETURN
               ENDIF
               IF ((TIME-REC1(1))*(TIME-REC2(1)).LE.0.D0) THEN
                  I3 = RBUFLR(IF)
                  REC3(1) = REC2(1)
               ELSE
                  I1 = RBUFLR(IF)
                  REC1(1) = REC2(1)
               ENDIF
            ENDIF
            IF (I3-I1-1) 100,100,91
 91         I2 = (I1 + I3) / 2
            IF (0.NE.RIDOU(IF,I2,REC2)) THEN
               IF (PR.GT.0) WRITE (0,*)
     .         'ERROR::RRERED: Failed reading record'
               RETURN
            ENDIF
            IF ((TIME-REC1(1))*(TIME-REC2(1)).LE.0.D0) THEN
               I3 = I2
               REC3(1) = REC2(1)
            ELSE
               I1 = I2
               REC1(1) = REC2(1)
            ENDIF
            GO TO 90
 100     CONTINUE
CC
CC    NOW READ
CC
         J = RLRR(IF) - RFRR(IF) + 1
         J = J + 1
         N = J
         DO 110 I = MAX(I3 - NHPS,RLRR (IF)+ 1),
     .              MIN(I1 + NHPS,RCLR (IF))
            IF (0.EQ.RGETRE(IF,I,REC2)) THEN
                IF (PR.GT.0) WRITE (0,*)
     .          'ERROR::RRERED: Failed reading record'
                RETURN
            ENDIF
            K = IN (J)
            RX(K, IF) = REC2 (1)
            DO 105 L = 1, RVARS(IF)
               RFS (L, K, IF) = REC2(L+1)
 105        CONTINUE 
            IF (RDERS(IF).NE.0) THEN
               DO 106 L = 1, RVARS(IF)
                  RDS (L, K, IF) = REC2(L+RVARS(IF)+1)
 106           CONTINUE 
            ENDIF
            J = J + 1
 110     CONTINUE
         J = J - 1
         RLRF(IF) = IN(J)
         NN = MAX(I3 - NHPS,RFRR (IF))
         NL = MIN (NN - RFRR (IF), RLRR(IF)-RFRR (IF)+1)
         RFRR (IF) = NN
         RLRR(IF) = MIN(I1 + NHPS,RCLR (IF))
         IF (I3-NHPS.GT.RFRR(IF)) THEN
            RFRF(IF) = IN(N)
         ELSE
            RFRF(IF) = IN(NL + 1)
         ENDIF
         RFTR(IF) = RX (RFRF(IF), IF)
         RLTR(IF) = RX (RLRF(IF), IF)
CC
CC    TABLE IS COMPLETE NOW
CC
      ELSE
CC
CC    SOMETHING IS READ AND CONTAINS THE DESIRED TIME
CC    THIS IS THE IDEAL CASE (BUT THE MOST COMPLEX)
CC    THEREFORE WE TRY TO DEAL WITH IT AS FOR THE PREVIOUS 
CC    CASES (AVOIDING UNNECESSARY READS OF COURSE)
CC
         I1 = RFRR (IF)
         I3 = RLRR (IF)
         REC1(1) = RX(IN(1), IF)
         REC3(1) = RX(IN(1 + I3 - RFRR (IF)), IF)
 120     CONTINUE
            IF (I1.LT.RBUFFR(IF).AND.RBUFFR(IF).LT.I3) THEN
               IF (0.NE.RIDOU(IF,RBUFFR(IF),REC2)) THEN
                  IF (PR.GT.0) WRITE (0,*)
     .            'ERROR::RRERED: Failed reading record'
                  RETURN
               ENDIF
               IF ((TIME-REC1(1))*(TIME-REC2(1)).LE.0.D0) THEN
                  I3 = RBUFFR(IF)
                  REC3(1) = REC2(1)
               ELSE
                  I1 = RBUFFR(IF)
                  REC1(1) = REC2(1)
               ENDIF
            ENDIF
            IF (I1.LT.RBUFLR(IF).AND.RBUFLR(IF).LT.I3) THEN
               IF (0.NE.RIDOU(IF,RBUFLR(IF),REC2)) THEN
                  IF (PR.GT.0) WRITE (0,*)
     .            'ERROR::RRERED: Failed reading record'
                  RETURN
               ENDIF
               IF ((TIME-REC1(1))*(TIME-REC2(1)).LE.0.D0) THEN
                  I3 = RBUFLR(IF)
                  REC3(1) = REC2(1)
               ELSE
                  I1 = RBUFLR(IF)
                  REC1(1) = REC2(1)
               ENDIF
            ENDIF
            IF (I3-I1-1) 130,130,121
 121        I2 = (I1 + I3) / 2
            REC2(1) = RX(IN(1 + I2 - RFRR (IF)), IF)
            IF ((TIME-REC1(1))*(TIME-REC2(1)).LE.0.D0) THEN
               I3 = I2
               REC3(1) = REC2(1)
            ELSE
               I1 = I2
               REC1(1) = REC2(1)
            ENDIF
            GO TO 120
 130    CONTINUE
CC
CC    NOW READ
CC
         J = RLRR(IF) - RFRR(IF) + 1
         J = J + 1
         N = J
         DO 140 I = MAX(I3 - NHPS,RLRR (IF)+ 1),
     .              MIN(I1 + NHPS,RCLR (IF))
            IF (0.EQ.RGETRE(IF,I,REC2)) THEN
                IF (PR.GT.0) WRITE (0,*)
     .          'ERROR::RRERED: Failed reading record'
                RETURN
            ENDIF
            K = IN (J)
            RX(K, IF) = REC2 (1)
            DO 135 L = 1, RVARS(IF)
               RFS (L, K, IF) = REC2(L+1)
 135        CONTINUE 
            IF (RDERS(IF).NE.0) THEN
                DO 136 L = 1, RVARS(IF)
                  RDS (L, K, IF) = REC2(L+RVARS(IF)+1)
 136            CONTINUE 
            ENDIF
            J = J + 1
 140     CONTINUE
         J = J - 1
         RLRF(IF) = IN(J)
         NN = MAX(I3 - NHPS,RFRR (IF))
         NL = MIN (NN - RFRR (IF), RLRR(IF)-RFRR (IF)+1)
         RFRR (IF) = NN
         RLRR(IF) = MIN(I1 + NHPS,RCLR (IF))
         IF (I3-NHPS.GT.RFRR(IF)) THEN
            RFRF(IF) = IN(N)
         ELSE
            RFRF(IF) = IN(NL + 1)
         ENDIF
         RFTR(IF) = RX (RFRF(IF), IF)
         RLTR(IF) = RX (RLRF(IF), IF)
CC
CC
CC
CC
CC    NOW READ
CC
         J = 0
         DO 170 I = MIN(I1 + NHPS,RFRR (IF)-1),
     .             MAX(I3 - NHPS,RCFR (IF)), -1
            IF (0.EQ.RGETRE(IF,I,REC2)) THEN
                IF (PR.GT.0) WRITE (0,*)
     .          'ERROR::RRERED: Failed reading record'
                RETURN
            ENDIF
            K = IN (J)
            RX(K, IF) = REC2 (1)
            DO 165 L = 1, RVARS(IF)
                RFS (L, K, IF) = REC2(L+1)
 165        CONTINUE 
            IF (RDERS(IF).NE.0) THEN
             DO 166 L = 1, RVARS(IF)
                  RDS (L, K, IF) = REC2(L+RVARS(IF)+1)
 166           CONTINUE 
            ENDIF
            J = J - 1
 170     CONTINUE
         J = J + 1
         IF (I1+NHPS.LT.RFRR(IF)) THEN
            RLRF(IF) = IN(0)
         ELSE
            M =  I1 + NHPS - RFRR(IF) + 1
            RLRF(IF) = MIN (IN(M), RLRF(IF))
         ENDIF
         RFRF(IF) = IN (J)
         RFRR(IF) = MAX(I3 - NHPS,RCFR (IF))
         RLRR(IF) = MIN(I1 + NHPS,RLRR (IF))
         RFTR(IF) = RX (RFRF(IF), IF)
         RLTR(IF) = RX (RLRF(IF), IF)
      ENDIF

CC
CC    TABLE IS COMPLETE NOW
CC
CC
CC    CALL INTERPOLATION
CC
      IF (RDERS(IF).EQ.0) THEN
         CALL LAGRDE (RX(1,IF), RFS (1,1,IF), TIME, MRMAXT,
     .                   MNUMVA, RVARS(IF),RFRF (IF) - 1, 
     .                   RLRR(IF) -RFRR(IF) + 1,
     .                   RVARS(IF), NDERS, STATE,IER)
         IF (0.NE.IER) THEN
            IF (PR.GT.0) WRITE (0,*)
     .      'ERROR::RRERED: In Lagrange method'
            RETURN
         ENDIF
      ELSE
         CALL HERMDE (RX(1,IF), RFS (1,1,IF), 
     .                   RDS(1,1,IF), TIME, MRMAXT,
     .                   MNUMVA,RVARS(IF), RFRF (IF) - 1, 
     .                   RLRR(IF) -RFRR(IF) + 1,
     .                   RVARS(IF), NDERS, STATE, IER)
         IF (0.NE.IER) THEN
            IF (PR.GT.0) WRITE (0,*)
     .      'ERROR::RRERED: In Hermite method'
            RETURN
         ENDIF
      ENDIF
CC
      RRERED = 1
      RETURN
      END
      
 
 
 
 
      SUBROUTINE RTCRBT(IFN, IERROR)

CC============================= HEADER =================================
CCP----- PURPOSE -------------------------------------------------------
CCP  This routine creates the block table and an index list with the
CCP  timeordered list of the elements of the block list. The first ele-
CCP  ment in the index list is therefore a pointer to whick element in
CCP  the block list that is the timewise first block. With "timewise 1st
CCP  block" is meant that it has the lowest "lower time". If some blocks
CCP  have the same lower-time then they are sorted by their higher time
CCP  and finally, if these also are equal, the blocknumbers are used.
CCP  
CCC----- COMMENTS ------------------------------------------------------
CCC  Proj=gen, subj=cmd, util= int. file syst.
CCC  Auth= Jens Juul Yde, TOS-GFI,  2001
CCC  
CCI----- ONLY INPUT VARIABLES ------------------------------------------
CCI  IFN: I*4. Identifyer to the used i-file (called IF in other subrt.)
CCI  
CCIO---- BOTH INPUT AND OUTPUT VARIABLES -------------------------------
CCIO 
CCO----- ONLY OUTPUT VARIABLES -----------------------------------------
CCO  IERROR: I*4 Error code.
CCO              = 0 Equal to zero if successful.
CCO              = 1 Cannot find first block (using pointer reset and
CCO                  RNEXTB)
CCO              = 2 if RGOTOB gives an error trying to move one block
CCO              = 3 if too many blocks to create block table
CCO              = 4 if error encountered trying to sort list
CCO  
CCB----- COMMON BLOCKS -------------------------------------------------
CCB  'dimensions.inc'
CCB  'rshare.inc'
CCB  
CCS----- SUBROUTINES USED ----------------------------------------------
CCS  RNEXTB: Retrieves information about the next block
CCS  RGOTOB: Goes to the next block. RNEXTB and RGOTOB should always be
CCS          used together
CCS  
CC============================= HEADER END =============================


CC--------------- VARIABLE DEFINITIONS ---------------------------------

C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC      INCLUDE 'errhnd.inc'

CC---- Interface variables
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rtcrbt.F	',
C     &'1.4	01/11/21 	IMSS_FDD\n'/
CC
      INTEGER           IFN, IERROR

CC---- Local variables
      INTEGER           IERRCH, ICOUNT
      INTEGER           RECNUM
      INTEGER           INMBLS
      INTEGER           IRANK(IMXBLK)

CC - - NEEDED VARIABLES FOR SORTING

CC     Tmp list of start time, end time, and block numbers
      DOUBLE PRECISION  DTMPTB (3, IMXBLK)

CC     Work space needed for sorting routine
      DOUBLE PRECISION  DWKSPC(3)

CC     Counters and constants
      INTEGER           I, J
      INTEGER           IVCLEN, ISLVL, IS2LVL

CC     Values of Tbeg for "old" and "new" state (see below)
      DOUBLE PRECISION  DTBOLD, DTBNEW
CC     Tbeg pointers
      INTEGER           ITBP1, ITBP2
CC     Tbeg equal - meaning that tbegin times found that are equal
      LOGICAL           LTBEQL

CC     Values of Tend for "old" and "new" state (see below)
      DOUBLE PRECISION  DTEOLD, DTENEW
CC     Tend pointers
      INTEGER           ITEP1, ITEP2
CC     Values of Tbeg for "old" and "new" state (see below)
      LOGICAL           LTEEQL

CC     PARAMETER DECLARATIONS
CC      CHARACTER*(*) ROUTNM
CC      PARAMETER (ROUTNM = 'RTCRBT')

CC---- Functions that are used.
      INTEGER RGOTOB, RNEXTB

CC--------------- MAKE TRAILER LIST -------------------------------------

CC---- First are the pointers and the number of blocks reset to zero
CC     before the first block
      RCURB(IFN) = 0
      NCURB(IFN) = 0
      INMBLS = 0

CC---- Then information of the first block is retrieved
      RECNUM = RNEXTB(IFN)
      IF (RECNUM .LE. 0) GOTO 910

CC---- FORTRAN "While do" construction:
CC     This loops until the end of data is reached counting the number of
CC     blocks and saving the data about the start and end times and block-
CC     and record numbers.

100   CONTINUE
      IF (RECNUM.NE.0.AND.IMXBLK.GT.INMBLS) THEN
         INMBLS = INMBLS + 1
         IERRCH = RGOTOB(IFN, RECNUM)
         IF (0.EQ.IERRCH)    GOTO 919

CC---- Make sure that the first time is the lowest time:
         IF (RBTBEG(IFN).LE.RBTEND(IFN)) THEN
            DBTABT(INMBLS, 1, IFN) = RBTBEG(IFN)
            DBTABT(INMBLS, 2, IFN) = RBTEND(IFN)
         ELSE
            DBTABT(INMBLS, 2, IFN) = RBTBEG(IFN)
            DBTABT(INMBLS, 1, IFN) = RBTEND(IFN)
         ENDIF
         IBTREC(INMBLS, 1, IFN) = NCURB(IFN)
         IBTREC(INMBLS, 2, IFN) = RECNUM
         
         RECNUM = RNEXTB(IFN)
         GOTO 100
      ENDIF

CC---- Check if there are too many blocks to create the block table
      IF (RECNUM.NE.0.AND.IMXBLK.EQ.INMBLS) GOTO 929

CC--------------- MAKE SORTED LIST (INDEX LIST) -------------------------
      IBTLEN(IFN) = INMBLS

CC---- Call NAG libary procedure to get a rank list
CC
CC  ! This small part could replace the rest of this subroutine if the
CC    nag libary was available !
CC
CC      CALL m01def(DBTABT(1,1,IFN), IMXBLK,
CC     .                1, INMBLS, 1, 2, 'A', IRANK, IERRCH)
CC      IF (IERRCH.NE.0)    GOTO 939
CC
CC---- Convert the rank to an index list
CC
CC     The element no. N of the RANK list contains the number this 
CC     element is in the timeordered list. The indexlist element number N
CC     contains an index to which element that is the N'th element in the
CC     sorted list. (Ok. this could maybe be explained better...)
CC
CC      DO 200 ICOUNT = 1, INMBLS
CC        IBTINX(IRANK(ICOUNT), IFN) = ICOUNT 
CC200    CONTINUE
CC
CC -------------------- NAG lib usage ending -------

CC---- Calculate rank list

CC - - Create intermediate list with start and end time and block numbers.
CC     Notice that it is transposed compared to original lists

      DO 600, I = 1, IBTLEN(IFN)
         DTMPTB(1, I) = DBTABT(I, 1, IFN)
         DTMPTB(2, I) = DBTABT(I, 2, IFN)
         DTMPTB(3, I) = DBLE(IBTREC(I, 1, IFN))
 600  CONTINUE

CC - - Sort after start times (sorting at "level 1" = start times)
      CALL DRSORT(IBTLEN(IFN), 3, 1, DWKSPC, DTMPTB, IERRCH)
      IF (IERRCH.NE.0)    GOTO 939

CC - - If start times are equal, then sort after end times, and these are
CC     equal, then sort after block number

CC     Length of vectorelements to be sorted
      IVCLEN = 3

CC     Sorting level of outer loop below
      ISLVL = 2

CC     Sorting level of inner loop below
      IS2LVL = 3

CC     Starting the sorting. Outer loop searches for equal start times,
CC     and when found sorts after "end times" and goes to the inner loop
CC     which searches for common "end times" (within the common-start time
CC     region).

CC     Initialize outer loop
      DTBOLD = DTMPTB(1, 1)
CC     The logical is used to determin if a region of common times is being
CC     processed
      LTBEQL = .FALSE.

      DO 697, I = 2, IBTLEN(IFN)
         DTBNEW = DTMPTB(1, I)

         IF (LTBEQL) THEN

CC           If new value is equal to old, then update "end pointer"
            IF (DTBOLD .EQ. DTBNEW) THEN
               ITBP2 = I
            ENDIF

CC           If list finished or new element encountered, then sort
CC           found area and look through this area at the lowest level:
            IF (I .EQ. IBTLEN(IFN)
     .         .OR. DTBOLD .NE. DTBNEW ) THEN
               CALL DRSORT(ITBP2 - ITBP1+1, IVCLEN,
     .                     ISLVL, DWKSPC,
     .                     DTMPTB(1, ITBP1), IERRCH)
               IF (IERRCH.NE.0)    GOTO 939
               LTBEQL = .FALSE.

CC     - - - - - - - - - - - - - - - 
CC     This is the part checking whether there is some elements that should
CC     be ordered after block number. Notice that this program part is a
CC     "nested copy" of the rest of the loop.
CC     (INN is an abreviation for "inner" (-loop))

CC              Initializing inner loop
               DTEOLD = DTMPTB(2, ITBP1)
               LTEEQL = .FALSE.

CC              Go through region with common start times and check
CC              if there should be regions of common end time within this.
               DO 696, J = ITBP1+1, ITBP2
                  DTENEW = DTMPTB(2, J)

                  IF (LTEEQL) THEN
CC                    If new value is equal to old, then update "end pointer"
                     IF (DTEOLD .EQ. DTENEW) THEN
                        ITEP2 = J
                     ENDIF
CC                    If list finished or new element encountered, then sort
                     IF (J .EQ. ITBP2
     .                  .OR. DTEOLD .NE. DTENEW ) THEN
                        CALL DRSORT(ITEP2 - ITEP1+1, IVCLEN,
     .                              IS2LVL, DWKSPC,
     .                              DTMPTB(1, ITEP1), IERRCH)
                        IF (IERRCH.NE.0)    GOTO 939
                        LTEEQL = .FALSE.
                     ENDIF

                  ELSE
CC                    If new value is equal to old, then initialize pointers
CC                    and set flag indicating a region of common start and end 
CC                    times have been found.
                     IF (DTEOLD .EQ. DTENEW) THEN
                        LTEEQL = .TRUE.
                        ITEP1 = J - 1
                        ITEP2 = J
CC                    ...and sort if last element
                        IF (J .EQ. ITBP2) THEN
                        CALL DRSORT(ITEP2 - ITEP1+1, IVCLEN,
     .                              IS2LVL, DWKSPC,
     .                              DTMPTB(1, ITEP1), IERRCH)
                        IF (IERRCH.NE.0)    GOTO 939
                        ENDIF
                     ENDIF
                  ENDIF
                  
                  DTEOLD = DTENEW

 696           CONTINUE
CC     - - - - - - - - - - - - - - - 

            ENDIF
         ELSE
CC           If new value is equal to old, then initialize pointers and
CC           set flag indicating a region of common start times have been
CC           found.
            IF (DTBOLD .EQ. DTBNEW) THEN
               LTBEQL = .TRUE.
               ITBP1 = I - 1
               ITBP2 = I
               IF (I .EQ. IBTLEN(IFN)) THEN
CC                    ...and sort if last element
                  CALL DRSORT(ITBP2 - ITBP1+1, IVCLEN,
     .                        ISLVL, DWKSPC,
     .                        DTMPTB(1, ITBP1), IERRCH)
                  IF (IERRCH.NE.0)    GOTO 939
               ENDIF
            ENDIF
         ENDIF

         DTBOLD = DTBNEW
 697     CONTINUE
 720  CONTINUE

CC---- Save result to index list

CC     The indexlist element number N contains an index to which element
CC     that is the N'th element in the sorted list (in the timewise
CC     sense)

      DO 750, I = 1, IBTLEN(IFN)
         IBTINX(I, IFN) = IDINT(DTMPTB(3, I))
 750  CONTINUE

CC-----------------------------------------------------------------------
      
CC-----NORMAL EXIT
      
 909  CONTINUE

      IERROR = 0
      GOTO 999
      
CC-----ERROR HANDLING
      
 910  CONTINUE
      IERROR = 1
CC      WRITE(MSG,*) 'Cannot find first block (using pointer ',
CC     .             'reset and RNEXTB)'
CC      CALL ERRHNP(IERRLV, 1, MSG, ROUTNM)
      GOTO 999

 919  CONTINUE
      IERROR = 2
CC      WRITE(MSG,*) 'Failed moving to next block'
CC      CALL ERRHNP(IERRLV, 1, MSG, ROUTNM)
      GOTO 999

 929  CONTINUE
      IERROR = 3
CC      WRITE(MSG,*) 'Too many blocks to create block table'
CC      CALL ERRHNP(IERRLV, 1, MSG, ROUTNM)
      GOTO 999

 939  CONTINUE
      IERROR = 4
CC     WRITE(MSG,*) 'Error sorting the list'
CC     CALL ERRHNP(IERRLV, 1, MSG, ROUTNM)
      GOTO 999

 999  CONTINUE
CC-----------------------------------------------------------------------

      RETURN
      END

 
 
 
 
      SUBROUTINE RTFNDB(IFN, DTIME, NTOP, IRSBLN, IERROR)

CC============================= HEADER =================================
CCP----- PURPOSE -------------------------------------------------------
CCP  The purpose of this subroutine is to calculate the block number of
CCP  the/a block which has data to a certain time DTIME. If more than 1
CCP  block has data to this time, then the one with the highest starting
CCP  time (the lower time) will be chosen.
CCP  NOTE: This procedure requires that the block table has been created
CCP  NOTE: If block found, then it is also pointed at in the common blks
CCP
CCC----- COMMENTS ------------------------------------------------------
CCC  Proj=gen, subj=cmd, util= int. file syst.
CCC  Auth= Jens Juul Yde, TOS-GFI, 2001
CCC
CCI----- ONLY INPUT VARIABLES ------------------------------------------
CCI  IFN:   I*4. Identifyer to the used i-file (called IF in some subr.)
CCI  DTIME: R*8. Time of desired data.
CCI  NTOP:  I*4  Topology flag. Decides if the blocks are considered as
CCI                  0 = BOTH  SIDED      CLOSED: [A,B]   or
CCI                  1 = RIGHT SIDED HALF CLOSED: ]A,B]   or
CCI                  2 = LEFT  SIDED HALF CLOSED: [A,B[   or
CCI                  3 = BOTH  SIDED        OPEN: ]A,B[
CCI
CCIO---- BOTH INPUT AND OUTPUT VARIABLES -------------------------------
CCIO
CCO----- ONLY OUTPUT VARIABLES -----------------------------------------
CCO  IRSBLN: I*4. Number of found block with data to time DTIME
CCO  IERROR: I*4. Error code. Equal to zero if successful
CCO             = 1 Invalid identifier
CCO             = 2 error in NTOP input (should be 0, 1, 2, or 3)
CCO             = 3 error searching for initial guess
CCO             = 4 error moving to block
CCO             = 5 time not in data set
CCO
CCB----- COMMON BLOCKS -------------------------------------------------
CCB  'dimensions.inc'
CCB  'rshare.inc'
CCB
CCS----- SUBROUTINES USED ----------------------------------------------
CCS  RTFNDG: Finds good candidate-block by finding the block with
CCS             the highest lower-time which is lower than DTIME
CCS  RDGOTB:    Goes directly to a user-specified block
CCS
CC============================= HEADER END =============================


CC--------------- Variable definitions ---------------------------------

CC---- Interface variables
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rtfndb.F	',
C     &'1.3	01/11/21 	IMSS_FDD\n'/
CC
      INTEGER           IFN, NTOP, IRSBLN, IERROR
      DOUBLE PRECISION  DTIME
      
CC---- Local variables
      INTEGER           IRESIN, IER
      DOUBLE PRECISION  DLOW, DHIGH, DPRDCT

CC--------------- Includes ----------------------------------------------
      
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC      INCLUDE 'errhnd.inc'
      
CC--------------- Calculate and goto block which has data to the time ---

CC     Check if identifier is possible
      IF (IFN.LT.1 .OR. IFN.GT.MRFLS)  GOTO 912

CC     Check if the flag of the interpolation file is true (= in use)
      IF (RFLIST(IFN).EQ.0)  GOTO 912

CC     Checks if the topology flag is set correct
      IF ((NTOP .LT. 0) .OR. (NTOP .GT. 3))  GOTO 915

CC---- Find the block with the highest start time which is lower than
CC     DTIME. This is a good guess for a useful block. Note that the
CC     result from RTFNDG is an index and not the block number directly.
CC     It tells which block number in timewise sense that is the result.

      CALL RTFNDG(DBTABT(1, 1, IFN), IBTLEN(IFN),
     .               IBTINX(1, IFN), DTIME, IRESIN, IER)
      IF (IER .NE. 0) GOTO 919

CC---- Goto the block (not necessary as long as the RTFNDG also goes
CC     to the found block).

CC      CALL RDGOTB(IFN, IRESIN, IER)
      CALL RDGOTB(IFN, IBTINX(IRESIN, IFN), IER)
      IF (IER .NE. 0) GOTO 929

CC---- Check if the "guess-block" is containing the time DTIME, and if
CC     not
CC     then move backward in the timeordered list from the first guess.
CC     If it is not found in block "timeordered no. 1" then give error.

150   CONTINUE

CC     DLOW and DHIGH are the lowest- and highest time of the current block
CC     repectively. DPRDCT is negative if DTIME is within the time
CC     interval of the block and positive if outside. Zero indicates
CC     boundary situation. In this case NTOP decides the outcome.
      DLOW   = DBTABT(NCURB(IFN), 1, IFN)
      DHIGH  = DBTABT(NCURB(IFN), 2, IFN)
      DPRDCT = (DTIME - DLOW) * (DTIME - DHIGH)

CC     Check if the product is positive or if it is zero and the chosen
CC     "topology" (open/closed... interval) excludes the situation.
CC     If true then goto another block (with lower start time), if possible.
      IF(  ( DPRDCT .GT. 0.D0 )
     .  .OR. 
     .     ( ( DPRDCT .EQ. 0 ) .AND.
     .     (   ( NTOP .EQ. 1 .AND. DTIME .EQ. DLOW  )
     .     .OR.( NTOP .EQ. 2 .AND. DTIME .EQ. DHIGH )
     .     .OR.( NTOP .EQ. 3                        )  )
     .     )) THEN
      
         IF (IRESIN.GT.1) THEN
            IRESIN = IRESIN - 1
            CALL RDGOTB(IFN, IBTINX(IRESIN, IFN), IER)
            IF (IER .NE. 0) GOTO 929
            GOTO 150
         ELSE
            GOTO 939
         ENDIF
      ENDIF

CC     When a "useful" block is found, then set the output "IRSBLN" equal
CC     to its block number
      IRSBLN = NCURB(IFN)

CC-----------------------------------------------------------------------
      
CC-----NORMAL EXIT
      
 909  CONTINUE

      IERROR = 0
      GOTO 999
      
CC-----ERROR HANDLING
      
 912  CONTINUE
      IERROR = 1
CC     WRITE(MSG,*) 'Invalid identifier'
CC     CALL ERRHNP(IERRLV, 1, MSG, SUB)
      GOTO 999

 915  CONTINUE
      IERROR = 2
CC     WRITE(MSG,*) 'NTOP input is not correct!'
CC     CALL ERRHNP(IERRLV, 1, MSG, SUB)
      GOTO 999

 919  CONTINUE
      IERROR = 3
CC      WRITE(MSG,*) 'Error searching for initial guess using RTFNDG'
CC      CALL ERRHNP(IERRLV, 1, MSG, SUB)
      GOTO 999

 929  CONTINUE
      IERROR = 4
CC      WRITE(MSG,*) 'Failed moving to block using RDGOTB'
CC      CALL ERRHNP(IERRLV, 1, MSG, SUB)
      GOTO 999

 939  CONTINUE
      IERROR = 5
CC     WRITE(MSG,*) 'Time not in data set!'
CC     CALL ERRHNP(IERRLV, 1, MSG, SUB)
      GOTO 999


 999  CONTINUE
CC-----------------------------------------------------------------------
      RETURN
      END



 
 
 
 
      SUBROUTINE RTFNDG(DLSTTM, ILSTLN, ILSTIX,
     .                     DTIME, IRESIN, IERROR)

CC============================= HEADER =================================
CCP----- PURPOSE -------------------------------------------------------
CCP  The purpose of this routine is to find the highest element of the
CCP  list DLSTTM which is below the value of DTIME. This is done using
CCP  the indexlist ILSTIX which is the sorted indexes of the input
CCP  list (ascending ordered).
CCP  The method used is based on the principle to look at the values at
CCP  the two ends of the interval and then continoue to calculate the
CCP  values in the middle of the interval and choose the new interval
CCP  such that the endpoint values are on each side of the time DTIME.
CCP  This continues until only two points are left. The lowest is then
CCP  the result.
CCP  This is developed as a tool procedure to "RTFNDB".
CCC----- COMMENTS ------------------------------------------------------
CCC  Proj=gen, subj=cmd, util= int. file syst.
CCC  Auth= Jens Juul Yde, TOS-GFI,  2001
CCC  
CCI----- ONLY INPUT VARIABLES ------------------------------------------
CCI  DLSTTM:  R*8(*) Input list (list of starttimes of the blocks)
CCI  ILSTLN:  I*4    Length of data in input list (number of blocks)
CCI  ILSTIX:  I*4(*) Index list to sort input list (ascending)
CCI  DTIME:   R*8    Time (the goal is the highest value lower than this
CCI
CCIO---- BOTH INPUT AND OUTPUT VARIABLES -------------------------------
CCIO  
CCO----- ONLY OUTPUT VARIABLES -----------------------------------------
CCO  IRESIN: I*4 This is the resulting index(!!!) of the highest value
CCO                   in DLSTTM that is lower than DTIME
CCO  IERROR: I*4  = 0 if successful
CCO               = 1 if DTIME is lower than all elements of DLSTTM
CCO  
CCB----- COMMON BLOCKS ------------------------------------------------- 
CCB  'dimensions.inc'
CCB  'rshare.inc'
CCB  
CCS----- SUBROUTINES USED ----------------------------------------------
CCS  
CC============================= HEADER END =============================

CC--------------- Variable definitions ---------------------------------

C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS,                     |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR READ INTERPOLATION FILES                        |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  RFPARS:                                                           |
C |    RFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR READING                                     |
C |    RUNITS   ARRAY WITH FILE UNITS                                  |
C |    RTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    RVARS    ARRAY WITH NUMBER OF VARS                              |
C |    RDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    RRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    RHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    RLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    RLREC    LAST RECORD WRITTEN                                    |
C |    RBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    RBTEND   FOR CURRENT BLOCK END TIME                             |
C |    RTBEG    FOR IFILE BLOCK START TIME                             |
C |    RTEND    FOR IFILE BLOCK END TIME                               |
C |    RCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    RCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    RCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    RCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C2|    RCURB                                                           |
C2|  NPARS                                                             |
C2|    NCURB    NUMBER OF CURRENT BLOCK                                |
C |  RINTAB:    PARAMETERS FOR INTERPOLATION TABLE                     |
C |    RFRR     FIRST RECORD ALREADY READ FROM FILE                    |
C |    RLRR     LAST  RECORD ALREADY READ FROM FILE                    |
C |    RFRF     FIRST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)         |
C |    RLRF     LAST ROW FILLED IF DIFFERENCES TABLE (CYCLIC)          |
C |    RIVAL    INDEX AS FROM WHICH THE INTERPOLATION IS VALID         |
C |    RFTR     FIRST TIME READ                                        |
C |    RLTR     LAST TIME READ                                         |
C |    RFS      FUNCTIONS TABLE                                        |
C |    RDS      DERIVATIVES TABLE                                      |
C |    RX       TIME ARRAY                                             |
C |       -------------------------------------------------------      |
C |    The next variables and parameters are used in the block-data    |
C |    extension which (if the max no. of blocks allow it) calcates    |
C |    a table with all block no., first rec. no. and tbeg and tend.   |
C |    (BT is an abbreviation for 'Block Table')                       |
C |                                                                    |
C |    I_MAXNOBLOCKS    Maximum number of blocks (mem allocation)      |
C |    D_BT_TIMETABLE   tbeg and tend part of table                    |
C |    I_BT_BLRECTABLE  block no. and rec. no part of table            |
C |    I_BT_TIMEINDEX   time ordered indexlist of the table            |
C |    L_BT_FLAGS       flags indicating if table is available         |
C |    I_BT_NUMBL       the number of blocks of the file (only         |
C |                        available if table made (if flat set)       |
C |                                                                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION
C2|   2000/03/ Updating for introduction of RRREC2.F and RBLREC.F      |
C2|    (Cf. comments "C2")                                             |
C +--------------------------------------------------------------------+
C
C
C      CHARACTER*68 SCCS_INFO_rshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.rshare.inc	',
C     &'1.5	01/11/09 	IMSS_FDD\n'/
C
      INTEGER MRFLS
      PARAMETER (MRFLS = 8)
      INTEGER RFLIST(MRFLS), RUNITS(MRFLS), RTYPES(MRFLS),
     .            RVARS(MRFLS), RDERS(MRFLS),
     .            RRECLS(MRFLS), RHSIZ(MRFLS), RBLHSI(MRFLS),
     .            RLASTS(MRFLS),
     .            RCFR(MRFLS), RCLR(MRFLS), RCPB(MRFLS), 
     .            RCNB(MRFLS), RCURB(MRFLS)
C2
      INTEGER NCURB(MRFLS)
      COMMON /NPARS/ NCURB
C2
      DOUBLE PRECISION RBTBEG(MRFLS), RBTEND(MRFLS),RTBEG(MRFLS)
     .                 , RTEND(MRFLS)

      COMMON /RFPARS/ RFLIST, RUNITS, RTYPES, RVARS, RDERS, 
     .                RRECLS, RHSIZ, RBLHSI, RLASTS,
     .                RBTBEG, RBTEND, RTBEG, RTEND,
     .                RCFR, RCLR, RCPB, RCNB, RCURB
      INTEGER MRORD, MRMAXT
      PARAMETER (MRORD=9)
      PARAMETER (MRMAXT=30)
      INTEGER RFRR(MRFLS), RLRR(MRFLS),
     .        RFRF(MRFLS), RLRF(MRFLS), RIVAL(MRFLS)
      DOUBLE PRECISION RFTR(MRFLS),RLTR(MRFLS), 
     .                 RFS (MNUMVA, MRMAXT, MRFLS),
     .                 RDS (MNUMVA, MRMAXT, MRFLS),
     .                 RX(MRMAXT, MRFLS)
      COMMON /RINTAB/RFRR,RLRR,
     .        RFRF, RLRF,RIVAL,RFTR,RLTR,RFS, RDS,RX

C
C    SIZE OF FILE RECORD 
C
      INTEGER MAXFRE
      PARAMETER (MAXFRE = 40000)
      DOUBLE PRECISION RFBUF(MAXFRE / 8, MRFLS)
      INTEGER RBUFFR(MRFLS), RBUFLR(MRFLS),
     .     RNLREC(MRFLS)
      COMMON /RBUF/ RFBUF, RBUFFR, RBUFLR,RNLREC
C
C----Variables used in the block-table extension------------------------
C
      INTEGER           IMXBLK
      PARAMETER (IMXBLK = 3000)

C In all the following block-table commons refer the last coordinate to
C which of the open files that is refered to.

C DoubleprecisionBlockTABleTimes: The content is the lowest time and
C highest times of each found block
      DOUBLE PRECISION  DBTABT (IMXBLK, 2, MRFLS)

C IntegerBlockTableRECords: List with the block and record numbers of
C the blocks. DBTABT(n, ...) and IBTREC(n, ...) refers to the same block
C IBTREC(X, 1, Y) is the block number while
C IBTREC(X, 2, Y) is the record number
      INTEGER           IBTREC(IMXBLK, 2, MRFLS)

C IntegerBlockTableINdeXes: The element number n points to which element in
C the block table that is the n'th element in the timewise sense
      INTEGER           IBTINX (IMXBLK, MRFLS)

C LogicalBlockTableFLaGs: If true is a block table generated
      LOGICAL           LBTFLG(MRFLS)

C IntegerBlockTableLENgths: The content is the number of blocks in the
C open files
      INTEGER           IBTLEN(MRFLS)

      COMMON /BTCOM/ DBTABT, IBTREC,
     .        IBTINX, LBTFLG, IBTLEN
C-----------------------------------------------------------------------

CC      INCLUDE 'errhnd.inc'

CC--Interface variables
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.rtfndg.F	',
C     &'1.3	01/11/21 	IMSS_FDD\n'/
CC
      DOUBLE PRECISION DLSTTM(IMXBLK)
      INTEGER          ILSTIX(IMXBLK)
      DOUBLE PRECISION DTIME
      INTEGER          ILSTLN, IRESIN, IERROR

CC--Local variables
      INTEGER          IPOIN1, IPOIN2, IPOINN
      INTEGER          INMPOI
      DOUBLE PRECISION DLOW, DHIGH, DNEW

CC--------------- Program part -----------------------------------------

      IF (DLSTTM(ILSTIX(1)).GT.DTIME)   GOTO 919

CC--Initialisation before "while" loop.

      IPOIN1 = 1
      IPOIN2 = ILSTLN
      INMPOI = ILSTLN

      DLOW  = DLSTTM(ILSTIX(IPOIN1))
      DHIGH = DLSTTM(ILSTIX(IPOIN2))

CC--FORTRAN "while" loop.
CC  Subdivide into smaller and smaller intervals undtil "End-case" where
CC  there are only two points left.

      IF (DTIME.GE.DHIGH) THEN
         IRESIN = IPOIN2
      ELSE
 10      CONTINUE
         IF (INMPOI.GT.2) THEN
            IPOINN = IPOIN1 + (INMPOI - 1) / 2
            DNEW = DLSTTM(ILSTIX(IPOINN))

            IF (DNEW.GT.DTIME) THEN
               DHIGH = DNEW
               IPOIN2 = IPOINN
            ELSE
               DLOW = DNEW
               IPOIN1 = IPOINN
            ENDIF
            INMPOI = IPOIN2 - IPOIN1 + 1
            GOTO 10
         ENDIF
CC---- The result is the lowest pointer at the end
         IRESIN = IPOIN1
      ENDIF

CC----------------------------------------------------------------------

CC-----NORMAL EXIT
      
 909  CONTINUE

      IERROR = 0
      GOTO 999
      
CC-----ERROR HANDLING
      
 919  CONTINUE
      IERROR = 1
CC      WRITE(MSG,*) 'Given time is lower than all times in the list'
CC      CALL ERRHNP(IERRLV, 1, MSG, SUB)
      GOTO 999

 999  CONTINUE
CC-----------------------------------------------------------------------
      RETURN
      END































 
 
 
 
      DOUBLE PRECISION FUNCTION TAIUTC(DAY,KEY)
CCP   CONVERTS ATOMIC TIME (TAI) TO UTC OR VICE VERSA.
CC
CCI  DAY = TAI (KEY=1) OR UTC (KEY=2) EXPRESSED AS MJD2000.
CCI  KEY = 1 TO CONVERT TAI INTO UTC
CCI      = 2 TO CONVERT UTC INTO TAI
CC
CCO  TAIUTC = UTC (KEY=1) OR TAI (KEY=2) EXPRESSED AS MJD2000.
CC
CC  LEAPSECONDS ARE REGISTERED FROM 1972 JAN 1 TO 1999 JAN 1.
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/oalib/orblib/src/SCCS/s.taiutc.f	',
C     &'1.9	98/07/28 	ORBLIB\n'/
CC
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION DLEAP(23)
CC
CC  NLEAP = NUMBER OF LEAPSECONDS REGISTERED
      DATA NLEAP /23/
CC
CC  MJD2000 FOR LEAPSECONDS IN REVERSED ORDER.
       DATA DLEAP /-365.D0, -914.D0, -1461.D0, -2010.D0, -2375.D0,
     & -2740.D0, -3287.D0, -3652.D0, -4383.D0, -5297.D0, -6028.D0,
     & -6393.D0, -6758.D0, -7305.D0, -7670.D0, -8035.D0, -8400.D0,
     & -8766.D0, -9131.D0, -9496.D0, -9861.D0, -10045.D0, -10227.D0/
CC
CC  ONESEC = 1 SEC IN DAYS = 1/86400
      DATA ONESEC /0.11574074074074074 D-4/
CC
CC  DSEC = (TAI - UTC) AFTER THE LAST LEAPSECOND REGISTERED
      DSEC = ONESEC*32.D0
CC
      IF(KEY .GE. 2) GOTO 2
CC
CC  KEY = 1 TO CONVERT TAI INTO UTC
      X = DAY - DSEC
CC
CC  SEARCH FOR LEAPSECOND, STARTING AT THE LATEST DATE
      DO 1 N = 1,NLEAP
      DLEAPN = DLEAP(N)
      IF(X .GE. DLEAPN) GOTO 5
      X = DMIN1(DLEAPN,X + ONESEC)
  1   CONTINUE
      GOTO 5
CC
CC  KEY = 2 TO CONVERT UTC INTO TAI
  2   X = DAY + DSEC
CC
CC  SEARCH FOR LEAPSECOND, STARTING AT THE LATEST DATE
      DO 3 N = 1,NLEAP
      IF(DAY .GE. DLEAP(N)) GOTO 5
      X = X - ONESEC
  3   CONTINUE
CC
  5   TAIUTC = X
      RETURN
      END
 
 
 
 
      DOUBLE PRECISION FUNCTION TDBTDT (DAY,KEY)
CC
CCP  CONVERTS BARYCENTRIC DYNAMICAL TIME (TDB) TO TERRESTRIAL
CCP             DYNAMICAL TIME (TDT) OR VICE VERSA
CC
CCC  PROJ=GEN,SUBJ=TIM,UTIL=GEN,AUTH=T.A.MORLEY TOS-G/FDD/IMSS
CCC  00/06/29
CC
CCR  REF(1) "EXPLANATORY SUPPLEMENT TO THE ASTRONOMICAL ALMANAC",
CCR         P. SEIDELMANN (ED.), UNIVERSITY SCIENCE BOOKS, 1992.
CCR  REF(2) "AMFIN - MATHEMATICAL DESCRIPTION OF THE AMFIN SUBROUTINES",
CCR         PRE-DRAFT, 2000/03/23.
CC
CCN  ONLY THE MAIN ANNUAL TERM, WITH AMPLITUDE 1.66 MILLISECONDS,
CCN  IS RETAINED. ALL NEGLECTED TERMS HAVE AMPLITUDES LESS THAN
CCN  21 MICROSECONDS.
CC
CC   CALLING SEQUENCE:
CC   INPUT:
CCI  DAY = MJD2000 IN TDB (KEY=1) OR TDT (KEY=2)                     R*8
CCI  KEY .LE. 1 TO CONVERT TDB INTO TDT                              I*4
CCI      .GE. 2 TO CONVERT TDT INTO TDB
CC
CCO  OUTPUT:
CCO  TDBTDT = MJD2000 IN TDT (KEY=1) OR TDB (KEY=2)                  R*8
CC
CC   DATA STATEMENT: VARIABLES FOR COMPUTING TIME DIFFERENCE
CCV  COF = COEFFICIENT OF MAIN TERM (SECONDS)                        R*8
CCV  ECC = MEAN ECCENTRICITY OF ORBIT OF EARTH-MOON BARYCENTRE       R*8
CCV  RME = MEAN MEAN ANOMALY OF ORBIT OF EARTH-MOON BARYCENTRE       R*8
CCV        AT 2000/01/01 00:00:00 TDB.
CCV  RMD = MEAN MOTION OF THE ORBIT OF THE EARTH-MOON BARYCENTRE     R*8
CCV        WITH RESPECT TO DYNAMICAL TIME.
CC
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imsorb/amfin/gen/SCCS/s.tdbtdt.F	',
C     &'1.1	01/08/10 	IMSS_FDD\n'/
CC
      IMPLICIT REAL*8 (A-H,O-Z)
      DATA COF,ECC,RME,RMD / 0.16567D-2,0.1671D-1,0.6231435D1,
     &                       0.1720197D-1 /
CC
CC  TIME DIFFERENCE, DT (STRICTLY A FUNCTION OF TDB BUT A NEGLIGIBLE
CC  ERROR ARISES IF TDT IS USED, I.E. FOR CASE KEY = 2)
CC
      RM = RME + RMD*DAY
      EA = RM + ECC*(DSIN(RM) + 0.5D0*ECC*DSIN(2.D0*RM))
      DT = COF*DSIN(EA)/86400.D0
CC
      TDBTDT = DAY - DT
      IF (KEY .GE. 2) TDBTDT = DAY + DT
CC
      RETURN
      END
 
 
 
 
      DOUBLE PRECISION FUNCTION TDBUTC (DAY,KEY)
CC
CCP  CONVERTS BARYCENTRIC DYNAMICAL TIME (TDB) TO UTC OR VICE VERSA
CC
CCC  PROJ=GEN,SUBJ=TIM,UTIL=GEN,AUTH=T.A.MORLEY TOS-G/FDD/IMSS
CCC  00/06/29
CC
CCN  VALID FOR THE SPAN OF VALIDITY OF ORBIT LIBRARY FUNCTION TAIUTC,
CCN  I.E. FROM 1972 JAN 1 UNTIL CURRENT TIME. (TAIUTC MUST BE
CCN  UPDATED WHEN A LEAP SECOND IS INSERTED).
CC
CC   CALLING SEQUENCE:
CC   INPUT:
CCI  DAY = MJD2000 IN TDB (KEY=1) OR UTC (KEY=2)                     R*8
CCI  KEY .LE. 1 TO CONVERT TDB INTO UTC                              I*4
CCI      .GE. 2 TO CONVERT UTC INTO TDB
CC
CCO  OUTPUT:
CCO  TDBUTC = MJD2000 IN UTC (KEY=1) OR TDB (KEY=2)                  R*8
CC
CC   SUBPROGRAMS CALLED:
CCS  TDBTDT: CONVERTS BARYCENTRIC DYNAMICAL TIME (TDB) TO TERRESTRIAL
CCS          DYNAMICAL TIME (TDT) OR VICE VERSA (DOUBLE PRECISION
CCS          FUNCTION).
CCS  TDTUTC: CONVERTS TERRESTRIAL DYNAMICAL TIME (TDT) TO UTC OR
CCS          VICE VERSA (DOUBLE PRECISION FUNCTION) (USES TAIUTC
CCS          FROM THE ORBIT LIBRARY).
CC
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imsorb/amfin/gen/SCCS/s.tdbutc.F	',
C     &'1.1	01/08/10 	IMSS_FDD\n'/
CC
      IMPLICIT REAL*8 (A-H,O-Z)
CC
      IF (KEY .LE. 1) THEN
         TDT = TDBTDT(DAY,KEY)
         TDBUTC = TDTUTC(TDT,KEY)
      ELSE
         TDT = TDTUTC(DAY,KEY)
         TDBUTC = TDBTDT(TDT,KEY)
      ENDIF
CC
      RETURN
      END
 
 
 
 
      DOUBLE PRECISION FUNCTION TDTUTC (DAY,KEY)
CC
CCP  CONVERTS TERRESTRIAL DYNAMICAL TIME (TDT) TO UTC OR VICE VERSA
CC
CCC  PROJ=GEN,SUBJ=TIM,UTIL=GEN,AUTH=T.A.MORLEY TOS-G/FDD/IMSS
CCC  00/06/29
CC
CCN  FUNCTION IS DERIVED FROM ETUTC OF THE ORBIT LIBRARY.
CCN  VALID FOR THE SPAN OF VALIDITY OF ORBIT LIBRARY FUNCTION TAIUTC,
CCN  I.E. FROM 1972 JAN 1 UNTIL CURRENT TIME. (TAIUTC MUST BE
CCN  UPDATED WHEN A LEAP SECOND IS INSERTED).
CC
CC   CALLING SEQUENCE:
CC   INPUT:
CCI  DAY = MJD2000 IN TDT (KEY=1) OR UTC (KEY=2)                     R*8
CCI  KEY .LE. 1 TO CONVERT TDT INTO UTC                              I*4
CCI      .GE. 2 TO CONVERT UTC INTO TDT
CC
CCO  OUTPUT:
CCO  TDTUTC = MJD2000 IN UTC (KEY=1) OR TDT (KEY=2)                  R*8
CC
CC   SUBPROGRAMS CALLED:
CCS  TAIUTC: CONVERTS ATOMIC TIME (TAI) TO UTC OR VICE VERSA
CCS          (DOUBLE PRECISION FUNCTION).
CC
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imsorb/amfin/gen/SCCS/s.tdtutc.F	',
C     &'1.1	01/08/10 	IMSS_FDD\n'/
CC
      IMPLICIT REAL*8 (A-H,O-Z)
CC
CC TDTTAI IS THE DIFFERENCE BETWEEN TDT AND TAI (DAYS)
CC
      TDTTAI = 32.184D0/86400.D0
CC
      IF (KEY .LE. 1) THEN
         TAI = DAY - TDTTAI
         TDTUTC = TAIUTC(TAI,KEY)
      ELSE
         TAI = TAIUTC(DAY,KEY)
         TDTUTC = TAI + TDTTAI
      ENDIF
CC
      RETURN
      END
 
 
 
 
      SUBROUTINE WAFCL (IF, IER)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE WAFCL            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  THIS SUBROUTINE CLOSES AN ATTITUDE FILE PREVIOUSLY GENERATED WITH    |
CC |  THE SUBROUTINES WAF**. IT IS NECESSARY TO CLOSE SPECIFICALLY THE  |
CC |  FILE WITH THIS SUBROUTINE, BECAUSE WAF** USE SW BUFFERING.        |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER FOR ORBIT FILE, AS RETURNED   |
CC |                           BY WAFOP                                 |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  IER            I*4       ERROR CODE, NON-ZERO IF ERROR            |
CC |                           1 = NOT ABLE TO CLOSE FILE               |
CC |                           2 = INVALID IDENTIFIER                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  debugf.inc   ERROR PRINTING OPTIONS                               |
CC |  wofsh.inc                                                         |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WIFCL                                                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC
CC    HEADER VARIABLES
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imsatt/atthist/attfil/src/SCCS/s.wafcl.F	',
C     &'1.2	01/08/03 	IMSS_FDD\n'/
CC
      INTEGER IF, IER
CC
CC    CALLING
CC
      INTEGER WIFCL
CC
CC    LOCAL VARIABLES
CC
CC
      INTEGER IUNER
      LOGICAL PR
CC
CC
CC
CC    INCLUDE FILES
CC
C ======================================================================
C INCLUDE FILE DEBUGF
C ======================================================================
C      CHARACTER*68 SCCS_INFO_debugf(2)
C     &/'@(#)/home/imlib/gen/errors/inc/SCCS/s.debugf.inc	',
C     &'1.1	98/04/21 	OAD_IMSS\n'/
C
      INTEGER      IDEBUG
      COMMON/ DEBUG/ IDEBUG(10)
C
CB    / DEBUG/ DEBUG FLAGS
CV    IF IDEBUG(1).NE.0 : TRACE MESSAGES ARE GENERATED AND WRITTEN
CV                        (FOR DEBUGGING, INTERMEDIATE OUTPUT...)
CV    IDEBUG(9)         : IT CONTROLS THE SEVERITY FOR THE MESSAGES 
CV                        OUTPUT
CV                        0 MEANS THAT REPEAT, ERROR AND
CV                          WARNING MESSAGES ARE WRITTEN
CV                        1 MEANS THAT ONLY REPEAT AND 
CV                          ERROR MESSAGES ARE WRITTEN
CV                        2 ONLY ERROR MESSAGES ARE WRITTEN
CV                        3 ERROR MESSAGES ARE NOT WRITTEN  
CV    IDEBUG(10)        : UNIT WHERE MESSAGES ARE GOING TO BE DISPLAYED
CV                        NEGATIVE UNIT MEANS UNIT 0 (UNIX STDERR)
CV                        TO LOGICAL UNIT NUMBER = IDEBUG(10).
CV                        0 MEANS NO MESSAGE WRITTEN
CV    IDEBUG(3)...IDEBUG(9) ARE CURRENTLY UNUSED.
C +----------------------+--------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA      |
C +----------------------|--------------------------+
C |   FDD                |  V. Companys             |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  DATA TO BE SHARED BETWEEN WAF?? FUNCTIONS. THIS INCLUDE FILE      |
C |  SHOULD BE CONSIDERED HIDDEN TO THE USER. USER SHOULD NEVER        |
C |  INCLUDE IT (THERE IS NO NEED).                                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  WAFP:                                                             |
C |     
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wafsh(2)
C      DATA SCCS_INFO_wafsh
C     &/'@(#)/home/imsatt/atthist/attfil/inc/SCCS/s.wafsh.inc	',
C     &'1.2	01/08/03 	IMSS_FDD\n'/
C
      INTEGER MAXUN
      PARAMETER (MAXUN = 8)
      IER = 0
CC
CC   FIX ONCE FOR EVER THE ERROR UNIT
CC
      IF (IDEBUG(10).LT.0) THEN
         IUNER = 0
      ELSE IF (IDEBUG(10).EQ.0) THEN
         IUNER = -1
      ELSE
         IUNER = IDEBUG(10)
      ENDIF
      PR = (IUNER.GE.0) 
      IF (IF .LT.1 .OR. IF .GT. MAXUN)
     .   THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E WAFCL. INVALID IDENTIFIER'
         ENDIF
         IER = 2
         RETURN
      ENDIF
CC
      IF (0.EQ. WIFCL (IF)) THEN
         IF (PR.AND.IDEBUG(9).LT.3) THEN
         WRITE (0, *) 'E WAFCL. UNABLE TO CLOSE FILE'
         ENDIF
         IER = 1
         RETURN
      ENDIF
      RETURN
      END
      
      
 
 
 
 
      SUBROUTINE WAFNB (IF, IFRAME, IER)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE WAFNB            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  ADDS A NEW BLOCK TO A ROSETTA ATTITUDE FILE. SUBROUTINE WAFOP MUST   |
CC |  BE CALLED BEFORE WAFNB, TO OPEN AND SET HEADER OF THE ATTITUDE FILE  |
CC |  DIFFERENT BLOCKS MAY BE USED TO STORE DIFFERENT PIECES OF THE     |
CC |  ORBIT.                                                            |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER FOR ORBIT FILE, AS RETURNED   |
CC |                           BY WAFOP                                 |
CC |  IFRAME         I*4       REFERENCE FRAME ID FOR THE BLOCK TO BE   |
CC |                           CREATED                                  |
CC |                           0: EQ2000                                |
CC |                           1: EC2000                                |
CC |                           2: EQ1950                                |
CC |                           3: EC1950                                |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  IER            I*4       ERROR CODE, NON-ZERO IF ERROR            |
CC |                           1 = ERROR CREATING NEW BLOCK,            |
CC |                               FILE IS CLOSED                       |
CC |                           2 = ERROR SETTING BLOCK HEADER           |
CC |                               PARAMETERS, FILE IS CLOSED           |
CC |                           3 = THIS IS THE ERROR CODE PRODUCED WHEN |
CC |                               FAILING TO CLOSE THE ORBIT FILE ONCE |
CC |                               ANOTHER ERROR CONDITION OCURRED.     |
CC |                               FOR THIS TO HAPPEN, SEVERE PROBLEMS  |
CC |                               MUST HAVE OCCURRED, AND THE CONTENTS |
CC |                               OF THE ORBIT FILE ARE NOT GUARANTEED |
CC |                               AT ALL                               |
CC |                           3 = INVALID IDENTIFIER                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  debugf.inc   ERROR PRINTING OPTIONS                               |
CC |  wafsh.inc                                                         |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WNWBLK, WAFCL, WMODBL                                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+

CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imsatt/atthist/attfil/src/SCCS/s.wafnb.F	',
C     &'1.2	01/08/03 	IMSS_FDD\n'/
CC
      INTEGER IF, IFRAME, IER
CC
CC    LOCAL VARIABLES
      INTEGER BUF, IUNER
CC
      LOGICAL PR
CC
CC    CALLING...
CC
      INTEGER WNWBLK, WMODBL
CC
CC
CC
CC    INCLUDE FILES
CC
C ======================================================================
C INCLUDE FILE DEBUGF
C ======================================================================
C      CHARACTER*68 SCCS_INFO_debugf(2)
C     &/'@(#)/home/imlib/gen/errors/inc/SCCS/s.debugf.inc	',
C     &'1.1	98/04/21 	OAD_IMSS\n'/
C
      INTEGER      IDEBUG
      COMMON/ DEBUG/ IDEBUG(10)
C
CB    / DEBUG/ DEBUG FLAGS
CV    IF IDEBUG(1).NE.0 : TRACE MESSAGES ARE GENERATED AND WRITTEN
CV                        (FOR DEBUGGING, INTERMEDIATE OUTPUT...)
CV    IDEBUG(9)         : IT CONTROLS THE SEVERITY FOR THE MESSAGES 
CV                        OUTPUT
CV                        0 MEANS THAT REPEAT, ERROR AND
CV                          WARNING MESSAGES ARE WRITTEN
CV                        1 MEANS THAT ONLY REPEAT AND 
CV                          ERROR MESSAGES ARE WRITTEN
CV                        2 ONLY ERROR MESSAGES ARE WRITTEN
CV                        3 ERROR MESSAGES ARE NOT WRITTEN  
CV    IDEBUG(10)        : UNIT WHERE MESSAGES ARE GOING TO BE DISPLAYED
CV                        NEGATIVE UNIT MEANS UNIT 0 (UNIX STDERR)
CV                        TO LOGICAL UNIT NUMBER = IDEBUG(10).
CV                        0 MEANS NO MESSAGE WRITTEN
CV    IDEBUG(3)...IDEBUG(9) ARE CURRENTLY UNUSED.
C +----------------------+--------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA      |
C +----------------------|--------------------------+
C |   FDD                |  V. Companys             |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  DATA TO BE SHARED BETWEEN WAF?? FUNCTIONS. THIS INCLUDE FILE      |
C |  SHOULD BE CONSIDERED HIDDEN TO THE USER. USER SHOULD NEVER        |
C |  INCLUDE IT (THERE IS NO NEED).                                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  WAFP:                                                             |
C |     
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wafsh(2)
C      DATA SCCS_INFO_wafsh
C     &/'@(#)/home/imsatt/atthist/attfil/inc/SCCS/s.wafsh.inc	',
C     &'1.2	01/08/03 	IMSS_FDD\n'/
C
      INTEGER MAXUN
      PARAMETER (MAXUN = 8)
CC
CC   FIX ONCE FOR EVER THE ERROR UNIT
CC
      IF (IDEBUG(10).LT.0) THEN
         IUNER = 0
      ELSE IF (IDEBUG(10).EQ.0) THEN
         IUNER = -1
      ELSE
         IUNER = IDEBUG(10)
      ENDIF
      PR = (IDEBUG(9).LT.3).AND.(IUNER.GE.0) 
      IF (IF .LT.1 .OR. IF .GT. MAXUN)
     .   THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E WAFNB. INVALID IDENTIFIER'
         ENDIF
         IER = 3
         RETURN
      ENDIF
CC
CC   CHECK IF UNIT ALREADY IN USE
CC
      IF (0.EQ.WNWBLK (IF)) THEN
         IER = 1
         IF (PR) THEN
         WRITE (IUNER,*) 'E WAFNB. UNABLE TO CREATE BLOCK'
         WRITE (IUNER,*) '         FILE WILL BE CLOSED'
         ENDIF
         CALL WAFCL(IF, IER)
         IF (0.NE.IER) THEN
            IER = 3
            IF (PR) THEN
            WRITE (IUNER,*) 'R WAFNB. UNABLE TO CLOSE FILE.'
            ENDIF
         ENDIF
         RETURN
      ENDIF
      BUF = IFRAME
      IF (0.EQ.WMODBL (IF, BUF, 9, 1)) THEN
         IER = 2
         IF (PR) THEN
         WRITE (IUNER,*) 'E WAFNB. UNABLE TO WRITE BLOCK HEADER'
         WRITE (IUNER,*) '         FILE WILL BE CLOSED'
         ENDIF
         CALL WAFCL(IF, IER)
         IF (0.NE.IER) THEN
            IER = 3
            IF (PR) THEN
            WRITE (IUNER,*) 'R WAFNB. UNABLE TO CLOSE FILE.'
            ENDIF
         ENDIF
         RETURN
      ENDIF
      IER = 0
      RETURN
      END
      
      




 
 
 
 
      SUBROUTINE WAFNR (IF, TIME, STATE, DERIVS, IER)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE WAFNR            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  ADDS A NEW RECORD TO AN ATTITUDE FILE. A RECORD CONSISTS OF          | 
CC |  A TIME AND A STATE AND IF AVAILABLE, DERIVATIVES                  |
CC |  OF THE STATE. THE FILE POINTED BY IUNIT MUST HAVE BEEN OPENED     |
CC |  AND INITIALISED BY WAFOP, AND AT LEAST ONE FILE BLOCK MUST HAVE   |
CC |  BEEN CREATED WITH WAFNB.                                          |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER FOR ORBIT FILE, AS RETURNED   |
CC |                           BY WAFOP                                 |
CC |  TIME           R*8       TIME OF THE RECORD. CURRENTLY ONLY TDT   |
CC |                           IN MJD2000 FORMAT IS SUPPORTED           |
CC |  STATE(*)       R*8       STATE VECTOR CORRESPONDING TO TIME       |
CC |                           REFERENCE SYSTEM AND CENTRE BODY MUST    |
CC |                           BE COMPATIBLE TO THOSE OF LAST BLOCK     |
CC |                           CREATED WITH WAFNB. DIMENSION SHALL      |
CC |                           BE COMPATIBLE TO NVARS PARAMETER IN      |
CC |                           WAFOP, NAMELY 4 FOR QUATERNION ONLY AND    |
CC |                           7 FOR QUATERNION AND RATES.             |
CC |  DERIVS(*)      R*8       DERIVATIVES OF STATE. ONLY TO BE FILLED  |
CC |                           IF FILE WAS INITIALISED WITH IDERIV      |
CC |                           PARAMETER NON-ZERO IN WAFOP CALL. IF     |
CC |                           IDERIV PARAMETER WAS 0 THE CONTENTS OF   |
CC |                           DERIVS ARE IGNORED, AND ONLY A DUMMY     |
CC |                           PARAMETER IS NECESSARY. DERIVS DIMENSION |
CC |                           SHALL BE THE SAME AS STATE               |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  IER            I*4       ERROR CODE, NON-ZERO IF ERROR            |
CC |                           1 = ERROR WRITTING RECORD,               |
CC |                               FILE IS CLOSED (HAS A BLOCK BEEN     |
CC |                               CREATED YET?)                        |
CC |                           2 = THIS IS THE ERROR CODE PRODUCED WHEN |
CC |                               FAILING TO CLOSE THE ORBIT FILE ONCE |
CC |                               ANOTHER ERROR CONDITION OCURRED.     |
CC |                               FOR THIS TO HAPPEN, SEVERE PROBLEMS  |
CC |                               MUST HAVE OCCURRED, AND THE CONTENTS |
CC |                               OF THE ORBIT FILE ARE NOT GUARANTEED |
CC |                               AT ALL                               |
CC |                           3 = INVALID IDENTIFIER                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  debugf.inc   ERROR PRINTING OPTIONS                               |
CC |  wafsh.inc                                                         |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WNWREC, WAFCL                                                     |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imsatt/atthist/attfil/src/SCCS/s.wafnr.F	',
C     &'1.2	01/08/03 	IMSS_FDD\n'/
CC
      INTEGER IER, IF
      DOUBLE PRECISION TIME, STATE(1), DERIVS(1)
CC
CC
CC    CALLING...
CC
      INTEGER WNWREC
CC
CC     INTERNAL VARIABLES
CC
      INTEGER IUNER
      LOGICAL PR
CC
CC
CC
CC    INCLUDE FILES
CC
C ======================================================================
C INCLUDE FILE DEBUGF
C ======================================================================
C      CHARACTER*68 SCCS_INFO_debugf(2)
C     &/'@(#)/home/imlib/gen/errors/inc/SCCS/s.debugf.inc	',
C     &'1.1	98/04/21 	OAD_IMSS\n'/
C
      INTEGER      IDEBUG
      COMMON/ DEBUG/ IDEBUG(10)
C
CB    / DEBUG/ DEBUG FLAGS
CV    IF IDEBUG(1).NE.0 : TRACE MESSAGES ARE GENERATED AND WRITTEN
CV                        (FOR DEBUGGING, INTERMEDIATE OUTPUT...)
CV    IDEBUG(9)         : IT CONTROLS THE SEVERITY FOR THE MESSAGES 
CV                        OUTPUT
CV                        0 MEANS THAT REPEAT, ERROR AND
CV                          WARNING MESSAGES ARE WRITTEN
CV                        1 MEANS THAT ONLY REPEAT AND 
CV                          ERROR MESSAGES ARE WRITTEN
CV                        2 ONLY ERROR MESSAGES ARE WRITTEN
CV                        3 ERROR MESSAGES ARE NOT WRITTEN  
CV    IDEBUG(10)        : UNIT WHERE MESSAGES ARE GOING TO BE DISPLAYED
CV                        NEGATIVE UNIT MEANS UNIT 0 (UNIX STDERR)
CV                        TO LOGICAL UNIT NUMBER = IDEBUG(10).
CV                        0 MEANS NO MESSAGE WRITTEN
CV    IDEBUG(3)...IDEBUG(9) ARE CURRENTLY UNUSED.
C +----------------------+--------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA      |
C +----------------------|--------------------------+
C |   FDD                |  V. Companys             |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  DATA TO BE SHARED BETWEEN WAF?? FUNCTIONS. THIS INCLUDE FILE      |
C |  SHOULD BE CONSIDERED HIDDEN TO THE USER. USER SHOULD NEVER        |
C |  INCLUDE IT (THERE IS NO NEED).                                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  WAFP:                                                             |
C |     
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wafsh(2)
C      DATA SCCS_INFO_wafsh
C     &/'@(#)/home/imsatt/atthist/attfil/inc/SCCS/s.wafsh.inc	',
C     &'1.2	01/08/03 	IMSS_FDD\n'/
C
      INTEGER MAXUN
      PARAMETER (MAXUN = 8)
CC
CC   FIX ONCE FOR EVER THE ERROR UNIT
CC/
      IF (IDEBUG(10).LT.0) THEN
         IUNER = 0
      ELSE IF (IDEBUG(10).EQ.0) THEN
         IUNER = -1
      ELSE
         IUNER = IDEBUG(10)
      ENDIF
      PR = (IDEBUG(9).LT.3).AND.(IUNER.GE.0) 
      PR = (IDEBUG(9).LT.3).AND.(IUNER.GE.0) 
      IF (IF .LT.1 .OR. IF .GT. MAXUN)
     .   THEN
        IF (PR) THEN
         WRITE (IUNER, *) 'E WAFNR. INVALID IDENTIFIER'
         ENDIF
         IER = 3
         RETURN
      ENDIF
CC
      IER = 0
      IF (0.EQ.WNWREC (IF, TIME, STATE, DERIVS)) THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E WAFNR. UNABLE TO WRITE RECORD'
         WRITE (IUNER, *) '         FILE WILL BE CLOSED'
         ENDIF
         IER = 1
         CALL WAFCL(IF, IER)
         IF (0.NE.IER) THEN
            IF (PR) THEN
            WRITE (IUNER, *) 'R WAFNR. UNABLE TO CLOSE FILE'
            ENDIF
            IER = 2
         ENDIF
         RETURN
      ENDIF
      RETURN
      END
      
      
 
 
 
 
      SUBROUTINE WAFOP (IUNIT, FNAME, NVARS, IDERIV, IFRAME,
     .                         ITSCAL, IF, IER)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE WAFOP            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             | 
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  OPENS A ROSETTA ATTITUDE FILE FOR WRITTING AND FILLS HEADER PART.    |
CC |  SCRATCH IF EXISTS                                                 |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IUNIT(1/3)      I*4      UNIT TO WHERE FILE MUST BE OPENED.       |
CC |                           IF UNIT = 0 THEN UNIT IS EXPECTED TO BE  |
CC |                           A VECTOR OF 3 COMPONENTS. UNIT(2) AND    |
CC |                           UNIT(3) GIVE THEN A RANGE TO SEARCH FOR  |
CC |                           FOR POSSIBLE UNITS                       |
CC |  FNAME          C*132     NAME OF THE FILE TO BE OPENED.           |
CC |  NVARS          I*4       NUMBER OF VARIABLES TO STORE. 4 FOR      |
CC |                           QUATERNION, 7 FOR QUATERNION AND RATES   |
CC |  IDERIV         I*4       NON ZERO IF DERIVATIVES ARE AVAILABLE    |
CC |  IFRAME         I*4       DEFAULT REFERENCE FRAME ID               |
CC |                           0: EQ2000                                |
CC |                           1: EC2000                                |
CC |                           2: EQ1950                                |
CC |                           3: EC1950                                |
CC |  ITSCAL         I*4       TIME SCALE ID                            |
CC |                           0 : TDB (BARYCENTRIC DYNAMIC TIME)       |
CC |                               IN MJD2000 FORMAT                    |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  IF             I*4       FILE IDENTIFIER TO BE USED IN SUBSEQUENT |
CC |                           CALLS OF SUBROUTINES OF THE FORM WAF??   |
CC |                           0 IF FAILED TO OPEN FILE                 |
CC |  IER            I*4       ERROR CODE, NON-ZERO IF ERROR            |
CC |                           1 = NVARS MUST BE 4,7                    |
CC |                           2 = FAILED OPENING FILE                  |
CC |                           3 = UNABLE TO SET DEFAULS                |
CC |                           4 = CORRUPTION??                         |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  debugf.inc   error printing options                               |
CC |  wafsh.inc                                                         |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WIFOP, WMODHE, WIFCL                                              |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imsatt/atthist/attfil/src/SCCS/s.wafop.F	',
C     &'1.2	01/08/03 	IMSS_FDD\n'/
CC
      INTEGER IUNIT, IER
      INTEGER NVARS, IDERIV, IFRAME, ITSCAL, IF
      CHARACTER*132 FNAME
CC
CC    LOCAL VARIABLES
      INTEGER BUF(2), IUNER
CC
      LOGICAL PR
CC
CC    CALLING...
CC
      INTEGER WIFOP, WMODHE, WIFCL
CC
CC    INCLUDE FILES
CC
C ======================================================================
C INCLUDE FILE DEBUGF
C ======================================================================
C      CHARACTER*68 SCCS_INFO_debugf(2)
C     &/'@(#)/home/imlib/gen/errors/inc/SCCS/s.debugf.inc	',
C     &'1.1	98/04/21 	OAD_IMSS\n'/
C
      INTEGER      IDEBUG
      COMMON/ DEBUG/ IDEBUG(10)
C
CB    / DEBUG/ DEBUG FLAGS
CV    IF IDEBUG(1).NE.0 : TRACE MESSAGES ARE GENERATED AND WRITTEN
CV                        (FOR DEBUGGING, INTERMEDIATE OUTPUT...)
CV    IDEBUG(9)         : IT CONTROLS THE SEVERITY FOR THE MESSAGES 
CV                        OUTPUT
CV                        0 MEANS THAT REPEAT, ERROR AND
CV                          WARNING MESSAGES ARE WRITTEN
CV                        1 MEANS THAT ONLY REPEAT AND 
CV                          ERROR MESSAGES ARE WRITTEN
CV                        2 ONLY ERROR MESSAGES ARE WRITTEN
CV                        3 ERROR MESSAGES ARE NOT WRITTEN  
CV    IDEBUG(10)        : UNIT WHERE MESSAGES ARE GOING TO BE DISPLAYED
CV                        NEGATIVE UNIT MEANS UNIT 0 (UNIX STDERR)
CV                        TO LOGICAL UNIT NUMBER = IDEBUG(10).
CV                        0 MEANS NO MESSAGE WRITTEN
CV    IDEBUG(3)...IDEBUG(9) ARE CURRENTLY UNUSED.
C +----------------------+--------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA      |
C +----------------------|--------------------------+
C |   FDD                |  V. Companys             |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  DATA TO BE SHARED BETWEEN WAF?? FUNCTIONS. THIS INCLUDE FILE      |
C |  SHOULD BE CONSIDERED HIDDEN TO THE USER. USER SHOULD NEVER        |
C |  INCLUDE IT (THERE IS NO NEED).                                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  WAFP:                                                             |
C |     
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wafsh(2)
C      DATA SCCS_INFO_wafsh
C     &/'@(#)/home/imsatt/atthist/attfil/inc/SCCS/s.wafsh.inc	',
C     &'1.2	01/08/03 	IMSS_FDD\n'/
C
      INTEGER MAXUN
      PARAMETER (MAXUN = 8)
CC
CC   FIX ONCE FOR EVER THE ERROR UNIT
CC
      IF (IDEBUG(10).LT.0) THEN
         IUNER = 0
      ELSE IF (IDEBUG(10).EQ.0) THEN
         IUNER = -1
      ELSE
         IUNER = IDEBUG(10)
      ENDIF
      PR = (IDEBUG(9).LT.3).AND.(IUNER.GE.0) 
CC
      IF (NVARS.NE.4.AND.NVARS.NE.7) THEN
         IER = 1
         IF (PR) THEN
         WRITE (IUNER, *) 'E WAFOP. NVARS MUST BE 4 OR 7'
         ENDIF
         IF = 0
         RETURN
      ENDIF
CC
CC   OPEN FILE
CC
      IF = WIFOP (IUNIT, FNAME, 2, NVARS, IDERIV, 160, 160, 34000)
      IF (IF.EQ.0) THEN
         IER = 2
         IF (PR) THEN
         WRITE (IUNER, *) 'E WAFOP. NOT ABLE TO CREATE FILE'
         ENDIF
         IF = 0
         RETURN
      ENDIF
      BUF (1) = IFRAME
      BUF (2) = ITSCAL
      IF (0.EQ.WMODHE (IF, BUF, 13, 2)) THEN
         IER = 3
         IF (PR) THEN
         WRITE (IUNER, *) 'E WAFOP. NOT ABLE TO SET DEFAULTS.',
     .                    '         FILE CLOSED AGAIN'
         ENDIF
         IF (0.EQ.WIFCL(IF)) THEN
            IER = 4
            IF (PR) THEN
            WRITE (IUNER, *) 'E WAFOP. CANNOT CLOSE FILE.'
            ENDIF
            RETURN
         ENDIF
         IF = 0
         RETURN
      ENDIF
      IER = 0
      RETURN
      END






 
 
 
 
      INTEGER FUNCTION WBLHEA (IF, BUFFER, RE)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE WBLHEA                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  WRITES A BLOCK HEADER BUFFER INTO AN IFILE STARTING IN RECORD REC |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF      I*4    INTERPOLATION FILE NUMBER                          |
CC |  BUFF    R*8    BUFFER CONTAINING HEADER                           |
CC |  RE      I*4    RECORD TO START WITH                               |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  RETURNS 1 IN SUCCESS 0 IN ERROR                                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc wshare.inc                                         |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WOREC                                                             |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/07 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.wblhea.F	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF
      DOUBLE PRECISION BUFFER(1)
CC
CC    LOCAL VARIABLES
CC
      INTEGER I, J, IOS, RE
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS, WRITE...            |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR WRITE                                           |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  IFPARS:                                                           |
C |    WFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR WRITTING                                    |
C |    WUNITS   ARRAY WITH FILE UNITS                                  |
C |    WTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    WVARS    ARRAY WITH NUMBER OF VARS                              |
C |    NDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    WRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    WHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    WLREC    LAST RECORD WRITTEN                                    |
C |    WBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    WBTEND   FOR CURRENT BLOCK END TIME                             |
C |    WTBEG    FOR IFILE BLOCK START TIME                             |
C |    WTEND    FOR IFILE BLOCK END TIME                               |
C |    WCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    WCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    WCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    WCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C |  WBUF:   Parameters to buffer I/O                                  |
C |    WFBUF    BUFFER TO READ BIG RECORDS                             |
C |    WBUFFR   FIRST LOGICAL RECORD IN RECORD                         |
C |    WBUFLR   LAST LOGICAL RECORD IN RECORD. A REAL RECORD IS MADE   |
C |             OF SEVERAL LOGICAL RECORDS. A LOGICAL RECORD CONTAINS  |
C |             FOR EXAMPLE, A TIME, A STATE AND THE DERIVATIVES       |
C |             IN ORDER TO AVOID TO MUCH IO, THE PHISICAL RECORD IS   |
C |             MUCH HIGHER. I/O IS DONE TO BUFFER, AND ONLY TO FILE   |
C |             WHEN THE LOGICAL RECORDS GO BEYOND THE CONTENDS OF THE |
C |             BUFFER                                                 |
C |    WRCW     NUMBER OF RECORDS CURRENTLY WRITTEN                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.wshare.inc	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
C
      INTEGER MWFLS
      PARAMETER (MWFLS = 8)
      INTEGER WFLIST(MWFLS), WUNITS(MWFLS), WTYPES(MWFLS),
     .            WVARS(MWFLS), WDERS(MWFLS),
     .            WRECLS(MWFLS), WHSIZ(MWFLS), WBLHSI(MWFLS),
     .            WLASTS(MWFLS),
     .            WLREC(MWFLS),
     .            WCFR(MWFLS), WCLR(MWFLS), WCPB(MWFLS), 
     .            WCNB(MWFLS)

       DOUBLE PRECISION WBTBEG(MWFLS), WBTEND(MWFLS),WTBEG(MWFLS)
     .                 , WTEND(MWFLS)

      COMMON /WFPARS/ WFLIST, WUNITS, WTYPES, WVARS, WDERS, 
     .                WRECLS, WHSIZ, WBLHSI, WLASTS, WLREC,
     .                WBTBEG, WBTEND, WTBEG, WTEND,
     .                WCFR, WCLR, WCPB, WCNB
      INTEGER MAXFWR

C
C    SIZE OF FILE RECORD 
C

      PARAMETER (MAXFWR = 40000)
      DOUBLE PRECISION WFBUF(MAXFWR / 8, MWFLS)
      INTEGER WBUFFR(MWFLS), WBUFLR(MWFLS), WRCW(MWFLS), 
     .     WNLREC(MWFLS)
      COMMON /WBUF/ WFBUF, WBUFFR, WBUFLR, WRCW, WNLREC
CC
CC
CC
CC
CC
CC    CALLING
CC
      INTEGER WOREC
      WBLHEA = 0
      IF (IF.LT.1.OR.IF.GT.MWFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WBLHEA: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (WFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WBLHEA: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      J = 1
      DO 10 I = 0, WBLHSI(IF) - 1
          IOS = WOREC (IF, I + RE, BUFFER (J))
CC         WRITE (UNIT = WUNITS(IF), IOSTAT = IOS, REC = I + RE) 
CC     .      (BUFFER(K), K=J,J + WRECLS(IF)/8 - 1)
         IF (IOS .NE. 0) THEN
            IF (PR.GT.0) WRITE (0, *) 
     .       'ERROR::WBLHEA: Not able to write block header IOS = ',
     .                IOS, 'File may be corrupted'
            RETURN
         ENDIF
         J = J + WRECLS(IF)/8
 10   CONTINUE
      WBLHEA = 1
      RETURN
      END

 
 
 
 
      INTEGER FUNCTION WGBLHE (IF, BUFFER, RE)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE WBLHEA                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  READS A BLOCK HEADER BUFFER FROM AN IFILE STARTING IN RECORD REC  |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF      I*4    INTERPOLATION FILE NUMBER                          |
CC |  RE      I*4    RECORD TO START WITH                               |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  BUFF    R*8    BUFFER CONTAINING HEADER                           |
CC |  RETURNS 1 IN SUCCESS 0 IN ERROR                                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions wshare.inc                                             |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WIREC                                                             |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/08 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.wgblhe.F	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF
      DOUBLE PRECISION BUFFER(1)
CC
CC    LOCAL VARIABLES
CC
      INTEGER I, J, IOS, RE
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS, WRITE...            |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR WRITE                                           |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  IFPARS:                                                           |
C |    WFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR WRITTING                                    |
C |    WUNITS   ARRAY WITH FILE UNITS                                  |
C |    WTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    WVARS    ARRAY WITH NUMBER OF VARS                              |
C |    NDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    WRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    WHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    WLREC    LAST RECORD WRITTEN                                    |
C |    WBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    WBTEND   FOR CURRENT BLOCK END TIME                             |
C |    WTBEG    FOR IFILE BLOCK START TIME                             |
C |    WTEND    FOR IFILE BLOCK END TIME                               |
C |    WCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    WCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    WCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    WCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C |  WBUF:   Parameters to buffer I/O                                  |
C |    WFBUF    BUFFER TO READ BIG RECORDS                             |
C |    WBUFFR   FIRST LOGICAL RECORD IN RECORD                         |
C |    WBUFLR   LAST LOGICAL RECORD IN RECORD. A REAL RECORD IS MADE   |
C |             OF SEVERAL LOGICAL RECORDS. A LOGICAL RECORD CONTAINS  |
C |             FOR EXAMPLE, A TIME, A STATE AND THE DERIVATIVES       |
C |             IN ORDER TO AVOID TO MUCH IO, THE PHISICAL RECORD IS   |
C |             MUCH HIGHER. I/O IS DONE TO BUFFER, AND ONLY TO FILE   |
C |             WHEN THE LOGICAL RECORDS GO BEYOND THE CONTENDS OF THE |
C |             BUFFER                                                 |
C |    WRCW     NUMBER OF RECORDS CURRENTLY WRITTEN                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.wshare.inc	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
C
      INTEGER MWFLS
      PARAMETER (MWFLS = 8)
      INTEGER WFLIST(MWFLS), WUNITS(MWFLS), WTYPES(MWFLS),
     .            WVARS(MWFLS), WDERS(MWFLS),
     .            WRECLS(MWFLS), WHSIZ(MWFLS), WBLHSI(MWFLS),
     .            WLASTS(MWFLS),
     .            WLREC(MWFLS),
     .            WCFR(MWFLS), WCLR(MWFLS), WCPB(MWFLS), 
     .            WCNB(MWFLS)

       DOUBLE PRECISION WBTBEG(MWFLS), WBTEND(MWFLS),WTBEG(MWFLS)
     .                 , WTEND(MWFLS)

      COMMON /WFPARS/ WFLIST, WUNITS, WTYPES, WVARS, WDERS, 
     .                WRECLS, WHSIZ, WBLHSI, WLASTS, WLREC,
     .                WBTBEG, WBTEND, WTBEG, WTEND,
     .                WCFR, WCLR, WCPB, WCNB
      INTEGER MAXFWR

C
C    SIZE OF FILE RECORD 
C

      PARAMETER (MAXFWR = 40000)
      DOUBLE PRECISION WFBUF(MAXFWR / 8, MWFLS)
      INTEGER WBUFFR(MWFLS), WBUFLR(MWFLS), WRCW(MWFLS), 
     .     WNLREC(MWFLS)
      COMMON /WBUF/ WFBUF, WBUFFR, WBUFLR, WRCW, WNLREC
CC
CC
CC
CC
CC
CC    CALLING
CC
      INTEGER WIREC
      WGBLHE = 0
      IF (IF.LT.1.OR.IF.GT.MWFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WGBLHE: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (WFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WGBLHE: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      J = 1
      DO 10 I = 0, WBLHSI(IF) - 1
          IOS = WIREC (IF, I + RE, BUFFER(J))
CC         READ (UNIT = WUNITS(IF), IOSTAT = IOS, REC = I + RE) 
CC     .      (BUFFER(K), K=J,J + WRECLS(IF)/8 - 1)
         IF (IOS .NE. 0) THEN
            IF (PR.GT.0) WRITE (0, *) 
     .       'ERROR::WGBLHE: Not able to read block header IOS = ',
     .                IOS
            RETURN
         ENDIF
         J = J + WRECLS(IF)/8
 10   CONTINUE
      WGBLHE = 1
      RETURN
      END

 
 
 
 
      INTEGER FUNCTION WGHEAD (IF, BUFFER)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE WGHEAD                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  READS THE HEADER BUFFER FROM AN IFILE                             |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF INTERPOLATION FILE NUMBER                                      |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  BUFF    R*8    BUFFER CONTAINING HEADER                           |
CC |  RETURNS 1 IN SUCCESS 0 IN ERROR                                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc wshare.inc                                         |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WIREC                                                             |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/07 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.wghead.F	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF
      DOUBLE PRECISION BUFFER(1)
CC
CC    LOCAL VARIABLES
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS, WRITE...            |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR WRITE                                           |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  IFPARS:                                                           |
C |    WFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR WRITTING                                    |
C |    WUNITS   ARRAY WITH FILE UNITS                                  |
C |    WTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    WVARS    ARRAY WITH NUMBER OF VARS                              |
C |    NDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    WRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    WHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    WLREC    LAST RECORD WRITTEN                                    |
C |    WBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    WBTEND   FOR CURRENT BLOCK END TIME                             |
C |    WTBEG    FOR IFILE BLOCK START TIME                             |
C |    WTEND    FOR IFILE BLOCK END TIME                               |
C |    WCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    WCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    WCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    WCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C |  WBUF:   Parameters to buffer I/O                                  |
C |    WFBUF    BUFFER TO READ BIG RECORDS                             |
C |    WBUFFR   FIRST LOGICAL RECORD IN RECORD                         |
C |    WBUFLR   LAST LOGICAL RECORD IN RECORD. A REAL RECORD IS MADE   |
C |             OF SEVERAL LOGICAL RECORDS. A LOGICAL RECORD CONTAINS  |
C |             FOR EXAMPLE, A TIME, A STATE AND THE DERIVATIVES       |
C |             IN ORDER TO AVOID TO MUCH IO, THE PHISICAL RECORD IS   |
C |             MUCH HIGHER. I/O IS DONE TO BUFFER, AND ONLY TO FILE   |
C |             WHEN THE LOGICAL RECORDS GO BEYOND THE CONTENDS OF THE |
C |             BUFFER                                                 |
C |    WRCW     NUMBER OF RECORDS CURRENTLY WRITTEN                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.wshare.inc	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
C
      INTEGER MWFLS
      PARAMETER (MWFLS = 8)
      INTEGER WFLIST(MWFLS), WUNITS(MWFLS), WTYPES(MWFLS),
     .            WVARS(MWFLS), WDERS(MWFLS),
     .            WRECLS(MWFLS), WHSIZ(MWFLS), WBLHSI(MWFLS),
     .            WLASTS(MWFLS),
     .            WLREC(MWFLS),
     .            WCFR(MWFLS), WCLR(MWFLS), WCPB(MWFLS), 
     .            WCNB(MWFLS)

       DOUBLE PRECISION WBTBEG(MWFLS), WBTEND(MWFLS),WTBEG(MWFLS)
     .                 , WTEND(MWFLS)

      COMMON /WFPARS/ WFLIST, WUNITS, WTYPES, WVARS, WDERS, 
     .                WRECLS, WHSIZ, WBLHSI, WLASTS, WLREC,
     .                WBTBEG, WBTEND, WTBEG, WTEND,
     .                WCFR, WCLR, WCPB, WCNB
      INTEGER MAXFWR

C
C    SIZE OF FILE RECORD 
C

      PARAMETER (MAXFWR = 40000)
      DOUBLE PRECISION WFBUF(MAXFWR / 8, MWFLS)
      INTEGER WBUFFR(MWFLS), WBUFLR(MWFLS), WRCW(MWFLS), 
     .     WNLREC(MWFLS)
      COMMON /WBUF/ WFBUF, WBUFFR, WBUFLR, WRCW, WNLREC
      INTEGER I, J, IOS
CC
CC    CALLING
CC
      INTEGER WIREC
      WGHEAD = 0
      IF (IF.LT.1.OR.IF.GT.MWFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WGHEAD: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (WFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WGHEAD: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      J = 1
      DO 10 I = 1, WHSIZ(IF)
         IOS = WIREC (IF, I, BUFFER(J))
CC         READ (UNIT = WUNITS(IF), IOSTAT = IOS, REC = I) 
CC     .      (BUFFER(K), K=J,J + WRECLS(IF)/8 - 1)
         IF (IOS .NE. 0) THEN
            IF (PR.GT.0) WRITE (0, *) 
     .       'ERROR::WGHEAD: Not able to read header IOS = ',
     .                IOS
            RETURN
         ENDIF
         J = J + WRECLS(IF)/8
 10   CONTINUE
      WGHEAD = 1
      RETURN
      END

 
 
 
 
      INTEGER FUNCTION WHEAD (IF, BUFFER)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE WHEAD                       |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  WRITES THE HEADER BUFFER INTO AN IFILE                            |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF INTERPOLATION FILE NUMBER                                      |
CC |  BUFF    R*8    BUFFER CONTAINING HEADER                           |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  RETURNS 1 IN SUCCESS 0 IN ERROR                                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc wshare.inc                                         |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WOREC                                                             |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/07 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.whead.F	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF
      DOUBLE PRECISION BUFFER(1)
CC
CC    LOCAL VARIABLES
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS, WRITE...            |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR WRITE                                           |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  IFPARS:                                                           |
C |    WFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR WRITTING                                    |
C |    WUNITS   ARRAY WITH FILE UNITS                                  |
C |    WTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    WVARS    ARRAY WITH NUMBER OF VARS                              |
C |    NDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    WRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    WHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    WLREC    LAST RECORD WRITTEN                                    |
C |    WBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    WBTEND   FOR CURRENT BLOCK END TIME                             |
C |    WTBEG    FOR IFILE BLOCK START TIME                             |
C |    WTEND    FOR IFILE BLOCK END TIME                               |
C |    WCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    WCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    WCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    WCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C |  WBUF:   Parameters to buffer I/O                                  |
C |    WFBUF    BUFFER TO READ BIG RECORDS                             |
C |    WBUFFR   FIRST LOGICAL RECORD IN RECORD                         |
C |    WBUFLR   LAST LOGICAL RECORD IN RECORD. A REAL RECORD IS MADE   |
C |             OF SEVERAL LOGICAL RECORDS. A LOGICAL RECORD CONTAINS  |
C |             FOR EXAMPLE, A TIME, A STATE AND THE DERIVATIVES       |
C |             IN ORDER TO AVOID TO MUCH IO, THE PHISICAL RECORD IS   |
C |             MUCH HIGHER. I/O IS DONE TO BUFFER, AND ONLY TO FILE   |
C |             WHEN THE LOGICAL RECORDS GO BEYOND THE CONTENDS OF THE |
C |             BUFFER                                                 |
C |    WRCW     NUMBER OF RECORDS CURRENTLY WRITTEN                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.wshare.inc	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
C
      INTEGER MWFLS
      PARAMETER (MWFLS = 8)
      INTEGER WFLIST(MWFLS), WUNITS(MWFLS), WTYPES(MWFLS),
     .            WVARS(MWFLS), WDERS(MWFLS),
     .            WRECLS(MWFLS), WHSIZ(MWFLS), WBLHSI(MWFLS),
     .            WLASTS(MWFLS),
     .            WLREC(MWFLS),
     .            WCFR(MWFLS), WCLR(MWFLS), WCPB(MWFLS), 
     .            WCNB(MWFLS)

       DOUBLE PRECISION WBTBEG(MWFLS), WBTEND(MWFLS),WTBEG(MWFLS)
     .                 , WTEND(MWFLS)

      COMMON /WFPARS/ WFLIST, WUNITS, WTYPES, WVARS, WDERS, 
     .                WRECLS, WHSIZ, WBLHSI, WLASTS, WLREC,
     .                WBTBEG, WBTEND, WTBEG, WTEND,
     .                WCFR, WCLR, WCPB, WCNB
      INTEGER MAXFWR

C
C    SIZE OF FILE RECORD 
C

      PARAMETER (MAXFWR = 40000)
      DOUBLE PRECISION WFBUF(MAXFWR / 8, MWFLS)
      INTEGER WBUFFR(MWFLS), WBUFLR(MWFLS), WRCW(MWFLS), 
     .     WNLREC(MWFLS)
      COMMON /WBUF/ WFBUF, WBUFFR, WBUFLR, WRCW, WNLREC
CC
CC    CALLING
CC
      INTEGER WOREC
      INTEGER I, J, IOS
      WHEAD = 0
      IF (IF.LT.1.OR.IF.GT.MWFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WHEAD: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (WFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WHEAD: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      J = 1
      DO 10 I = 1, WHSIZ(IF)
         IOS = WOREC (IF, I, BUFFER(J))
CC         WRITE (UNIT = WUNITS(IF), IOSTAT = IOS, REC = I) 
CC     .      (BUFFER(K), K=J,J + WRECLS(IF)/8 - 1)
         IF (IOS .NE. 0) THEN
            IF (PR.GT.0) WRITE (0, *) 
     .       'ERROR::WHEAD: Not able to write header IOS = ',
     .                IOS, 'File may be corrupted'
            RETURN
         ENDIF
         J = J + WRECLS(IF)/8
 10   CONTINUE
      WHEAD = 1
      RETURN
      END

 
 
 
 
      INTEGER FUNCTION WIFCL (IF)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE WIFCL                       |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  CLOSES ONE INTERPOLATION FILE (ORBIT FILE) WHICH HAS BEEN OPEN    |
CC |  FOR WRITTING. SETS PARAMETERS TO                                  |
CC |  ALLOW NEW USE OF SHARED MEMORY                                    |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF          I*4     IDENTIFIER FOR THE IFILE, AS RETURNED BY      |
CC |                      WIFOP.                                        |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  RETURNS 1 IN SUCCESS 0 IN ERROR                                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  wshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WGBLHE, WBLHEA, WGHEAD, WHEAD, WFLUSH                             |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/08 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.wifcl.F	',
C     &'1.5	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF
CC
CC    LOCAL VARIABLES
CC
      INTEGER IOS
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS, WRITE...            |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR WRITE                                           |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  IFPARS:                                                           |
C |    WFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR WRITTING                                    |
C |    WUNITS   ARRAY WITH FILE UNITS                                  |
C |    WTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    WVARS    ARRAY WITH NUMBER OF VARS                              |
C |    NDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    WRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    WHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    WLREC    LAST RECORD WRITTEN                                    |
C |    WBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    WBTEND   FOR CURRENT BLOCK END TIME                             |
C |    WTBEG    FOR IFILE BLOCK START TIME                             |
C |    WTEND    FOR IFILE BLOCK END TIME                               |
C |    WCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    WCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    WCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    WCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C |  WBUF:   Parameters to buffer I/O                                  |
C |    WFBUF    BUFFER TO READ BIG RECORDS                             |
C |    WBUFFR   FIRST LOGICAL RECORD IN RECORD                         |
C |    WBUFLR   LAST LOGICAL RECORD IN RECORD. A REAL RECORD IS MADE   |
C |             OF SEVERAL LOGICAL RECORDS. A LOGICAL RECORD CONTAINS  |
C |             FOR EXAMPLE, A TIME, A STATE AND THE DERIVATIVES       |
C |             IN ORDER TO AVOID TO MUCH IO, THE PHISICAL RECORD IS   |
C |             MUCH HIGHER. I/O IS DONE TO BUFFER, AND ONLY TO FILE   |
C |             WHEN THE LOGICAL RECORDS GO BEYOND THE CONTENDS OF THE |
C |             BUFFER                                                 |
C |    WRCW     NUMBER OF RECORDS CURRENTLY WRITTEN                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.wshare.inc	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
C
      INTEGER MWFLS
      PARAMETER (MWFLS = 8)
      INTEGER WFLIST(MWFLS), WUNITS(MWFLS), WTYPES(MWFLS),
     .            WVARS(MWFLS), WDERS(MWFLS),
     .            WRECLS(MWFLS), WHSIZ(MWFLS), WBLHSI(MWFLS),
     .            WLASTS(MWFLS),
     .            WLREC(MWFLS),
     .            WCFR(MWFLS), WCLR(MWFLS), WCPB(MWFLS), 
     .            WCNB(MWFLS)

       DOUBLE PRECISION WBTBEG(MWFLS), WBTEND(MWFLS),WTBEG(MWFLS)
     .                 , WTEND(MWFLS)

      COMMON /WFPARS/ WFLIST, WUNITS, WTYPES, WVARS, WDERS, 
     .                WRECLS, WHSIZ, WBLHSI, WLASTS, WLREC,
     .                WBTBEG, WBTEND, WTBEG, WTEND,
     .                WCFR, WCLR, WCPB, WCNB
      INTEGER MAXFWR

C
C    SIZE OF FILE RECORD 
C

      PARAMETER (MAXFWR = 40000)
      DOUBLE PRECISION WFBUF(MAXFWR / 8, MWFLS)
      INTEGER WBUFFR(MWFLS), WBUFLR(MWFLS), WRCW(MWFLS), 
     .     WNLREC(MWFLS)
      COMMON /WBUF/ WFBUF, WBUFFR, WBUFLR, WRCW, WNLREC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
CC
      INTEGER BLHEI (MAXBLK/4)
      EQUIVALENCE (BLHE, BLHEI)
CC
      INTEGER HEAINT(MAXHEA/4)
      EQUIVALENCE (HEABUF, HEAINT)
CC
CC    CALLED FUNCTIONS
CC
      INTEGER WGBLHE, WBLHEA, WGHEAD, WHEAD, WFLUSH
CC  
      WIFCL = 0
      IF (IF.LT.1.OR.IF.GT.MWFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WIFCL: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (WFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WIFCL: Invalid identifier IF = ', IF
         RETURN
      ENDIF
CC
CC
CC    IN CASE A BLOCK HAS BEEN STARTED, WRITE BLOCK INFORMATION
CC
      IF (WLASTS(IF).NE.0) THEN
         IF (0.EQ.WGBLHE (IF, BLHE, WLASTS(IF))) THEN
            IF (PR.GT.0) WRITE (0,*) 
     .       'ERROR::WIFCL: Could not read last block header'
            RETURN
         ENDIF
CC
CC    IF LAST BLOCK IS NOT EMPTY, COMPLETE IT
CC
         IF (WCLR (IF) .NE. 0) THEN 
CC
CC    SET LAST RECORD AND NEXT BLOCK IN HEADER
CC
            BLHEI (2) = WCLR (IF)
            BLHEI (4) = 0
CC
CC    SET FIRST TIME AND LAST TIME IN HEADER
CC
            BLHE (3) = WBTBEG (IF)
            BLHE (4) = WBTEND (IF)
CC
CC    WRITE THE HEADER OF THE LAST BLOCK
CC
            IF (0.EQ.WBLHEA (IF, BLHE, WLASTS(IF))) THEN
               IF (PR.GT.0) WRITE (0,*) 
     .          'ERROR::WIFCL: Could not write last block header'
                  RETURN
            ENDIF
            IF (WLREC (IF).GE.WCFR (IF)) THEN
CC
CC    SET THE GLOBAL START AND END TIME, IF FIRST RECORD WRITTEN
CC
               IF ((WLASTS (IF) .EQ. WHSIZ(IF) + 1)) THEN
                  IF (WBTBEG (IF) .LT. WBTEND (IF)) THEN
                     WTBEG (IF) = WBTBEG (IF)
                     WTEND (IF) = WBTEND (IF)
                  ELSE
                     WTEND (IF) = WBTBEG (IF)
                     WTBEG (IF) = WBTEND (IF)
                  ENDIF
               ELSE
                  IF (WBTEND (IF) .GT. WTEND (IF))
     .               WTEND (IF) = WBTEND (IF)
                  IF (WBTBEG (IF) .GT. WTEND (IF))
     .               WTEND (IF) = WBTBEG (IF)
                  IF (WBTEND (IF) .LT. WTBEG (IF))
     .               WTBEG (IF) = WBTEND (IF)
                  IF (WBTBEG (IF) .LT. WTBEG (IF))
     .               WTBEG (IF) = WBTBEG (IF)
               ENDIF
            ENDIF
         ELSE
            WLASTS (IF) = WCPB (IF)
            IF (PR.GT.0) WRITE (0,*) 
     .     'WARNING::WIFCL: No data in last block'
            IF (PR.GT.0) WRITE (0,*) 
     .       '                Block will be removed'
         ENDIF
      ENDIF
CC
CC    WRITE FILE HEADER (READ IT FIRST)
CC
      IF (0.EQ.WGHEAD (IF, HEABUF)) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WIFCL: Could not read file header'
         RETURN
      ENDIF
      HEAINT(7) = WLASTS (IF)
      HEABUF (5) = WTBEG (IF)
      HEABUF (6) = WTEND (IF)
      IF (0.EQ.WHEAD (IF, HEABUF)) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WIFCL: Could not write file header'
         RETURN
      ENDIF
CC
CC    FLUSHING FILE
CC
      IF (0.NE.WFLUSH (IF)) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WIFCL: Could not flush file'
         RETURN
      ENDIF
CC    FREEING IF
CC
      WFLIST (IF) = 0
CC
CC    CLOSING UNIT POINTED BY IF
CC
      CLOSE (UNIT = WUNITS(IF), IOSTAT = IOS)
CC
CC    CHECK RETURN CODE
CC
      IF (IOS.NE.0) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::WIFCL: Not able to close unit ', 
     .          WUNITS(IF)
         RETURN
      ENDIF
CC
      WIFCL = 1
      RETURN
      END
 
 
 
 
      INTEGER FUNCTION WIFOP (UNIT, FNAME, TYPE, NVARS, 
     .                        DERIVS, HEASIZ, BLHSIZ, FRECL)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE WIFOP            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  OPENS A FILE TO STORE RESULT OF ODE INTEGRATION                   |
CC |  THE FILE WILL BE CREATED AS A DIRECT ACCESS FILE, WITH RECORD     |
CC |  LENGTH THE NECESSARY TO SAVE A POINT. OPTIMISATION IS LEFT FOR    |
CC |  THE FUTURE, OR THE THE OPERATING SYSTEM (BUFFERING...)            |
CC |  THE FILE WILL HAVE A HEADER, WITH PARAMETERS RELEVANT TO THE      |
CC |  WHOLE, AND BLOCKS CORRESPONDING TO DIFFERENT INTERVAL OF          |
CC |  INTEGRATION. EACH BLOCK WILL HAVE A BLOCK HEADER AND A SEQUENCE   |
CC |  OF RECORDS FOR EACH INTEGRATION POINT                             |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  UNIT(1/3)      I*4       UNIT TO WHERE FILE MUST BE OPENED.       |
CC |                           IF UNIT = 0 THEN UNIT IS EXPECTED TO BE  |
CC |                           A VECTOR OF 3 COMPONENTS. UNIT(2) AND    |
CC |                           UNIT(3) GIVE THEN A RANGE TO SEARCH FOR  |
CC |                           FOR POSSIBLE UNITS                       |
CC |  FNAME          C*132     NAME OF THE FILE TO BE CREATED.          |
CC |                           OVERWRITTEN IF EXISTS                    |
CC |  TYPE           I*4       INTEGER DEFINING TYPE OF FILE            |
CC |                           (1 ROSETTA ORBIT FILE)                   |
CC |  NVARS          I*4       NUMBER OF VARIABLES TO CONSIDER (3 FOR   |
CC |                           POSITION, 6 FOR STATE, 4 FOR QUATERNION  |
CC |  DERIVS         I*4       NON ZERO IF DERIVATIVES OF STATE ARE     |
CC |                           TO BE                                    |
CC |                           WRITTEN IN THE FILE (BETTER ACCURACY     |
CC |                           FOR INTERPOLATION LATER)                 |
CC |  HEASIZ         I*4       HEADER SIZE IN BYTES. THE ACTUAL SIZE OF |
CC |                           THE HEADER WILL BE ROUNDED TO COMPLETE   |
CC |                           RECORDS. AT LEAST 32 BYTES FOR THE       |
CC |                           MANDATORY PARAMETERS                     |
CC |  BLHSIZ         I*4       AS BEFORE, BUT APPLICABLE TO BLOCK       |
CC |                           HEADER                                   |
CC |  FRECL          I*4       REQUIRED LONGITUDE OF RECORD (AFFECTS    |
CC |                           PERFORMANCE)                             |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  RETURNS AN IDENTIFIER FOR THE FILE, TO BE USE IN SUBSEQUENT CALLS |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  wshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  GETUN, WHEAD                                                      |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.wifop.F	',
C     &'1.8	01/11/21 	OAD_IMSS\n'/
CC
      INTEGER TYPE, NVARS, DERIVS, HEASIZ, BLHSIZ, FRECL, UNIT(*)
CC    LOCAL VARIABLES
CC
      INTEGER UN, RECLON, IOS, I, INIT
      CHARACTER*132 FNAME
CC
CC    CALLING FUNCTIONS
CC
      INTEGER GETUN, WHEAD
CC
CC    UNAVOIDABLE INCLUDE FILE TO RESERVE ENOUGH MEMORY (FORTRAN)
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
CC
CC    IN THE NEXT INCLUDE, COMMON DATA IS STORED, AS OPEN I FILES, 
CC    THE RECORD LENGTHS ...
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS, WRITE...            |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR WRITE                                           |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  IFPARS:                                                           |
C |    WFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR WRITTING                                    |
C |    WUNITS   ARRAY WITH FILE UNITS                                  |
C |    WTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    WVARS    ARRAY WITH NUMBER OF VARS                              |
C |    NDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    WRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    WHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    WLREC    LAST RECORD WRITTEN                                    |
C |    WBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    WBTEND   FOR CURRENT BLOCK END TIME                             |
C |    WTBEG    FOR IFILE BLOCK START TIME                             |
C |    WTEND    FOR IFILE BLOCK END TIME                               |
C |    WCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    WCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    WCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    WCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C |  WBUF:   Parameters to buffer I/O                                  |
C |    WFBUF    BUFFER TO READ BIG RECORDS                             |
C |    WBUFFR   FIRST LOGICAL RECORD IN RECORD                         |
C |    WBUFLR   LAST LOGICAL RECORD IN RECORD. A REAL RECORD IS MADE   |
C |             OF SEVERAL LOGICAL RECORDS. A LOGICAL RECORD CONTAINS  |
C |             FOR EXAMPLE, A TIME, A STATE AND THE DERIVATIVES       |
C |             IN ORDER TO AVOID TO MUCH IO, THE PHISICAL RECORD IS   |
C |             MUCH HIGHER. I/O IS DONE TO BUFFER, AND ONLY TO FILE   |
C |             WHEN THE LOGICAL RECORDS GO BEYOND THE CONTENDS OF THE |
C |             BUFFER                                                 |
C |    WRCW     NUMBER OF RECORDS CURRENTLY WRITTEN                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.wshare.inc	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
C
      INTEGER MWFLS
      PARAMETER (MWFLS = 8)
      INTEGER WFLIST(MWFLS), WUNITS(MWFLS), WTYPES(MWFLS),
     .            WVARS(MWFLS), WDERS(MWFLS),
     .            WRECLS(MWFLS), WHSIZ(MWFLS), WBLHSI(MWFLS),
     .            WLASTS(MWFLS),
     .            WLREC(MWFLS),
     .            WCFR(MWFLS), WCLR(MWFLS), WCPB(MWFLS), 
     .            WCNB(MWFLS)

       DOUBLE PRECISION WBTBEG(MWFLS), WBTEND(MWFLS),WTBEG(MWFLS)
     .                 , WTEND(MWFLS)

      COMMON /WFPARS/ WFLIST, WUNITS, WTYPES, WVARS, WDERS, 
     .                WRECLS, WHSIZ, WBLHSI, WLASTS, WLREC,
     .                WBTBEG, WBTEND, WTBEG, WTEND,
     .                WCFR, WCLR, WCPB, WCNB
      INTEGER MAXFWR

C
C    SIZE OF FILE RECORD 
C

      PARAMETER (MAXFWR = 40000)
      DOUBLE PRECISION WFBUF(MAXFWR / 8, MWFLS)
      INTEGER WBUFFR(MWFLS), WBUFLR(MWFLS), WRCW(MWFLS), 
     .     WNLREC(MWFLS)
      COMMON /WBUF/ WFBUF, WBUFFR, WBUFLR, WRCW, WNLREC
      INTEGER HEAINT(MAXHEA/4)
      EQUIVALENCE (HEABUF, HEAINT)     
CC
CC    FIRST CALL
CC
      SAVE INIT

      DATA INIT /0/

      IF (INIT.EQ.0) THEN
         DO 5 I = 1, MWFLS
            WFLIST(I) = 0
 5       CONTINUE
         INIT = 1
      ENDIF
CC 
CC
      WIFOP = 0
CC 
CC
CC    FIRST TRY TO FIND A FREE UNIT BETWEEN 101, 200. THIS IS DONE LIKE
CC    THAT, TO AVOID COLLISION WITH OTHER UNITS (12 EPHEMERIS...)
CC    OF COURSE, THERE IS NO  GUARANTEE THAT THE USER OF THE FILE
CC    DOES NOT TRY TO USE THE UNIT FOR SOMETHING ELSE LATER
CC 
CC
      IF (UNIT(1).NE.0) THEN    
         UN = GETUN (UNIT(1), UNIT(1))
      ELSE 
         UN = GETUN (UNIT(2), UNIT(3))
      ENDIF
      IF (UN .EQ. 0) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::WIFOP: Not able to get a free unit'
         RETURN
      ENDIF
CC
CC    NOW TRY TO OPEN THE FILE IN UNIT, RECL IS COMPUTED FIRST.
CC
CC    SOME CONTROLS
CC
      IF (NVARS .LT. 1) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::WIFOP: Number of vars shall be > 0'
         RETURN
      ENDIF
      IF (HEASIZ .LT. 32) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::WIFOP: Header size must be >= 32'
         RETURN
      ENDIF

      RECLON = 1 + NVARS
      IF (DERIVS .NE. 0) THEN
         RECLON = RECLON + NVARS
      ENDIF
CC
CC    THE SIZE OF RECORD WILL BE AS IN PARAMETER FRECL. THE INDIVIDUAL
CC    POINTS WILL BE SPREAD IN THE RECORD.
CC
      RECLON = RECLON * 8
CC
CC    NON STANDARD FEATURE TO REMOVE FILE IF IT IS EXISTING

CC      CALL unlink (FNAME)
CC
CC  NECESSITY OF PREVIOUS LINE MUST BE CONFIRMED 
CC 
      OPEN (UNIT = UN, FILE = FNAME, ACCESS = 'DIRECT',
     .      RECL = FRECL, IOSTAT = IOS)

CC
CC    CHECK IF THE OPEN WAS DONE SUCCESFULLY
CC
      IF (IOS .NE. 0) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::WIFOP: Not able to open file IOS = ',
     .                IOS
         RETURN
      ENDIF
CC
CC    CHECK IF THERE IS AN IFILE FREE
CC
      WIFOP = 0
      DO 20 I = MWFLS, 1, -1
         IF (WFLIST(I).EQ.0) WIFOP = I
 20   CONTINUE
      IF (WIFOP .EQ. 0) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::WIFOP: No IFILE free'
         CLOSE (UN)
         RETURN
      ENDIF
CC
CC    SET PARAMETERS OF FILE AND PREPARE HEADER BUFFER
CC
      WFLIST (WIFOP) = 1
      WUNITS (WIFOP) = UN

      HEAINT(1) = FRECL
      WRECLS (WIFOP) = RECLON
      WVARS (WIFOP) = NVARS
      HEAINT(2) = NVARS
      IF (DERIVS.EQ.0) THEN
         HEAINT(3) = 0
      ELSE
         HEAINT(3) = 1
      ENDIF
      WDERS (WIFOP) = HEAINT(3)
      WTYPES (WIFOP) = TYPE
      HEAINT(4) = TYPE
      IF (0.EQ.MOD (HEASIZ, RECLON)) THEN
         WHSIZ (WIFOP) =  HEASIZ / RECLON
      ELSE
         WHSIZ (WIFOP) = HEASIZ / RECLON + 1
      ENDIF
      HEAINT(5) = HEASIZ
      IF (0.EQ.MOD (BLHSIZ, RECLON)) THEN
         WBLHSI (WIFOP) = BLHSIZ / RECLON
      ELSE
         WBLHSI (WIFOP) = BLHSIZ / RECLON + 1
      ENDIF
      HEAINT(6) = BLHSIZ
      WLASTS (WIFOP) = 0
      HEAINT(7) = 0
CC
CC    NO RECORD WRITTEN
CC
      WLREC (WIFOP) = WHSIZ(WIFOP)
CC
CC    SET SOMETHING ON THE TIMES
CC
      WTBEG (WIFOP) = 0.D0
      HEABUF (5) = 0.D0
      HEABUF (6) = 0.D0
      WTEND (WIFOP) = 0.D0
      WBTBEG (WIFOP) = 0.D0
      WBTEND (WIFOP) = 0.D0
CC
CC    CONTROL PARAMETERS FOR BUFFERING
CC
      
      WRCW(WIFOP) = 0
      WBUFFR(WIFOP) = 0
      WBUFLR(WIFOP) = 0
      WNLREC(WIFOP) = FRECL / RECLON
CC
CC  NOW WRITE THE HEADER
CC
      IF (0.EQ.WHEAD (WIFOP, HEABUF)) THEN
         IF (PR.GT.0) WRITE (0, *) 
     .   'ERROR::WIFOP: Could not write header'
         CLOSE (UN)
         WFLIST(WIFOP) = 0
         WIFOP = 0
         RETURN
      ENDIF
      RETURN
      END
 
 
 
 
      INTEGER FUNCTION WOREC (IF, LREC, BUFFER)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE WOREC                       |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  WRITES A LOGICAL RECORD TO FILE (OR BUFFER)                       |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF       I*4    INTERPOLATION FILE NUMBER                         |
CC |  LREC     I*4    LOGICAL RECORD TO WRITE                           |
CC |  BUFFER() R*8    BUFFER CONTAINING HEADER                          |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  RETURNS 0 IN SUCCESS                                              |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  wshare.inc dimensions.inc                                         |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  IMPLICIT FUNCTIONS ONLY                                           |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/16 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.wiorec.F	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF, LREC
CC
CC   LOCAL VARIABLES
CC
      INTEGER I, J, K, NREC, IOS
CC
CC    INCLUDING
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS, WRITE...            |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR WRITE                                           |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  IFPARS:                                                           |
C |    WFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR WRITTING                                    |
C |    WUNITS   ARRAY WITH FILE UNITS                                  |
C |    WTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    WVARS    ARRAY WITH NUMBER OF VARS                              |
C |    NDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    WRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    WHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    WLREC    LAST RECORD WRITTEN                                    |
C |    WBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    WBTEND   FOR CURRENT BLOCK END TIME                             |
C |    WTBEG    FOR IFILE BLOCK START TIME                             |
C |    WTEND    FOR IFILE BLOCK END TIME                               |
C |    WCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    WCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    WCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    WCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C |  WBUF:   Parameters to buffer I/O                                  |
C |    WFBUF    BUFFER TO READ BIG RECORDS                             |
C |    WBUFFR   FIRST LOGICAL RECORD IN RECORD                         |
C |    WBUFLR   LAST LOGICAL RECORD IN RECORD. A REAL RECORD IS MADE   |
C |             OF SEVERAL LOGICAL RECORDS. A LOGICAL RECORD CONTAINS  |
C |             FOR EXAMPLE, A TIME, A STATE AND THE DERIVATIVES       |
C |             IN ORDER TO AVOID TO MUCH IO, THE PHISICAL RECORD IS   |
C |             MUCH HIGHER. I/O IS DONE TO BUFFER, AND ONLY TO FILE   |
C |             WHEN THE LOGICAL RECORDS GO BEYOND THE CONTENDS OF THE |
C |             BUFFER                                                 |
C |    WRCW     NUMBER OF RECORDS CURRENTLY WRITTEN                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.wshare.inc	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
C
      INTEGER MWFLS
      PARAMETER (MWFLS = 8)
      INTEGER WFLIST(MWFLS), WUNITS(MWFLS), WTYPES(MWFLS),
     .            WVARS(MWFLS), WDERS(MWFLS),
     .            WRECLS(MWFLS), WHSIZ(MWFLS), WBLHSI(MWFLS),
     .            WLASTS(MWFLS),
     .            WLREC(MWFLS),
     .            WCFR(MWFLS), WCLR(MWFLS), WCPB(MWFLS), 
     .            WCNB(MWFLS)

       DOUBLE PRECISION WBTBEG(MWFLS), WBTEND(MWFLS),WTBEG(MWFLS)
     .                 , WTEND(MWFLS)

      COMMON /WFPARS/ WFLIST, WUNITS, WTYPES, WVARS, WDERS, 
     .                WRECLS, WHSIZ, WBLHSI, WLASTS, WLREC,
     .                WBTBEG, WBTEND, WTBEG, WTEND,
     .                WCFR, WCLR, WCPB, WCNB
      INTEGER MAXFWR

C
C    SIZE OF FILE RECORD 
C

      PARAMETER (MAXFWR = 40000)
      DOUBLE PRECISION WFBUF(MAXFWR / 8, MWFLS)
      INTEGER WBUFFR(MWFLS), WBUFLR(MWFLS), WRCW(MWFLS), 
     .     WNLREC(MWFLS)
      COMMON /WBUF/ WFBUF, WBUFFR, WBUFLR, WRCW, WNLREC
CC
      DOUBLE PRECISION BUFFER(1)
      WOREC = 0
      IF (LREC.LT.WBUFFR(IF).OR.LREC.GT.WBUFLR(IF)) THEN
CC
CC    WRITE PREVIOUS RECORD
CC
         IF (WBUFFR(IF).NE.0) THEN
            NREC = 1 + (WBUFFR(IF)-1) / WNLREC(IF)
            WRITE (UNIT = WUNITS(IF), IOSTAT = IOS, REC = NREC) 
     .      (WFBUF (K, IF), K=1, WNLREC(IF)* WRECLS(IF)/8)
            IF (IOS.NE.0) THEN
               IF (PR.GT.0) WRITE (0,*) 
     .         'ERROR::WOREC: Error writing record'
               WOREC = IOS
               RETURN
            ENDIF
         ENDIF
CC
CC    READ CURRENT RECORD
CC
         NREC = (LREC-1) / WNLREC(IF) + 1
         IF (WRCW(IF) .GE. NREC) THEN
            READ (UNIT = WUNITS(IF), IOSTAT = IOS, REC = NREC) 
     .      (WFBUF (K, IF), K=1, WNLREC(IF)* WRECLS(IF)/8)
            IF (IOS.NE.0) THEN
               IF (PR.GT.0) WRITE (0,*) 
     .         'ERROR::WOREC: Error reading record'
               WOREC = IOS
               RETURN
            ENDIF
         ENDIF
         WRCW(IF) = MAX (WRCW(IF), NREC)
         WBUFFR(IF) = (NREC - 1) * WNLREC(IF) + 1
         WBUFLR(IF) = WBUFFR(IF) + WNLREC(IF) - 1
      ENDIF
CC
CC    WRITE TO BUFFER
CC
      J = 1 + (LREC - WBUFFR(IF))* WRECLS(IF) / 8
      DO 10 I = 1, WRECLS(IF)/8
         WFBUF (J, IF) = BUFFER (I)
         J = J + 1
 10   CONTINUE
      WOREC = 0
      RETURN
      END
         
      
      INTEGER FUNCTION WIREC (IF, LREC, BUFFER)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE WIREC                       |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  READS A LOGICAL RECORD TO FILE (OR BUFFER)                        |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF       I*4    INTERPOLATION FILE NUMBER                         |
CC |  LREC     I*4    LOGICAL RECORD TO WRITE                           |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  BUFFER() R*8    BUFFER CONTAINING HEADER                          |
CC |  RETURNS 0                                                         |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  wshare.inc dimensions.inc                                         |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  IMPLICIT FUNCTIONS ONLY                                           |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/16 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
      INTEGER IF, LREC
CC
CC   LOCAL VARIABLES
CC
      INTEGER I, J, K, NREC, IOS
CC
CC    INCLUDING
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS, WRITE...            |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR WRITE                                           |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  IFPARS:                                                           |
C |    WFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR WRITTING                                    |
C |    WUNITS   ARRAY WITH FILE UNITS                                  |
C |    WTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    WVARS    ARRAY WITH NUMBER OF VARS                              |
C |    NDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    WRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    WHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    WLREC    LAST RECORD WRITTEN                                    |
C |    WBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    WBTEND   FOR CURRENT BLOCK END TIME                             |
C |    WTBEG    FOR IFILE BLOCK START TIME                             |
C |    WTEND    FOR IFILE BLOCK END TIME                               |
C |    WCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    WCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    WCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    WCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C |  WBUF:   Parameters to buffer I/O                                  |
C |    WFBUF    BUFFER TO READ BIG RECORDS                             |
C |    WBUFFR   FIRST LOGICAL RECORD IN RECORD                         |
C |    WBUFLR   LAST LOGICAL RECORD IN RECORD. A REAL RECORD IS MADE   |
C |             OF SEVERAL LOGICAL RECORDS. A LOGICAL RECORD CONTAINS  |
C |             FOR EXAMPLE, A TIME, A STATE AND THE DERIVATIVES       |
C |             IN ORDER TO AVOID TO MUCH IO, THE PHISICAL RECORD IS   |
C |             MUCH HIGHER. I/O IS DONE TO BUFFER, AND ONLY TO FILE   |
C |             WHEN THE LOGICAL RECORDS GO BEYOND THE CONTENDS OF THE |
C |             BUFFER                                                 |
C |    WRCW     NUMBER OF RECORDS CURRENTLY WRITTEN                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.wshare.inc	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
C
      INTEGER MWFLS
      PARAMETER (MWFLS = 8)
      INTEGER WFLIST(MWFLS), WUNITS(MWFLS), WTYPES(MWFLS),
     .            WVARS(MWFLS), WDERS(MWFLS),
     .            WRECLS(MWFLS), WHSIZ(MWFLS), WBLHSI(MWFLS),
     .            WLASTS(MWFLS),
     .            WLREC(MWFLS),
     .            WCFR(MWFLS), WCLR(MWFLS), WCPB(MWFLS), 
     .            WCNB(MWFLS)

       DOUBLE PRECISION WBTBEG(MWFLS), WBTEND(MWFLS),WTBEG(MWFLS)
     .                 , WTEND(MWFLS)

      COMMON /WFPARS/ WFLIST, WUNITS, WTYPES, WVARS, WDERS, 
     .                WRECLS, WHSIZ, WBLHSI, WLASTS, WLREC,
     .                WBTBEG, WBTEND, WTBEG, WTEND,
     .                WCFR, WCLR, WCPB, WCNB
      INTEGER MAXFWR

C
C    SIZE OF FILE RECORD 
C

      PARAMETER (MAXFWR = 40000)
      DOUBLE PRECISION WFBUF(MAXFWR / 8, MWFLS)
      INTEGER WBUFFR(MWFLS), WBUFLR(MWFLS), WRCW(MWFLS), 
     .     WNLREC(MWFLS)
      COMMON /WBUF/ WFBUF, WBUFFR, WBUFLR, WRCW, WNLREC
CC
      DOUBLE PRECISION BUFFER(1)
      WIREC = 0
      IF (LREC.LT.WBUFFR(IF).OR.LREC.GT.WBUFLR(IF)) THEN
CC
CC    WRITE PREVIOUS RECORD
CC
         IF (WBUFFR(IF).NE.0) THEN
            NREC = 1 + (WBUFFR(IF)-1) / WNLREC(IF)
            WRITE (UNIT = WUNITS(IF), IOSTAT = IOS, REC = NREC) 
     .      (WFBUF (K, IF), K=1, WNLREC(IF)* WRECLS(IF)/8)
            IF (IOS.NE.0) THEN
               IF (PR.GT.0) WRITE (0,*) 
     .         'ERROR::WIREC: Error writing record'
               WIREC = IOS
               RETURN
            ENDIF
         ENDIF
CC
CC    READ CURRENT RECORD
CC
         NREC = (LREC-1) / WNLREC(IF) + 1
         IF (WRCW(IF) .GE. NREC) THEN
            READ (UNIT = WUNITS(IF), IOSTAT = IOS, REC = NREC) 
     .      (WFBUF (K, IF), K=1, WNLREC(IF)* WRECLS(IF)/8)
            IF (IOS.NE.0) THEN
               IF (PR.GT.0) WRITE (0,*) 
     .         'ERROR::WIREC: Error reading record'
               WIREC = IOS
               RETURN
            ENDIF
         ENDIF
         WRCW(IF) = MAX (WRCW(IF), NREC)
         WBUFFR(IF) = (NREC - 1) * WNLREC(IF) + 1
         WBUFLR(IF) = WBUFFR(IF) + WNLREC(IF) - 1
      ENDIF
CC
CC    READ FROM BUFFER
CC
      J = 1 + (LREC - WBUFFR(IF))* WRECLS(IF) / 8
      DO 10 I = 1, WRECLS(IF)/8
         BUFFER (I) = WFBUF (J, IF)
         J = J + 1
 10   CONTINUE
      WIREC = 0
      RETURN
      END
         
               
      
      INTEGER FUNCTION WFLUSH (IF)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE WFLUSH                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  Writes buffer to filew                                            |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF       I*4    INTERPOLATION FILE NUMBER                         |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  RETURNS 0 IN SUCCESS                                              |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  wshare.inc dimensions.inc                                         |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  IMPLICIT FUNCTIONS ONLY                                           |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/16 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
      INTEGER IF
CC
CC   LOCAL VARIABLES
CC
      INTEGER NREC, IOS, K
CC
CC    INCLUDING
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS, WRITE...            |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR WRITE                                           |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  IFPARS:                                                           |
C |    WFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR WRITTING                                    |
C |    WUNITS   ARRAY WITH FILE UNITS                                  |
C |    WTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    WVARS    ARRAY WITH NUMBER OF VARS                              |
C |    NDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    WRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    WHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    WLREC    LAST RECORD WRITTEN                                    |
C |    WBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    WBTEND   FOR CURRENT BLOCK END TIME                             |
C |    WTBEG    FOR IFILE BLOCK START TIME                             |
C |    WTEND    FOR IFILE BLOCK END TIME                               |
C |    WCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    WCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    WCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    WCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C |  WBUF:   Parameters to buffer I/O                                  |
C |    WFBUF    BUFFER TO READ BIG RECORDS                             |
C |    WBUFFR   FIRST LOGICAL RECORD IN RECORD                         |
C |    WBUFLR   LAST LOGICAL RECORD IN RECORD. A REAL RECORD IS MADE   |
C |             OF SEVERAL LOGICAL RECORDS. A LOGICAL RECORD CONTAINS  |
C |             FOR EXAMPLE, A TIME, A STATE AND THE DERIVATIVES       |
C |             IN ORDER TO AVOID TO MUCH IO, THE PHISICAL RECORD IS   |
C |             MUCH HIGHER. I/O IS DONE TO BUFFER, AND ONLY TO FILE   |
C |             WHEN THE LOGICAL RECORDS GO BEYOND THE CONTENDS OF THE |
C |             BUFFER                                                 |
C |    WRCW     NUMBER OF RECORDS CURRENTLY WRITTEN                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.wshare.inc	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
C
      INTEGER MWFLS
      PARAMETER (MWFLS = 8)
      INTEGER WFLIST(MWFLS), WUNITS(MWFLS), WTYPES(MWFLS),
     .            WVARS(MWFLS), WDERS(MWFLS),
     .            WRECLS(MWFLS), WHSIZ(MWFLS), WBLHSI(MWFLS),
     .            WLASTS(MWFLS),
     .            WLREC(MWFLS),
     .            WCFR(MWFLS), WCLR(MWFLS), WCPB(MWFLS), 
     .            WCNB(MWFLS)

       DOUBLE PRECISION WBTBEG(MWFLS), WBTEND(MWFLS),WTBEG(MWFLS)
     .                 , WTEND(MWFLS)

      COMMON /WFPARS/ WFLIST, WUNITS, WTYPES, WVARS, WDERS, 
     .                WRECLS, WHSIZ, WBLHSI, WLASTS, WLREC,
     .                WBTBEG, WBTEND, WTBEG, WTEND,
     .                WCFR, WCLR, WCPB, WCNB
      INTEGER MAXFWR

C
C    SIZE OF FILE RECORD 
C

      PARAMETER (MAXFWR = 40000)
      DOUBLE PRECISION WFBUF(MAXFWR / 8, MWFLS)
      INTEGER WBUFFR(MWFLS), WBUFLR(MWFLS), WRCW(MWFLS), 
     .     WNLREC(MWFLS)
      COMMON /WBUF/ WFBUF, WBUFFR, WBUFLR, WRCW, WNLREC
CC
      WFLUSH = 0
CC
CC    WRITE RECORD
CC
      IF (WBUFFR(IF).NE.0) THEN
         NREC = 1 + (WBUFFR(IF)-1) / WNLREC(IF)
         WRITE (UNIT = WUNITS(IF), IOSTAT = IOS, REC = NREC) 
     .   (WFBUF (K, IF), K=1, WNLREC(IF)* WRECLS(IF)/8)
         IF (IOS.NE.0) THEN
            IF (PR.GT.0) WRITE (0,*) 
     .      'ERROR::WFLUSH: Error writing record'
            WFLUSH = IOS
            RETURN
         ENDIF
      ENDIF
      WFLUSH = 0
      RETURN
      END

 
 
 
 
      INTEGER FUNCTION WMODBL (IF, BUF, POS, LENGTH)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE WMODBL                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  WRITES THE BLOCK HEADER BUFFER INTO AN IFILE                      |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF INTERPOLATION FILE NUMBER                                      |
CC |  BUFF(*)    I*4 BUFFER CONTAINING DATA TO PUT IN HEADER            |
CC |  POS        I*4 POSITION TO INSERT DATA MUST BE 4* BYTES. IF POS   |
CC |                 IS 20, THE DATA IS GOING TO BE WRITEN STARTING     |
CC |                 AT BYTE 81. POS MUST BE > 9, BECAUSE THE FIRST     |
CC |                 WORTDS ARE PROTECTED                               |
CC |  LENGTH     I*4 NUMBER OF 4BYTE WORDS TO BE COPIED                 |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  RETURNS 1 IN SUCCESS 0 IN ERROR                                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  wshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WGBLHE, WBLHEA                                                    |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/07 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC

CC
C      CHARACTER*68 SCCS_INFO(2)
C      DATA SCCS_INFO
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.wmodbl.F	',
C     &'1.2	01/11/09 	IMSS_FDD\n'/
CC
      INTEGER IF, BUF(1), POS, LENGTH
CC
CC    LOCAL VARIABLES
CC
      INTEGER I
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS, WRITE...            |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR WRITE                                           |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  IFPARS:                                                           |
C |    WFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR WRITTING                                    |
C |    WUNITS   ARRAY WITH FILE UNITS                                  |
C |    WTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    WVARS    ARRAY WITH NUMBER OF VARS                              |
C |    NDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    WRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    WHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    WLREC    LAST RECORD WRITTEN                                    |
C |    WBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    WBTEND   FOR CURRENT BLOCK END TIME                             |
C |    WTBEG    FOR IFILE BLOCK START TIME                             |
C |    WTEND    FOR IFILE BLOCK END TIME                               |
C |    WCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    WCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    WCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    WCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C |  WBUF:   Parameters to buffer I/O                                  |
C |    WFBUF    BUFFER TO READ BIG RECORDS                             |
C |    WBUFFR   FIRST LOGICAL RECORD IN RECORD                         |
C |    WBUFLR   LAST LOGICAL RECORD IN RECORD. A REAL RECORD IS MADE   |
C |             OF SEVERAL LOGICAL RECORDS. A LOGICAL RECORD CONTAINS  |
C |             FOR EXAMPLE, A TIME, A STATE AND THE DERIVATIVES       |
C |             IN ORDER TO AVOID TO MUCH IO, THE PHISICAL RECORD IS   |
C |             MUCH HIGHER. I/O IS DONE TO BUFFER, AND ONLY TO FILE   |
C |             WHEN THE LOGICAL RECORDS GO BEYOND THE CONTENDS OF THE |
C |             BUFFER                                                 |
C |    WRCW     NUMBER OF RECORDS CURRENTLY WRITTEN                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.wshare.inc	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
C
      INTEGER MWFLS
      PARAMETER (MWFLS = 8)
      INTEGER WFLIST(MWFLS), WUNITS(MWFLS), WTYPES(MWFLS),
     .            WVARS(MWFLS), WDERS(MWFLS),
     .            WRECLS(MWFLS), WHSIZ(MWFLS), WBLHSI(MWFLS),
     .            WLASTS(MWFLS),
     .            WLREC(MWFLS),
     .            WCFR(MWFLS), WCLR(MWFLS), WCPB(MWFLS), 
     .            WCNB(MWFLS)

       DOUBLE PRECISION WBTBEG(MWFLS), WBTEND(MWFLS),WTBEG(MWFLS)
     .                 , WTEND(MWFLS)

      COMMON /WFPARS/ WFLIST, WUNITS, WTYPES, WVARS, WDERS, 
     .                WRECLS, WHSIZ, WBLHSI, WLASTS, WLREC,
     .                WBTBEG, WBTEND, WTBEG, WTEND,
     .                WCFR, WCLR, WCPB, WCNB
      INTEGER MAXFWR

C
C    SIZE OF FILE RECORD 
C

      PARAMETER (MAXFWR = 40000)
      DOUBLE PRECISION WFBUF(MAXFWR / 8, MWFLS)
      INTEGER WBUFFR(MWFLS), WBUFLR(MWFLS), WRCW(MWFLS), 
     .     WNLREC(MWFLS)
      COMMON /WBUF/ WFBUF, WBUFFR, WBUFLR, WRCW, WNLREC
CC
      INTEGER BLHEI (MAXBLK/4)
      EQUIVALENCE (BLHE, BLHEI)
CC
CC    CALLING
CC
      INTEGER WGBLHE, WBLHEA
CC
      WMODBL = 0
      IF (IF.LT.1.OR.IF.GT.MWFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WMODBL: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (WFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WMODBL: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (POS.LT.9) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WMODBL: words from 1 to 8 are protected'
         RETURN
      ENDIF
      IF (LENGTH.LT.1) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WMODBL: Number of words ', LENGTH,
     .    'is to small'
         RETURN
      ENDIF
      IF (POS + LENGTH -1.GT.WRECLS(IF) * WHSIZ(IF) / 4) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WMODBL: Cannot write so many words  ', LENGTH
         RETURN
      ENDIF
      IF (WLASTS(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WGETBL: Tere is no block yet'
         RETURN
      ENDIF
CC
CC    RETRIEVE THE CURRENT HEADER
CC
CC
CC    RETRIEVE THE CURRENT HEADER
CC
      IF (0.EQ.WGBLHE (IF, BLHE, WLASTS(IF))) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WGETBL: Could not read block header'
         RETURN
      ENDIF
CC
CC    COPY THE RELEVANT PARAMETERS
CC
      DO 10 I = POS, POS + LENGTH -1
         BLHEI (I) = BUF(I - POS + 1)
 10   CONTINUE
      IF (0.EQ.WBLHEA (IF, BLHE, WLASTS(IF))) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WMODBL: Could not write block header'
         RETURN
      ENDIF
      WMODBL = 1
      RETURN
      END


 
 
 
 
      INTEGER FUNCTION WMODHE (IF, BUF, POS, LENGTH)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE WMODHE                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  WRITES THE HEADER BUFFER INTO AN IFILE                            |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF INTERPOLATION FILE NUMBER                                      |
CC |  BUFF(*)    I*4 BUFFER CONTAINING DATA TO PUT IN HEADER            |
CC |  POS        I*4 POSITION TO INSERT DATA MUST BE 4* BYTES. IF POS   |
CC |                 IS 20, THE DATA IS GOING TO BE WRITEN STARTING     |
CC |                 AT BYTE 81. POS MUST BE > 12, BECAUSE THE FIRST    |
CC |                 WORTDS ARE PROTECTED                               |
CC |  LENGTH     I*4 NUMBER OF 4BYTE WORDS TO BE COPIED                 |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  RETURNS 1 IN SUCCESS 0 IN ERROR                                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  wshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  IMPLICIT FUNCTIONS ONLY                                           |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/07 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.wmodhe.F	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF, BUF(1), POS, LENGTH
CC
CC    LOCAL VARIABLES
CC
      INTEGER I
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS, WRITE...            |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR WRITE                                           |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  IFPARS:                                                           |
C |    WFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR WRITTING                                    |
C |    WUNITS   ARRAY WITH FILE UNITS                                  |
C |    WTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    WVARS    ARRAY WITH NUMBER OF VARS                              |
C |    NDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    WRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    WHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    WLREC    LAST RECORD WRITTEN                                    |
C |    WBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    WBTEND   FOR CURRENT BLOCK END TIME                             |
C |    WTBEG    FOR IFILE BLOCK START TIME                             |
C |    WTEND    FOR IFILE BLOCK END TIME                               |
C |    WCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    WCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    WCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    WCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C |  WBUF:   Parameters to buffer I/O                                  |
C |    WFBUF    BUFFER TO READ BIG RECORDS                             |
C |    WBUFFR   FIRST LOGICAL RECORD IN RECORD                         |
C |    WBUFLR   LAST LOGICAL RECORD IN RECORD. A REAL RECORD IS MADE   |
C |             OF SEVERAL LOGICAL RECORDS. A LOGICAL RECORD CONTAINS  |
C |             FOR EXAMPLE, A TIME, A STATE AND THE DERIVATIVES       |
C |             IN ORDER TO AVOID TO MUCH IO, THE PHISICAL RECORD IS   |
C |             MUCH HIGHER. I/O IS DONE TO BUFFER, AND ONLY TO FILE   |
C |             WHEN THE LOGICAL RECORDS GO BEYOND THE CONTENDS OF THE |
C |             BUFFER                                                 |
C |    WRCW     NUMBER OF RECORDS CURRENTLY WRITTEN                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.wshare.inc	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
C
      INTEGER MWFLS
      PARAMETER (MWFLS = 8)
      INTEGER WFLIST(MWFLS), WUNITS(MWFLS), WTYPES(MWFLS),
     .            WVARS(MWFLS), WDERS(MWFLS),
     .            WRECLS(MWFLS), WHSIZ(MWFLS), WBLHSI(MWFLS),
     .            WLASTS(MWFLS),
     .            WLREC(MWFLS),
     .            WCFR(MWFLS), WCLR(MWFLS), WCPB(MWFLS), 
     .            WCNB(MWFLS)

       DOUBLE PRECISION WBTBEG(MWFLS), WBTEND(MWFLS),WTBEG(MWFLS)
     .                 , WTEND(MWFLS)

      COMMON /WFPARS/ WFLIST, WUNITS, WTYPES, WVARS, WDERS, 
     .                WRECLS, WHSIZ, WBLHSI, WLASTS, WLREC,
     .                WBTBEG, WBTEND, WTBEG, WTEND,
     .                WCFR, WCLR, WCPB, WCNB
      INTEGER MAXFWR

C
C    SIZE OF FILE RECORD 
C

      PARAMETER (MAXFWR = 40000)
      DOUBLE PRECISION WFBUF(MAXFWR / 8, MWFLS)
      INTEGER WBUFFR(MWFLS), WBUFLR(MWFLS), WRCW(MWFLS), 
     .     WNLREC(MWFLS)
      COMMON /WBUF/ WFBUF, WBUFFR, WBUFLR, WRCW, WNLREC
CC
      INTEGER HEAINT(MAXHEA/4)
      EQUIVALENCE (HEABUF, HEAINT)
CC
CC    CALLING
CC
      INTEGER WGHEAD, WHEAD
CC
      WMODHE = 0
      IF (IF.LT.1.OR.IF.GT.MWFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WMODHE: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (WFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WMODHE: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (POS.LT.13) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WMODHE: words from 1 to 12 are protected'
         RETURN
      ENDIF
      IF (LENGTH.LT.1) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WMODHE: Number of words ', LENGTH,
     .    'is to small'
         RETURN
      ENDIF
      IF (POS + LENGTH -1.GT.WRECLS(IF) * WHSIZ(IF) / 4) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WMODHE: Cannot write so many words  ', LENGTH
         RETURN
      ENDIF
CC
CC    RETRIEVE THE CURRENT HEADER
CC
      IF (0.EQ.WGHEAD (IF, HEABUF)) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WMODHE: Could not read file header'
         RETURN
      ENDIF
CC
CC    UPDATE THE RELEVANT PARAMETERS
CC
      DO 10 I = POS, POS + LENGTH -1
         HEAINT (I) = BUF(I - POS + 1)
 10   CONTINUE
      IF (0.EQ.WHEAD (IF, HEABUF)) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WMODHE: Could not write file header'
         RETURN
      ENDIF
      WMODHE = 1
      RETURN
      END


 
 
 
 
      INTEGER FUNCTION WNWBLK (IF)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE WNWBLK                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  CREATES A NEW BLOCK ON AN INTERPOLATION FILE. IT ONLY FILLS THE   |
CC |  ESSENTIAL PART OF THE HEADER                                      |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER AS RETURNED BY WIFOP          |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  RETURNS ONE IF SUCCESS 0 IF FAILED                                |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  wshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WGBLHE, WBLHEA                                                    |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/08 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.wnwblk.F	',
C     &'1.6	01/11/09 	OAD_IMSS\n'/
CC
      INTEGER IF
CC
CC    LOCAL VARIABLES
CC
CC    TWO BUFFERS TO STORE HEADER OF NEW AND LAST BLOCK
CC
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS, WRITE...            |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR WRITE                                           |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  IFPARS:                                                           |
C |    WFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR WRITTING                                    |
C |    WUNITS   ARRAY WITH FILE UNITS                                  |
C |    WTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    WVARS    ARRAY WITH NUMBER OF VARS                              |
C |    NDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    WRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    WHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    WLREC    LAST RECORD WRITTEN                                    |
C |    WBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    WBTEND   FOR CURRENT BLOCK END TIME                             |
C |    WTBEG    FOR IFILE BLOCK START TIME                             |
C |    WTEND    FOR IFILE BLOCK END TIME                               |
C |    WCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    WCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    WCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    WCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C |  WBUF:   Parameters to buffer I/O                                  |
C |    WFBUF    BUFFER TO READ BIG RECORDS                             |
C |    WBUFFR   FIRST LOGICAL RECORD IN RECORD                         |
C |    WBUFLR   LAST LOGICAL RECORD IN RECORD. A REAL RECORD IS MADE   |
C |             OF SEVERAL LOGICAL RECORDS. A LOGICAL RECORD CONTAINS  |
C |             FOR EXAMPLE, A TIME, A STATE AND THE DERIVATIVES       |
C |             IN ORDER TO AVOID TO MUCH IO, THE PHISICAL RECORD IS   |
C |             MUCH HIGHER. I/O IS DONE TO BUFFER, AND ONLY TO FILE   |
C |             WHEN THE LOGICAL RECORDS GO BEYOND THE CONTENDS OF THE |
C |             BUFFER                                                 |
C |    WRCW     NUMBER OF RECORDS CURRENTLY WRITTEN                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.wshare.inc	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
C
      INTEGER MWFLS
      PARAMETER (MWFLS = 8)
      INTEGER WFLIST(MWFLS), WUNITS(MWFLS), WTYPES(MWFLS),
     .            WVARS(MWFLS), WDERS(MWFLS),
     .            WRECLS(MWFLS), WHSIZ(MWFLS), WBLHSI(MWFLS),
     .            WLASTS(MWFLS),
     .            WLREC(MWFLS),
     .            WCFR(MWFLS), WCLR(MWFLS), WCPB(MWFLS), 
     .            WCNB(MWFLS)

       DOUBLE PRECISION WBTBEG(MWFLS), WBTEND(MWFLS),WTBEG(MWFLS)
     .                 , WTEND(MWFLS)

      COMMON /WFPARS/ WFLIST, WUNITS, WTYPES, WVARS, WDERS, 
     .                WRECLS, WHSIZ, WBLHSI, WLASTS, WLREC,
     .                WBTBEG, WBTEND, WTBEG, WTEND,
     .                WCFR, WCLR, WCPB, WCNB
      INTEGER MAXFWR

C
C    SIZE OF FILE RECORD 
C

      PARAMETER (MAXFWR = 40000)
      DOUBLE PRECISION WFBUF(MAXFWR / 8, MWFLS)
      INTEGER WBUFFR(MWFLS), WBUFLR(MWFLS), WRCW(MWFLS), 
     .     WNLREC(MWFLS)
      COMMON /WBUF/ WFBUF, WBUFFR, WBUFLR, WRCW, WNLREC
      INTEGER BLHEI (MAXBLK/4)
      EQUIVALENCE (BLHE, BLHEI)
CC
CC    CALLED FUNTIONS
CC
      INTEGER WGBLHE, WBLHEA
      WNWBLK = 0
      IF (IF.LT.1.OR.IF.GT.MWFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WNWBLK: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (WFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WNWBLK: Invalid identifier IF = ', IF
         RETURN
      ENDIF
CC
CC    IS THERE A BLOCK CURRENTLY OPEN? IF SO, CLOSE IT
CC
      IF (WLASTS(IF).NE.0) THEN
         IF (0.EQ.WGBLHE (IF, BLHE, WLASTS(IF))) THEN
            IF (PR.GT.0) WRITE (0,*) 
     .      'ERROR::WNWBLK: Could not read previous record'
            RETURN
         ENDIF
CC
CC    IF NO RECORD HAS BEEN WRITTEN IN LAST BLOCK, THEN 
CC    LAST BLOCK IS SIMPLY OVERWRITTEN. A WARNING APPEARS
CC    BUT FUNCTION RETURNS 1
CC
         IF (WCLR (IF).EQ.0) THEN
            IF (PR.GT.0) WRITE (0,*) 
     .           'WARNING::WNWBLK: Nothing to store in last block'
            IF (PR.GT.0) WRITE (0,*)
     .           '                 Last block will be scratch'
            WNWBLK = 1
            RETURN
         ENDIF
CC
CC    SET LAST RECORD AND NEXT BLOCK IN HEADER
CC
         BLHEI (2) = WCLR (IF)
         BLHEI (4) = WLREC (IF) + 1
CC
CC    SET FIRST TIME AND LAST TIME IN HEADER
CC
         BLHE (3) = WBTBEG (IF)
         BLHE (4) = WBTEND (IF)
CC
CC    WRITE THE HEADER OF THE LAST BLOCK
CC
         IF (0.EQ.WBLHEA (IF, BLHE, WLASTS(IF))) THEN
            IF (PR.GT.0) WRITE (0,*) 
     .      'ERROR::WNWBLK: Could not write previous record'
            RETURN
         ENDIF
         WCPB (IF) = WLASTS (IF)
         IF (WLREC (IF).GE.WCFR (IF)) THEN
CC
CC    SET THE GLOBAL START AND END TIME, IF FIRST RECORD WRITTEN
CC
            IF ((WLASTS (IF) .EQ. WHSIZ(IF) + 1)) THEN
               IF (WBTBEG (IF) .LT. WBTEND (IF)) THEN
                  WTBEG (IF) = WBTBEG (IF)
                  WTEND (IF) = WBTEND (IF)
               ELSE
                  WTEND (IF) = WBTBEG (IF)
                  WTBEG (IF) = WBTEND (IF)
               ENDIF
            ELSE
               IF (WBTEND (IF) .GT. WTEND (IF))
     .            WTEND (IF) = WBTEND (IF)
               IF (WBTBEG (IF) .GT. WTEND (IF))
     .            WTEND (IF) = WBTBEG (IF)
               IF (WBTEND (IF) .LT. WTBEG (IF))
     .            WTBEG (IF) = WBTEND (IF)
               IF (WBTBEG (IF) .LT. WTBEG (IF))
     .            WTBEG (IF) = WBTBEG (IF)
            ENDIF
         ENDIF
      ELSE
         WCPB (IF) = 0
      ENDIF
      WLASTS (IF) = WLREC (IF) + 1
      WCFR (IF) = WLASTS (IF) + WBLHSI(IF)
      WCLR (IF) = 0
      WCNB (IF) = 0
      WBTBEG (IF) = 0.D0
      WBTEND (IF) = 0.D0
CC         
CC  PREPARE THE BLOCK HEADER AND WRITE IT
CC
      BLHEI (1) = WCFR (IF)
      BLHEI (2) = WCLR (IF)
      BLHEI (3) = WCPB (IF)
      BLHEI (4) = WCNB (IF)
      BLHE (3) = WBTBEG (IF)
      BLHE (4) = WBTEND (IF)
      IF (0.EQ.WBLHEA (IF, BLHE, WLASTS(IF))) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .   'ERROR::WNWBLK: Could not write created record'
         RETURN
      ENDIF
      WLREC (IF) = WCFR (IF) - 1
CC
      WNWBLK = 1
      RETURN
      END

 
 
 
 
      INTEGER FUNCTION WNWREC (IF, TIME, STATE, DERIVS)
CC +----------------------+-------------------------------------+
CC |   PROJECT ROS        |  MODULE WNWREC                      |
CC +----------------------|--------------------------+----------+-------+
CC |   FDD                |  V. Companys             | JAN 1998         |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  WRITES A NEW DATA RECORD ON AN INTERPOLATION FILE. A DATA RECORD  |
CC |  CONSISTS OF A TIME, A STATE, AND SOMETIMES THE DERIVATIVES OF THE |
CC |  STATE                                                             |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER AS RETURNED BY WIFOP          |
CC |  TIME           R*8       TIME CORRESPONDING TO THE STATE          |
CC |  STATE(NVARS)   R*8       STATE TO BE STORED (NVARS AS IN WIFOP    |
CC |  DERIVS(NVARS)  R*8       DERIVATIVES OF STATE. ONLY NEEDED IF     |
CC |                           WIFOP WAS CALLED WITH DERS.NE.0          |
CC |                           OTHERWISE, PASS A DUMMY ARGUMENT         |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  RETURNS ONE IF SUCCESS 0 IF FAILED                                |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  dimensions.inc                                                    |
CC |  wshare.inc                                                        |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WOREC                                                             |
CC +--------------------------------------------------------------------+
CC |  HISTORY  :                                                        |
CC |  ----------                                                        |
CC |  V. Companys --- 98/01/08 --- CREATION                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/gen/interfile/src/SCCS/s.wnwrec.F	',
C     &'1.10	01/11/21 	OAD_IMSS\n'/
CC
      INTEGER IF
      DOUBLE PRECISION STATE(1), DERIVS(1), TIME
CC
CC    LOCAL VARIABLES
CC
CC
      INTEGER I, IOS
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE DIMENSIONS FILE             |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  MAXIMUM DIMENSIONS FOR INTERPOLATION FILE                         |
C |  MAXHEA    MAXIMUM SIZE OF HEADER IN BYTES                         |
C |  MAXBLK    MAXIMUM SIZE OF BLOCK HEADER IN BYTES                   |
C |  MNUMVA    MAXIMUM NUMBER OF FUNCTIONS TO STORE                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  HEADS     TO SAVE MEMORY, THIS ARRAYS ARE USED EVERYWHERE         |
C |               HEABUF                                               |
C |               BLHE                                                 |
C |  PR        SORRY TO PUT THAT HERE, IT IS A COMMON TO HIDE ERROR    |
C |            MESSAGES ON UNIT 0                                      |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/22 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C
C    MAXIMUM SIZE OF FILE HEADER
C
C      CHARACTER*68 SCCS_INFO_dimensions(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.dimensions.inc	',
C     &'1.1	00/07/20 	OAD_IMSS\n'/
C
      INTEGER MAXHEA
      PARAMETER (MAXHEA = 40000)
C
C    MAXIMUM SIZE OF BLOCK HEADER
C
      INTEGER MAXBLK
      PARAMETER (MAXBLK = 40000)
C
C    MAXIMUM NUMBER OF VARIABLES ALLOWED
C
      INTEGER MNUMVA
      PARAMETER (MNUMVA  = 50)
C
C    HEABUF WILL CONTAIN THE BUFFER TO BE WRITTEN AS HEADER OF THE FILE
C
      DOUBLE PRECISION HEABUF(MAXHEA/8), BLHE(MAXBLK/8)
C
C    THE SAME IN INTEGER, SEE EQUIVALENCE (SORRY BUT THERE IS NO
C    OTHER WAY IN STANDARD FORTRAN)
C
      COMMON /HEADS/ HEABUF, BLHE
      INTEGER PR
      COMMON /PR/ PR
C +----------------------+-------------------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA                 |
C +----------------------|--------------------------+----------+-------+
C |   FDD                |  V. Companys             | JAN 1998         |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  CONTAINS DATA TO BE SHARED BY READ FUNCTIONS, WRITE...            |
C |  NO ENCAPSULATION POSSIBLE BECAUSE FORTRAN                         |
C |  ONLY RELEVANT FOR WRITE                                           |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  IFPARS:                                                           |
C |    WFLIST   ARRAY WITH FLAGS  (ONE FOR EACH INTERPOLATION FILE)    |
C |             0 NOT USED                                             |
C |             1 OPEN FOR WRITTING                                    |
C |    WUNITS   ARRAY WITH FILE UNITS                                  |
C |    WTYPES   ARRAY WITH FILE TYPES (ROSETTA 1)                      |
C |    WVARS    ARRAY WITH NUMBER OF VARS                              |
C |    NDERS    ARRAY WITH FLAGS FOR DERIVATIVES                       |
C |    WRECLS   ARRAY WITH RECORD LENGTHS (BYTES)                      |
C |    WHSIZ    ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WBLHSI   ARRAY WITH HEADER SIZE (RECORDS)                       |
C |    WLASTS   ARRAY WITH LAST BLOCK BEGINNING RECORD                 |
C |    WLREC    LAST RECORD WRITTEN                                    |
C |    WBTBEG   FOR CURRENT BLOCK START TIME                           |
C |    WBTEND   FOR CURRENT BLOCK END TIME                             |
C |    WTBEG    FOR IFILE BLOCK START TIME                             |
C |    WTEND    FOR IFILE BLOCK END TIME                               |
C |    WCFR     FOR CURRENT BLOCK FIRST RECORD                         |
C |    WCLR     FOR CURRENT BLOCK LAST RECORD                          |
C |    WCPB     FOR CURRENT BLOCK PREVIOUS BLOCK                       |
C |    WCNB     FOR CURRENT BLOCK NEXT BLOCK                           |
C |  WBUF:   Parameters to buffer I/O                                  |
C |    WFBUF    BUFFER TO READ BIG RECORDS                             |
C |    WBUFFR   FIRST LOGICAL RECORD IN RECORD                         |
C |    WBUFLR   LAST LOGICAL RECORD IN RECORD. A REAL RECORD IS MADE   |
C |             OF SEVERAL LOGICAL RECORDS. A LOGICAL RECORD CONTAINS  |
C |             FOR EXAMPLE, A TIME, A STATE AND THE DERIVATIVES       |
C |             IN ORDER TO AVOID TO MUCH IO, THE PHISICAL RECORD IS   |
C |             MUCH HIGHER. I/O IS DONE TO BUFFER, AND ONLY TO FILE   |
C |             WHEN THE LOGICAL RECORDS GO BEYOND THE CONTENDS OF THE |
C |             BUFFER                                                 |
C |    WRCW     NUMBER OF RECORDS CURRENTLY WRITTEN                    |
C +--------------------------------------------------------------------+
C |  HISTORY  :                                                        |
C |  ----------                                                        |
C |  V. Companys --- 98/01/07 --- CREATION                             |
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wshare(2)
C     &/'@(#)/home/imlib/gen/interfile/inc/SCCS/s.wshare.inc	',
C     &'1.4	01/11/09 	OAD_IMSS\n'/
C
      INTEGER MWFLS
      PARAMETER (MWFLS = 8)
      INTEGER WFLIST(MWFLS), WUNITS(MWFLS), WTYPES(MWFLS),
     .            WVARS(MWFLS), WDERS(MWFLS),
     .            WRECLS(MWFLS), WHSIZ(MWFLS), WBLHSI(MWFLS),
     .            WLASTS(MWFLS),
     .            WLREC(MWFLS),
     .            WCFR(MWFLS), WCLR(MWFLS), WCPB(MWFLS), 
     .            WCNB(MWFLS)

       DOUBLE PRECISION WBTBEG(MWFLS), WBTEND(MWFLS),WTBEG(MWFLS)
     .                 , WTEND(MWFLS)

      COMMON /WFPARS/ WFLIST, WUNITS, WTYPES, WVARS, WDERS, 
     .                WRECLS, WHSIZ, WBLHSI, WLASTS, WLREC,
     .                WBTBEG, WBTEND, WTBEG, WTEND,
     .                WCFR, WCLR, WCPB, WCNB
      INTEGER MAXFWR

C
C    SIZE OF FILE RECORD 
C

      PARAMETER (MAXFWR = 40000)
      DOUBLE PRECISION WFBUF(MAXFWR / 8, MWFLS)
      INTEGER WBUFFR(MWFLS), WBUFLR(MWFLS), WRCW(MWFLS), 
     .     WNLREC(MWFLS)
      COMMON /WBUF/ WFBUF, WBUFFR, WBUFLR, WRCW, WNLREC
      DOUBLE PRECISION BUF(1 + 2 * MNUMVA, 2, MWFLS)
      INTEGER BUFID(MWFLS)
      SAVE BUF
      SAVE BUFID
CC
CC    CALLED FUNCTIONS
CC
      INTEGER WOREC

      DATA BUFID /MWFLS * 1/

      WNWREC = 0
      BUFID(IF) = 3 - BUFID(IF)
      IF (IF.LT.1.OR.IF.GT.MWFLS) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WNWREC: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (WFLIST(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WNWREC: Invalid identifier IF = ', IF
         RETURN
      ENDIF
      IF (WLASTS(IF).EQ.0) THEN
         IF (PR.GT.0) WRITE (0,*) 
     .    'ERROR::WNWREC: You must create a block first'
         RETURN
      ENDIF
      IF (WDERS(IF) .EQ. 0) THEN
          BUF(1, BUFID(IF),IF) = TIME
          DO 2 I=1,WVARS(IF)
 2           BUF(I+1, BUFID(IF),IF) = STATE(I)
CC
CC    CHECK FOR TIME KEY REPETITION
CC
          IF (WCLR(IF).NE.0) THEN
             IF (BUF(1,BUFID(IF),IF) .EQ. BUF(1,3-BUFID(IF),IF)) THEN
                IF (PR.GT.0) WRITE (0, *) 
     .          'ERROR::WNWREC: TWO DIFFERENT STATES WITH ',
     .          'SAME TIME'
                BUFID(IF) = 3 - BUFID(IF)
                RETURN
             ENDIF
          ENDIF
          IOS = WOREC (IF, 1 + WLREC(IF), BUF(1, BUFID(IF),IF))
CC         WRITE (UNIT = WUNITS(IF), IOSTAT = IOS, REC = 1 + WLREC(IF)) 
CC     .   TIME, (STATE(I), I=1, WVARS(IF))
         IF (IOS .NE. 0) THEN
            IF (PR.GT.0) WRITE (0, *) 
     .       'ERROR::WNWREC: Not able to write data record IOS = ',
     .             IOS, 'File may be corrupted'
            RETURN
         ENDIF
      ELSE
          BUF(1, BUFID(IF),IF) = TIME
          DO 3 I=1,WVARS(IF)
             BUF(I + 1 + WVARS(IF), BUFID(IF),IF) = DERIVS(I)
 3           BUF(I+1, BUFID(IF),IF) = STATE(I)
CC
CC    CHECK FOR TIME KEY REPETITION
CC
          IF (WCLR(IF).NE.0) THEN
             IF (BUF(1,BUFID(IF),IF) .EQ. BUF(1,3-BUFID(IF),IF)) THEN
                IF (PR.GT.0) WRITE (0, *) 
     .          'ERROR::WNWREC: TWO DIFFERENT STATES WITH ',
     .          'SAME TIME'
                BUFID(IF) = 3 - BUFID(IF)
                RETURN
             ENDIF
          ENDIF
          IOS = WOREC (IF, 1 + WLREC(IF), BUF(1, BUFID(IF),IF))
CC         WRITE (UNIT = WUNITS(IF), IOSTAT = IOS, REC = 1 + WLREC(IF)) 
CC     .   TIME, (STATE(I), I=1, WVARS(IF)), (DERIVS(I), I=1, WVARS(IF))
         IF (IOS .NE. 0) THEN
            IF (PR.GT.0) WRITE (0, *) 
     .       'ERROR::WNWREC: Not able to write data record IOS = ',
     .             IOS, 'File may be corrupted'
            RETURN
         ENDIF
      ENDIF
CC
CC    INCREASE THE RECORD COUNTER
CC
      WLREC(IF) = WLREC(IF) + 1
CC
CC    SET THE START AND END TIME OF BLOCK IF APPLICABLE
CC
      WBTEND(IF) = TIME
      IF (WLREC(IF).EQ.WCFR(IF)) THEN
         WBTBEG (IF) = TIME
CC
CC    CHECK FOR DISCONTINUITIES, AND GIVE WARNINGS
CC
         IF (WLASTS(IF) .NE. WHSIZ(IF) + 1) THEN
            IF (WBTBEG (IF).NE.WTEND(IF)) THEN
               IF (PR.GT.0) WRITE (0,*)
     .        'WARNING::WNWREC: Discontinuity found between blocks'
            ENDIF
         ENDIF
      ENDIF
CC
CC    SET THE CURRENT BLOCK LAST RECORD. THERE IS A SUBTEL DIFF
CC
      WCLR (IF) = WLREC(IF)
      WNWREC = 1
      RETURN
      END
 
 
 
 
      SUBROUTINE WOFCL (IF, IER)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE WOFCL            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  THIS SUBROUTINE CLOSES AN ORBIT FILE PREVIOUSLY GENERATED WITH    |
CC |  THE SUBROUTINES WOF**. IT IS NECESSARY TO CLOSE SPECIFICALLY THE  |
CC |  FILE WITH THIS SUBROUTINE, BECAUSE WOF** USE SW BUFFERING.        |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER FOR ORBIT FILE, AS RETURNED   |
CC |                           BY WOFOP                                 |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  IER            I*4       ERROR CODE, NON-ZERO IF ERROR            |
CC |                           1 = NOT ABLE TO CLOSE FILE               |
CC |                           2 = INVALID IDENTIFIER                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  debugf.inc   ERROR PRINTING OPTIONS                               |
CC |  wofsh.inc                                                         |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WIFCL                                                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/orbit/orbfil/src/SCCS/s.wofcl.F	',
C     &'1.6	01/11/15 	OAD_IMSS\n'/
CC
CC    HEADER VARIABLES
      INTEGER IF, IER
CC
CC    CALLING
CC
      INTEGER WIFCL
CC
CC    LOCAL VARIABLES
CC
CC
      INTEGER IUNER
      LOGICAL PR
CC
CC
CC
CC    INCLUDE FILES
CC
C ======================================================================
C INCLUDE FILE DEBUGF
C ======================================================================
C      CHARACTER*68 SCCS_INFO_debugf(2)
C     &/'@(#)/home/imlib/gen/errors/inc/SCCS/s.debugf.inc	',
C     &'1.1	98/04/21 	OAD_IMSS\n'/
C
      INTEGER      IDEBUG
      COMMON/ DEBUG/ IDEBUG(10)
C
CB    / DEBUG/ DEBUG FLAGS
CV    IF IDEBUG(1).NE.0 : TRACE MESSAGES ARE GENERATED AND WRITTEN
CV                        (FOR DEBUGGING, INTERMEDIATE OUTPUT...)
CV    IDEBUG(9)         : IT CONTROLS THE SEVERITY FOR THE MESSAGES 
CV                        OUTPUT
CV                        0 MEANS THAT REPEAT, ERROR AND
CV                          WARNING MESSAGES ARE WRITTEN
CV                        1 MEANS THAT ONLY REPEAT AND 
CV                          ERROR MESSAGES ARE WRITTEN
CV                        2 ONLY ERROR MESSAGES ARE WRITTEN
CV                        3 ERROR MESSAGES ARE NOT WRITTEN  
CV    IDEBUG(10)        : UNIT WHERE MESSAGES ARE GOING TO BE DISPLAYED
CV                        NEGATIVE UNIT MEANS UNIT 0 (UNIX STDERR)
CV                        TO LOGICAL UNIT NUMBER = IDEBUG(10).
CV                        0 MEANS NO MESSAGE WRITTEN
CV    IDEBUG(3)...IDEBUG(9) ARE CURRENTLY UNUSED.
C +----------------------+--------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA      |
C +----------------------|--------------------------+
C |   FDD                |  V. Companys             |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  DATA TO BE SHARED BETWEEN WOF?? FUNCTIONS. THIS INCLUDE FILE      |
C |  SHOULD BE CONSIDERED HIDDEN TO THE USER. USER SHOULD NEVER        |
C |  INCLUDE IT (THERE IS NO NEED).                                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  WOFP:                                                             |
C |     
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wofsh(2)
C     &/'@(#)/home/imlib/orbit/orbfil/inc/SCCS/s.wofsh.inc	',
C     &'1.4	01/11/15 	OAD_IMSS\n'/
C
      INTEGER MAXUN
      PARAMETER (MAXUN = 8)
C
      IER = 0
CC
CC   FIX ONCE FOR EVER THE ERROR UNIT
CC
      IF (IDEBUG(10).LT.0) THEN
         IUNER = 0
      ELSE IF (IDEBUG(10).EQ.0) THEN
         IUNER = -1
      ELSE
         IUNER = IDEBUG(10)
      ENDIF
      PR = (IUNER.GE.0) 
      IF (IF .LT.1 .OR. IF .GT. MAXUN)
     .   THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E WOFCL. INVALID IDENTIFIER'
         ENDIF
         IER = 2
         RETURN
      ENDIF
CC
      IF (0.EQ. WIFCL (IF)) THEN
         IF (PR.AND.IDEBUG(9).LT.3) THEN
         WRITE (0, *) 'E WOFCL. UNABLE TO CLOSE FILE'
         ENDIF
         IER = 1
         RETURN
      ENDIF
      RETURN
      END
      
      
 
 
 
 
      SUBROUTINE WOFNB (IF, IFRAME, IBODY, IER)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE WOFNB            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  ADDS A NEW BLOCK TO A ROSETTA ORBIT FILE. SUBROUTINE WOFOP MUST   |
CC |  BE CALLED BEFORE WOFNB, TO OPEN AND SET HEADER OF THE ORBIT FILE  |
CC |  DIFFERENT BLOCKS MAY BE USED TO STORE DIFFERENT PIECES OF THE     |
CC |  ORBIT. FOR EXAMPLE, WHEN THE ATTRACTION BODY CHANGES, A NEW       |
CC |  BLOCK SHOULD BE CREATED. IT IS ALSO ADVICED TO CREATE BLOCKS      |
CC |  WHEN DISCONTINUITIES OCCUR IN THE EQUATIONS OF MOTION             |
CC |  (MANOEUVRES)                                                      |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER FOR ORBIT FILE, AS RETURNED   |
CC |                           BY WOFOP                                 |
CC |  IFRAME         I*4       REFERENCE FRAME ID FOR THE BLOCK TO BE   |
CC |                           CREATED                                  |
CC |                           0: EQ2000                                |
CC |                           1: EC2000                                |
CC |                           2: EQ1950                                |
CC |                           3: EC1950                                |
CC |  IBODY          I*4       REFERENCE BODY ID FOR THE BLOCK TO BE    |
CC |                           CREATED                                  |
CC |                           0: BARY-CENTRE OF THE SOLAR SYSTEM       |
CC |                           1: MERCURY                               |
CC |                           2: VENUS                                 |
CC |                           3: EARTH                                 |
CC |                           4: MARS                                  |
CC |                           5: JUPITER                               |
CC |                           6: SATURN                                |
CC |                           7: URANUS                                |
CC |                           8: NEPTUNE                               |
CC |                           9: PLUTO                                 |
CC |                           10: SUN                                  |
CC |                           11: MOON                                 |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  IER            I*4       ERROR CODE, NON-ZERO IF ERROR            |
CC |                           1 = ERROR CREATING NEW BLOCK,            |
CC |                               FILE IS CLOSED                       |
CC |                           2 = ERROR SETTING BLOCK HEADER           |
CC |                               PARAMETERS, FILE IS CLOSED           |
CC |                           3 = THIS IS THE ERROR CODE PRODUCED WHEN |
CC |                               FAILING TO CLOSE THE ORBIT FILE ONCE |
CC |                               ANOTHER ERROR CONDITION OCURRED.     |
CC |                               FOR THIS TO HAPPEN, SEVERE PROBLEMS  |
CC |                               MUST HAVE OCCURRED, AND THE CONTENTS |
CC |                               OF THE ORBIT FILE ARE NOT GUARANTEED |
CC |                               AT ALL                               |
CC |                           3 = INVALID IDENTIFIER                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  debugf.inc   ERROR PRINTING OPTIONS                               |
CC |  wofsh.inc                                                         |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WNWBLK, WOFCL, WMODBL                                             |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/orbit/orbfil/src/SCCS/s.wofnb.F	',
C     &'1.8	01/11/15 	OAD_IMSS\n'/
CC
      INTEGER IF, IFRAME, IBODY, IER
CC
CC    LOCAL VARIABLES
      INTEGER BUF(2), IUNER
CC
      LOGICAL PR
CC
CC    CALLING...
CC
      INTEGER WNWBLK, WMODBL
CC
CC
CC
CC    INCLUDE FILES
CC
C ======================================================================
C INCLUDE FILE DEBUGF
C ======================================================================
C      CHARACTER*68 SCCS_INFO_debugf(2)
C     &/'@(#)/home/imlib/gen/errors/inc/SCCS/s.debugf.inc	',
C     &'1.1	98/04/21 	OAD_IMSS\n'/
C
      INTEGER      IDEBUG
      COMMON/ DEBUG/ IDEBUG(10)
C
CB    / DEBUG/ DEBUG FLAGS
CV    IF IDEBUG(1).NE.0 : TRACE MESSAGES ARE GENERATED AND WRITTEN
CV                        (FOR DEBUGGING, INTERMEDIATE OUTPUT...)
CV    IDEBUG(9)         : IT CONTROLS THE SEVERITY FOR THE MESSAGES 
CV                        OUTPUT
CV                        0 MEANS THAT REPEAT, ERROR AND
CV                          WARNING MESSAGES ARE WRITTEN
CV                        1 MEANS THAT ONLY REPEAT AND 
CV                          ERROR MESSAGES ARE WRITTEN
CV                        2 ONLY ERROR MESSAGES ARE WRITTEN
CV                        3 ERROR MESSAGES ARE NOT WRITTEN  
CV    IDEBUG(10)        : UNIT WHERE MESSAGES ARE GOING TO BE DISPLAYED
CV                        NEGATIVE UNIT MEANS UNIT 0 (UNIX STDERR)
CV                        TO LOGICAL UNIT NUMBER = IDEBUG(10).
CV                        0 MEANS NO MESSAGE WRITTEN
CV    IDEBUG(3)...IDEBUG(9) ARE CURRENTLY UNUSED.
C +----------------------+--------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA      |
C +----------------------|--------------------------+
C |   FDD                |  V. Companys             |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  DATA TO BE SHARED BETWEEN WOF?? FUNCTIONS. THIS INCLUDE FILE      |
C |  SHOULD BE CONSIDERED HIDDEN TO THE USER. USER SHOULD NEVER        |
C |  INCLUDE IT (THERE IS NO NEED).                                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  WOFP:                                                             |
C |     
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wofsh(2)
C     &/'@(#)/home/imlib/orbit/orbfil/inc/SCCS/s.wofsh.inc	',
C     &'1.4	01/11/15 	OAD_IMSS\n'/
C
      INTEGER MAXUN
      PARAMETER (MAXUN = 8)
C
CC
CC   FIX ONCE FOR EVER THE ERROR UNIT
CC
      IF (IDEBUG(10).LT.0) THEN
         IUNER = 0
      ELSE IF (IDEBUG(10).EQ.0) THEN
         IUNER = -1
      ELSE
         IUNER = IDEBUG(10)
      ENDIF
      PR = (IDEBUG(9).LT.3).AND.(IUNER.GE.0) 
      IF (IF .LT.1 .OR. IF .GT. MAXUN)
     .   THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E WOFNB. INVALID IDENTIFIER'
         ENDIF
         IER = 3
         RETURN
      ENDIF
CC
CC   CHECK IF UNIT ALREADY IN USE
CC
      IF (0.EQ.WNWBLK (IF)) THEN
         IER = 1
         IF (PR) THEN
         WRITE (IUNER,*) 'E WOFNB. UNABLE TO CREATE BLOCK'
         WRITE (IUNER,*) '         FILE WILL BE CLOSED'
         ENDIF
         CALL WOFCL(IF, IER)
         IF (0.NE.IER) THEN
            IER = 3
            IF (PR) THEN
            WRITE (IUNER,*) 'R WOFNB. UNABLE TO CLOSE FILE.'
            ENDIF
         ENDIF
         RETURN
      ENDIF
      BUF(1) = IFRAME
      BUF(2) = IBODY
      IF (0.EQ.WMODBL (IF, BUF, 9, 2)) THEN
         IER = 2
         IF (PR) THEN
         WRITE (IUNER,*) 'E WOFNB. UNABLE TO WRITE BLOCK HEADER'
         WRITE (IUNER,*) '         FILE WILL BE CLOSED'
         ENDIF
         CALL WOFCL(IF, IER)
         IF (0.NE.IER) THEN
            IER = 3
            IF (PR) THEN
            WRITE (IUNER,*) 'R WOFNB. UNABLE TO CLOSE FILE.'
            ENDIF
         ENDIF
         RETURN
      ENDIF
      IER = 0
      RETURN
      END
      
      




 
 
 
 
      SUBROUTINE WOFNR (IF, TIME, STATE, DERIVS, IER)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE WOFNR            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             |
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  ADDS A NEW RECORD TO AN ORBIT FILE. A RECORD CONSISTS OF          | 
CC |  A TIME AND A STATE AND IF AVAILABLE, DERIVATIVES                  |
CC |  OF THE STATE. THE FILE POINTED BY IUNIT MUST HAVE BEEN OPENED     |
CC |  AND INITIALISED BY WOFOP, AND AT LEAST ONE FILE BLOCK MUST HAVE   |
CC |  BEEN CREATED WITH WOFNB.                                          |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IF             I*4       IDENTIFIER FOR ORBIT FILE, AS RETURNED   |
CC |                           BY WOFOP                                 |
CC |  TIME           R*8       TIME OF THE RECORD. CURRENTLY ONLY TDT   |
CC |                           IN MJD2000 FORMAT IS SUPPORTED           |
CC |  STATE(*)       R*8       STATE VECTOR CORRESPONDING TO TIME       |
CC |                           REFERENCE SYSTEM AND CENTRE BODY MUST    |
CC |                           BE COMPATIBLE TO THOSE OF LAST BLOCK     |
CC |                           CREATED WITH WOFNB. DIMENSION SHALL      |
CC |                           BE COMPATIBLE TO NVARS PARAMETER IN      |
CC |                           WOFOP, NAMELY 3 FOR POSITION ONLY AND    |
CC |                           6 FOR POSITION AND VELOCITY.             |
CC |  DERIVS(*)      R*8       DERIVATIVES OF STATE. ONLY TO BE FILLED  |
CC |                           IF FILE WAS INITIALISED WITH IDERIV      |
CC |                           PARAMETER NON-ZERO IN WOFOP CALL. IF     |
CC |                           IDERIV PARAMETER WAS 0 THE CONTENTS OF   |
CC |                           DERIVS ARE IGNORED, AND ONLY A DUMMY     |
CC |                           PARAMETER IS NECESSARY. DERIVS DIMENSION |
CC |                           SHALL BE THE SAME AS STATE               |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  IER            I*4       ERROR CODE, NON-ZERO IF ERROR            |
CC |                           1 = ERROR WRITTING RECORD,               |
CC |                               FILE IS CLOSED (HAS A BLOCK BEEN     |
CC |                               CREATED YET?)                        |
CC |                           2 = THIS IS THE ERROR CODE PRODUCED WHEN |
CC |                               FAILING TO CLOSE THE ORBIT FILE ONCE |
CC |                               ANOTHER ERROR CONDITION OCURRED.     |
CC |                               FOR THIS TO HAPPEN, SEVERE PROBLEMS  |
CC |                               MUST HAVE OCCURRED, AND THE CONTENTS |
CC |                               OF THE ORBIT FILE ARE NOT GUARANTEED |
CC |                               AT ALL                               |
CC |                           3 = INVALID IDENTIFIER                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  debugf.inc   ERROR PRINTING OPTIONS                               |
CC |  wofsh.inc                                                         |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WNWREC, WOFCL                                                     |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/orbit/orbfil/src/SCCS/s.wofnr.F	',
C     &'1.7	01/11/15 	OAD_IMSS\n'/
CC
CC    HEADER VARIABLES
CC
      INTEGER IER, IF
      DOUBLE PRECISION TIME, STATE(1), DERIVS(1)
CC
CC
CC    CALLING...
CC
      INTEGER WNWREC
CC
CC     INTERNAL VARIABLES
CC
      INTEGER IUNER
      LOGICAL PR
CC
CC
CC
CC    INCLUDE FILES
CC
C ======================================================================
C INCLUDE FILE DEBUGF
C ======================================================================
C      CHARACTER*68 SCCS_INFO_debugf(2)
C     &/'@(#)/home/imlib/gen/errors/inc/SCCS/s.debugf.inc	',
C     &'1.1	98/04/21 	OAD_IMSS\n'/
C
      INTEGER      IDEBUG
      COMMON/ DEBUG/ IDEBUG(10)
C
CB    / DEBUG/ DEBUG FLAGS
CV    IF IDEBUG(1).NE.0 : TRACE MESSAGES ARE GENERATED AND WRITTEN
CV                        (FOR DEBUGGING, INTERMEDIATE OUTPUT...)
CV    IDEBUG(9)         : IT CONTROLS THE SEVERITY FOR THE MESSAGES 
CV                        OUTPUT
CV                        0 MEANS THAT REPEAT, ERROR AND
CV                          WARNING MESSAGES ARE WRITTEN
CV                        1 MEANS THAT ONLY REPEAT AND 
CV                          ERROR MESSAGES ARE WRITTEN
CV                        2 ONLY ERROR MESSAGES ARE WRITTEN
CV                        3 ERROR MESSAGES ARE NOT WRITTEN  
CV    IDEBUG(10)        : UNIT WHERE MESSAGES ARE GOING TO BE DISPLAYED
CV                        NEGATIVE UNIT MEANS UNIT 0 (UNIX STDERR)
CV                        TO LOGICAL UNIT NUMBER = IDEBUG(10).
CV                        0 MEANS NO MESSAGE WRITTEN
CV    IDEBUG(3)...IDEBUG(9) ARE CURRENTLY UNUSED.
C +----------------------+--------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA      |
C +----------------------|--------------------------+
C |   FDD                |  V. Companys             |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  DATA TO BE SHARED BETWEEN WOF?? FUNCTIONS. THIS INCLUDE FILE      |
C |  SHOULD BE CONSIDERED HIDDEN TO THE USER. USER SHOULD NEVER        |
C |  INCLUDE IT (THERE IS NO NEED).                                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  WOFP:                                                             |
C |     
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wofsh(2)
C     &/'@(#)/home/imlib/orbit/orbfil/inc/SCCS/s.wofsh.inc	',
C     &'1.4	01/11/15 	OAD_IMSS\n'/
C
      INTEGER MAXUN
      PARAMETER (MAXUN = 8)
C
CC
CC   FIX ONCE FOR EVER THE ERROR UNIT
CC
      IF (IDEBUG(10).LT.0) THEN
         IUNER = 0
      ELSE IF (IDEBUG(10).EQ.0) THEN
         IUNER = -1
      ELSE
         IUNER = IDEBUG(10)
      ENDIF
      PR = (IDEBUG(9).LT.3).AND.(IUNER.GE.0) 
      PR = (IDEBUG(9).LT.3).AND.(IUNER.GE.0) 
      IF (IF .LT.1 .OR. IF .GT. MAXUN)
     .   THEN
        IF (PR) THEN
         WRITE (IUNER, *) 'E WOFNR. INVALID IDENTIFIER'
         ENDIF
         IER = 3
         RETURN
      ENDIF
CC
      IER = 0
      IF (0.EQ.WNWREC (IF, TIME, STATE, DERIVS)) THEN
         IF (PR) THEN
         WRITE (IUNER, *) 'E WOFNR. UNABLE TO WRITE RECORD'
         WRITE (IUNER, *) '         FILE WILL BE CLOSED'
         ENDIF
         IER = 1
         CALL WOFCL(IF, IER)
         IF (0.NE.IER) THEN
            IF (PR) THEN
            WRITE (IUNER, *) 'R WOFNR. UNABLE TO CLOSE FILE'
            ENDIF
            IER = 2
         ENDIF
         RETURN
      ENDIF
      RETURN
      END
      
      
 
 
 
 
      SUBROUTINE WOFOP (IUNIT, FNAME, NVARS, IDERIV, IFRAME, IBODY,
     .                         ITSCAL, IF, IER)
CC +----------------------+--------------------------+
CC |   PROJECT ROS        |  MODULE WOFOP            |
CC +----------------------|--------------------------+
CC |   FDD                |  V. Companys             | 
CC +----------------------+--------------------------+------------------+
CC |  FUNCTIONAL DESCRIPTION :                                          |
CC |  ------------------------                                          |
CC |  OPENS A ROSETTA ORBIT FILE FOR WRITTING AND FILLS HEADER PART.    |
CC |  SCRATCH IF EXISTS                                                 |
CC +--------------------------------------------------------------------+
CC |  INPUT DESCRIPTION  :                                              |
CC |  --------------------                                              |
CC |  IUNIT(1/3)      I*4      UNIT TO WHERE FILE MUST BE OPENED.       |
CC |                           IF UNIT = 0 THEN UNIT IS EXPECTED TO BE  |
CC |                           A VECTOR OF 3 COMPONENTS. UNIT(2) AND    |
CC |                           UNIT(3) GIVE THEN A RANGE TO SEARCH FOR  |
CC |                           FOR POSSIBLE UNITS                       |
CC |  FNAME          C*132     NAME OF THE FILE TO BE OPENED.           |
CC |  NVARS          I*4       NUMBER OF VARIABLES TO STORE. 3 FOR      |
CC |                           POSITION, 6 FOR STATE, 42 TO INCLUDE     |
CC |                           VARIATIONALS IN ADDITION                 |
CC |  IDERIV         I*4       NON ZERO IF DERIVATIVES ARE AVAILABLE    |
CC |  IFRAME         I*4       DEFAULT REFERENCE FRAME ID               |
CC |                           0: EQ2000                                |
CC |                           1: EC2000                                |
CC |                           2: EQ1950                                |
CC |                           3: EC1950                                |
CC |  IBODY          I*4       DEFAULT REFERENCE BODY ID                |
CC |                           0: BARY-CENTRE OF THE SOLAR SYSTEM       |
CC |                           1: MERCURY                               |
CC |                           2: VENUS                                 |
CC |                           3: EARTH                                 |
CC |                           4: MARS                                  |
CC |                           5: JUPITER                               |
CC |                           6: SATURN                                |
CC |                           7: URANUS                                |
CC |                           8: NEPTUNE                               |
CC |                           9: PLUTO                                 |
CC |                           10: SUN                                  |
CC |                           11: MOON                                 |
CC |  ITSCAL         I*4       TIME SCALE ID                            |
CC |                           0 : TDB (BARYCENTRIC DYNAMIC TIME)       |
CC |                               IN MJD2000 FORMAT                    |
CC +--------------------------------------------------------------------+
CC |  OUTPUT DESCRIPTION  :                                             |
CC |  ---------------------                                             |
CC |  IF             I*4       FILE IDENTIFIER TO BE USED IN SUBSEQUENT |
CC |                           CALLS OF SUBROUTINES OF THE FORM WOF??   |
CC |                           0 IF FAILED TO OPEN FILE                 |
CC |  IER            I*4       ERROR CODE, NON-ZERO IF ERROR            |
CC |                           1 = NVARS MUST BE 3, 6 OR 42             |
CC |                           2 = FAILED OPENING FILE                  |
CC |                           3 = UNABLE TO SET DEFAULS                |
CC |                           4 = CORRUPTION??                         |
CC |                           5 = TO MANY FILES OPEN                   |
CC +--------------------------------------------------------------------+
CC |  COMMON DESCRIPTION   :                                            |
CC |  ----------------------                                            |
CC |  SEE INCLUDE FILES                                                 |
CC +--------------------------------------------------------------------+
CC |  INCLUDE FILES   :                                                 |
CC |  -----------------                                                 |
CC |  debugf.inc   error printing options                               |
CC |  wofsh.inc                                                         |
CC +--------------------------------------------------------------------+
CC |  REFERS TO  :                                                      |
CC |  ------------                                                      |
CC |  WIFOP, WMODHE, WIFCL                                              |
CC +--------------------------------------------------------------------+
CC |  REFERENCES :                                                      |
CC |  ------------                                                      |
CC |  NONE                                                              |
CC +--------------------------------------------------------------------+
CC
CC    HEADER VARIABLES
C      CHARACTER*68 SCCS_INFO(2)
C     &/'@(#)/home/imlib/orbit/orbfil/src/SCCS/s.wofop.F	',
C     &'1.11	01/11/15 	OAD_IMSS\n'/
CC
      INTEGER IUNIT, IER
      INTEGER NVARS, IDERIV, IFRAME, IBODY, ITSCAL, IF
      CHARACTER*132 FNAME
CC
CC    LOCAL VARIABLES
      INTEGER BUF(3), IUNER
CC
      LOGICAL PR
CC
CC    CALLING...
CC
      INTEGER WIFOP, WMODHE, WIFCL
CC
CC    INCLUDE FILES
CC
C ======================================================================
C INCLUDE FILE DEBUGF
C ======================================================================
C      CHARACTER*68 SCCS_INFO_debugf(2)
C     &/'@(#)/home/imlib/gen/errors/inc/SCCS/s.debugf.inc	',
C     &'1.1	98/04/21 	OAD_IMSS\n'/
C
      INTEGER      IDEBUG
      COMMON/ DEBUG/ IDEBUG(10)
C
CB    / DEBUG/ DEBUG FLAGS
CV    IF IDEBUG(1).NE.0 : TRACE MESSAGES ARE GENERATED AND WRITTEN
CV                        (FOR DEBUGGING, INTERMEDIATE OUTPUT...)
CV    IDEBUG(9)         : IT CONTROLS THE SEVERITY FOR THE MESSAGES 
CV                        OUTPUT
CV                        0 MEANS THAT REPEAT, ERROR AND
CV                          WARNING MESSAGES ARE WRITTEN
CV                        1 MEANS THAT ONLY REPEAT AND 
CV                          ERROR MESSAGES ARE WRITTEN
CV                        2 ONLY ERROR MESSAGES ARE WRITTEN
CV                        3 ERROR MESSAGES ARE NOT WRITTEN  
CV    IDEBUG(10)        : UNIT WHERE MESSAGES ARE GOING TO BE DISPLAYED
CV                        NEGATIVE UNIT MEANS UNIT 0 (UNIX STDERR)
CV                        TO LOGICAL UNIT NUMBER = IDEBUG(10).
CV                        0 MEANS NO MESSAGE WRITTEN
CV    IDEBUG(3)...IDEBUG(9) ARE CURRENTLY UNUSED.
C +----------------------+--------------------------+
C |   PROJECT ROS        |  MODULE SHARED DATA      |
C +----------------------|--------------------------+
C |   FDD                |  V. Companys             |
C +----------------------+--------------------------+------------------+
C |  FUNCTIONAL DESCRIPTION :                                          |
C |  ------------------------                                          |
C |  DATA TO BE SHARED BETWEEN WOF?? FUNCTIONS. THIS INCLUDE FILE      |
C |  SHOULD BE CONSIDERED HIDDEN TO THE USER. USER SHOULD NEVER        |
C |  INCLUDE IT (THERE IS NO NEED).                                    |
C +--------------------------------------------------------------------+
C |  COMMON DESCRIPTION   :                                            |
C |  ----------------------                                            |
C |  WOFP:                                                             |
C |     
C +--------------------------------------------------------------------+
C
C      CHARACTER*68 SCCS_INFO_wofsh(2)
C     &/'@(#)/home/imlib/orbit/orbfil/inc/SCCS/s.wofsh.inc	',
C     &'1.4	01/11/15 	OAD_IMSS\n'/
C
      INTEGER MAXUN
      PARAMETER (MAXUN = 8)
C
CC
CC   FIX ONCE FOR EVER THE ERROR UNIT
CC
      IF (IDEBUG(10).LT.0) THEN
         IUNER = 0
      ELSE IF (IDEBUG(10).EQ.0) THEN
         IUNER = -1
      ELSE
         IUNER = IDEBUG(10)
      ENDIF
      PR = (IDEBUG(9).LT.3).AND.(IUNER.GE.0) 
CC
      IF (NVARS.NE.3.AND.NVARS.NE.6.AND.NVARS.NE.42) THEN
         IER = 1
         IF (PR) THEN
         WRITE (IUNER, *) 'E WOFOP. NVARS MUST BE 3 OR 6 OR 42'
         ENDIF
         IF = 0
         RETURN
      ENDIF
CC
CC   OPEN FILE
CC
      IF = WIFOP (IUNIT, FNAME, 1, NVARS, IDERIV, 160, 160, 34000)
      IF (IF.GT.MAXUN) THEN
         IER = WIFCL(IF)
         IER = 5
         IF (PR) THEN
         WRITE (IUNER, *) 'E WOFOP. TOO MANY ORBIT FILES OPEN'
         ENDIF
         IF = 0
         RETURN
      ENDIF
      IF (IF.EQ.0) THEN
         IER = 2
         IF (PR) THEN
         WRITE (IUNER, *) 'E WOFOP. NOT ABLE TO CREATE FILE'
         ENDIF
         RETURN
      ENDIF
      BUF (1) = IFRAME
      BUF (2) = IBODY
      BUF (3) = ITSCAL
      IF (0.EQ.WMODHE (IF, BUF, 13, 3)) THEN
         IER = 3
         IF (PR) THEN
         WRITE (IUNER, *) 'E WOFOP. NOT ABLE TO SET DEFAULTS.',
     .                    '         FILE CLOSED AGAIN'
         ENDIF
         IF (0.EQ.WIFCL(IF)) THEN
            IER = 4
            IF (PR) THEN
            WRITE (IUNER, *) 'E WOFOP. CANNOT CLOSE FILE.'
            ENDIF
            RETURN
         ENDIF
         IF = 0
         RETURN
      ENDIF
      IER = 0
      RETURN
      END






 
 
 
 
