C * * * * * P R O G R A M D T B A S E * * * * * C 00001 C NAME DTBASE 00002 C 00003 C TYPE PROGRAM 00004 C 00005 C PURPOSE CREATES AN ALTIMETRY DATA BASE ON TWO DIRECT ACCESS FILES00006 C 00007 C EXTERNALS NONE 00008 C 00009 C CALLING LUREAD , LULIST , LUBUG , MTIN 00010 C 00011 C LUREAD = READING INPUT LOGICAL UNIT 00012 C LULIST = LISTING OUTPUT LOGICAL UNIT 00013 C LUBUG = DEBBUGING OUTPUT LOGICAL UNIT 00014 C MTIN = INPUT MAGNETIC TAPE LOGICAL UNIT 00015 C 00016 C DEVICES D-A FILE # 98 = DATA BASE 00017 C D-A FILE # 97 = RECORD LOCATION INDEX FILE 00018 C 00019 DIMENSION IAS(7) 00020 DOUBLE PRECISION FODAY 00021 C 00022 C MACHINE DEPENTENT STATEMENTS 00023 DEFINE FILE 97(400,24,L,LOCREC) , 00024 # 98(40000,90,L,LPRSUM) 00025 C 00026 C DATA SETS REFERENCE NUMBERS 00027 ICR = 5 00028 IPR = 6 00029 C 00030 READ(ICR,1000) LUREAD,MTIN,LULIST,LUBUG 00031 1000 FORMAT(4I4) 00032 C 00033 IF(LUREAD .EQ. 0) LUREAD = ICR 00034 IF(LULIST .EQ. 0) LULIST = IPR 00035 IF(LUBUG .EQ. 0) LUBUG = 13 00036 IF(MTIN .EQ. 0) MTIN = 10 00037 C 00038 C 00039 C NFILE = NUMBER OF FILES TO PROCESS 00040 C MAXREC = MAXIMUM NUMBER OF RECORDS IN FILES 00041 C IPRINT = 0 NO DEBBUGING OUTPUT 00042 C 1 FULL OUTPUT 00043 C 00044 READ(LUREAD,1001) NFILE,MAXREC,IPRINT 00045 1001 FORMAT(3I4) 00046 C 00047 ICOUNT = 0 00048 C 00049 WRITE(LULIST,1008) 00050 1008 FORMAT('1',5X,'FILE NO.',6X,'START REC IN',6X,'END REC IN', 00051 # /,21X,2('DATA BASE',7X),//) 00052 C 00053 C LOOP OVER ALL FILES 00054 C 00055 DO 500 IFILE = 1,NFILE 00056 IF(IPRINT .EQ. 1) WRITE(LUBUG,1002) IFILE 00057 1002 FORMAT(//,' FILE',I3,/,' EDITED REC IN FM ',7X, 00058 # 'FODAY SMOALT SIG ',3X,'LAT LONG TROP GEOID ', 00059 # ' TIDE SEAH RES H1/3',/,2X,'REC FRAME') 00060 C 00061 C LOOP OVER ALL RECORDS IN FILE 00062 C 00063 DO 400 IREC = 1,MAXREC 00064 READ(MTIN,1003,END=410) NEDR,LREC,IFORM,FODAY,LSMALT, 00065 # LSIG,LAT,LONG,LTROP,LGEOID,LTIDE,LSEAH,IRES, 00066 # LAVAGC,LSAGC,LH,N,(IAS(I),I=1,N) 00067 1003 FORMAT(2I5,I4,F13.0,I9,I6,2I8,9I6,7I4) 00068 C 00069 IF(IPRINT .EQ.1) WRITE(LUBUG,1004) NEDR,LREC,IFORM,FODAY,LSMALT, 00070 # LSIG,LAT,LONG,LTROP,LGEOID,LTIDE,LSEAH,IRES,LH 00071 1004 FORMAT(1X,2(I4,4X),I2,1X,F12.0,I9,I6,2I8,6I6) 00072 C 00073 C OUTPUT RECORD TO MASTER FILE 00074 C 00075 ICOUNT = ICOUNT + 1 00076 LPRSUM = ICOUNT 00077 C 00078 WRITE(98'LPRSUM,1005) NEDR,LREC,IFORM,FODAY,LSMALT,LSIG,LAT,LONG, 00079 # LTROP,LGEOID,LTIDE,LSEAH,IRES,LH 00080 1005 FORMAT(2I4,I3,F12.0,I9,I6,2I8,6I6) 00081 C 00082 400 CONTINUE 00083 C 00084 C CHAIN RECORD IN MASTER FILE 00085 C 00086 410 IREC = IREC - 1 00087 LSREC = ICOUNT - IREC + 1 00088 LEREC = ICOUNT 00089 LOCREC = IFILE 00090 C 00091 C CREATE RECORD LOCATION FILE 00092 C 00093 WRITE(97'LOCREC,1006) IFILE,LSREC,LEREC 00094 1006 FORMAT(3I8) 00095 WRITE(LULIST,1007) IFILE,LSREC,LEREC 00096 1007 FORMAT(5X,I6,8X,I8,10X,I8) 00097 500 CONTINUE 00098 STOP 00099 END 00100