A sample FORTRAN program

A sample FORTRAN program is contained in the PATCH FATUSER on the FATMEN PAM. A CRADLE to produce this FORTRAN is currently stored in FATUSER CRADLE on FAT3's 191 disk on CERNVM. An additional example is given below: this example loads information from DELPHI's Production Summary File (PSF) and adds it to the FATMEN file catalogue.

Other examples programs, including generation of a FORTRAN program from scratch, are to be found in the tutorial section of this manual.

                       Example of a PSF file
                                  

COMM ***********************************************************************************
COMM ***                                   Institute and computer identifier
COMM ***********************************************************************************
INST CERN CC           IBM3090
COMM ***********************************************************************************
COMM ***                   List of Raw Data cass. from august 1989 Pilot Run
COMM ***********************************************************************************
TDAS EP0001                                       X ALLD/RAWD/E091.0
       0/P01R000314/NONE/F001/CERN/V001/#000003/#000384*
UDAS No S-O-R.
TDAS EP0002                                           X ALLD/RAWD/E091.00
     /P01R000315/NONE/F001/CERN/V001/#000002/#000140
TDAS EP0003 C                                         X ALLD/RAWD/E091.00
     /P01R000315/NONE/F002/CERN/V001/#100002/#100203
UDAS 100000 added to event numbers because of duplicate run/event numbering in
              DAS system
TDAS EP0004 C01             X ALLD/RAWD/E091.00/P01R000315/NONE/F003/CERN/V001/#
200002/#203148
UDAS 200000 added to event numbers because of duplicate run/event numbering in
       DAS system
TDAS EP0005   C 01                                      X ALLD/RAWD/E091.00
    /P01R000316/NONE/F001/CERN/V001/#000002/#000193
TDAS EP0006   C 01                                      X ALLD/RAWD/E091.00
    /P01R000317/NONE/F001/CERN/V001/#000002/#000235
TDAS EP0007   C 01                                      X ALLD/RAWD/E091.00
/P01R000317/NONE/F002/CERN/V001/#000002/#000222
TDAS EP0008   C 01                                      X ALLD/RAWD/E091.00/
P01R000318/NONE/F001/CERN/V001/#000003/#000786
UDAS No S-O-R.
              Using the FATMEN database from FORTRAN
                                  

      PROGRAM FATDEL
*----------------------------------------------------------------------*
*                                                                      *
* Example FATMEN program, which reads DELPHI Production Summary File   *
* and adds information to FATMEN database.                             *
* In this example, only TDAS records are processed.                    *
*                                                                      *
*----------------------------------------------------------------------*
*
*     Stuff for ZEBRA
*
      PARAMETER (LURCOR=200000)
      COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
      DIMENSION    LQ(999),IQ(999),Q(999)
      EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
      COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
      COMMON /QUEST/IQUEST(100)
      PARAMETER       (LKEYFA=10)
      DIMENSION KEY(LKEYFA)
      CHARACTER*1 CHLUN
*
*     Initialise ZEBRA
*
      CALL MZEBRA(-3)
      CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
     +            BLVECT(5000),BLVECT(LURCOR))
      CALL MZLOGL(IXSTOR,-3)
*
* *** Define user division and link area like:
*
      CALL MZDIV  (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
      CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
*
*     Units for RZ database, FZ update files and PSF
*
      LUNRZ  = 1
      LUNFZ  = 2
      LUNPSF = 3
*
*     Issue FILEDEF for PSF
*
      WRITE(CHLUN,'(I1)') LUNPSF
      CALL VMCMS('FILEDEF '//CHLUN//
     +' DISK CERN PSF * (LRECL 132 RECFM F)',IRC)
*
*     Initialise FATMEN for DELPHI
*
      CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/DELPHI',IRC)
*
*     Process information in PSF
*
      CALL ADDPSF(LUNPSF)
      END
      SUBROUTINE ADDPSF(LUNPSF)
* Start sequence FATPARA
*
*          Keys
      PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
     1           ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
*
** ***     Bank offsets
*
      PARAMETER ( MFQNFA=  1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
     1           ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
     2           ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
     3           ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
     4           ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
     5           ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
     6           ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
     7           ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
     8           ,MUSWFA=116, MUCMFA=126, NWDSFA=145
     9           ,MFSZFA=MSYWFA)
* End   sequence FATPARA
      PARAMETER (LURCOR=200000)
      COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
      DIMENSION    LQ(999),IQ(999),Q(999)
      EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
*
      COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
*
      COMMON /QUEST/IQUEST(100)
      PARAMETER (LKEYFA=10)
      DIMENSION KEYS(LKEYFA)
      CHARACTER*132 CARD
      CHARACTER*240 GENEN
      CHARACTER     UFORM(4)*1,FFORM(4)*2
      DATA          UFORM/'N','X','A','G'/
      DATA          FFORM/'FZ','FX','FA','AS'/
      DATA NCARDS/0/,NPROC/0/
 1    CONTINUE
*
*     Process all records in file
*
      READ(LUNPSF,'(A132)',END=99) CARD
      NCARDS = NCARDS + 1
*
*     Got a PSF line, now process
*
      IF (CARD(1:4) .EQ. 'TDAS') THEN
         PRINT *,'Processing ',CARD
         NPROC = NPROC + 1
*
*     Format of TDAS card is:
*
*23456789_123456789_123456789_123456789_123456789_123456789_123456789_
*KEY VID----- M FS                                      F Generic name
*
*     where M  = media type (C=cart, T=tape)
*           FS = File sequence number
*           F  = file format
*
         CALL CFILL(' ',GENEN,1,240)
         GENEN = CARD(59:119)
         LGEN = LENOCC(GENEN)
*
*     Create bank for this generic name
*
         CALL FMLIFT('//CERN/DELPHI/'//GENEN(1:LGEN),
     +   KEYS,'3480','U',IRC)
*
*     Get address of the bank
*
         CALL FMLINK('//CERN/DELPHI/'//GENEN(1:LGEN),LFAT,' ',IRC)
*
*     Dataset name is always DELPHI
*
         CALL UCTOH('DELPHI',IQ(LFAT+MFQNFA),4,6)
*
*     Set values according to information found in PSF
*
         READ(CARD(17:18),'(I2)') IFILE
         IQ(LFAT+MFSQFA) = IFILE
         CALL UCTOH(CARD(6:13),IQ(LFAT+MVIDFA),4,6)
         CALL UCTOH(CARD(6:13),IQ(LFAT+MVSNFA),4,6)
         IMATCH = ICNTH(CARD(57:57),UFORM,4)
         CALL UCTOH(FFORM(IMATCH),IQ(LFAT+MFLFFA),4,2)
*
*     Write bank to RZ file (and ORACLE...)
*
         CALL FMPUT('//CERN/DELPHI/'//GENEN(1:LGEN),LFAT,IRC)
         ELSE
*        PRINT *,'Unrecognised card ',CARD(1:4)
         ENDIF
      GOTO 1
99    CONTINUE
      PRINT *,'EOF on PSF file found, LUN=',LUNPSF
      PRINT *,NCARDS,' records found, of which ',NPROC,' processed'
      END