78 lines
3.5 KiB
Fortran
78 lines
3.5 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C Routine to read and write the basic data to and from IDATA.DA
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE WRBAS
|
|
INCLUDE 'COMDIF'
|
|
C-----------------------------------------------------------------------
|
|
C If called from ANGVAL or RB read from IDATA
|
|
C If called from RB, read from IDATA after confirming
|
|
C As of 18-Jun-94 record 1 has 84 variables,
|
|
C record 2 85 " (5-Oct-95)
|
|
C record 3 85 "
|
|
C-----------------------------------------------------------------------
|
|
IF (KI .EQ. 'AN' .OR. KI .EQ. 'RB') THEN
|
|
IF (KI .EQ. 'RB') THEN
|
|
WRITE (COUT,10000)
|
|
CALL YESNO ('Y',ANS)
|
|
IF (ANS .EQ. 'N') THEN
|
|
KI = ' '
|
|
RETURN
|
|
ENDIF
|
|
ENDIF
|
|
READ (IID,REC=1) R,WAVE,DCHI,DOMEGA,DTHETA,THEMIN,THEMAX,
|
|
$ AS,BS,CS,DPSI,PSIMIN,PSIMAX,PRESET,QTIME,
|
|
$ TMAX,PA,PM,IHMAX,IKMAX,ILMAX,NCOND,ICOND,
|
|
$ IHS,IKS,ILS,IR,IS,STEP,STEPOF,
|
|
$ DFTYPE,DFMODL,NSTAN,NINTRR,
|
|
$ IHSTAN,IKSTAN,ILSTAN
|
|
READ (IID,REC=2) NSEG,NMSEG,
|
|
$ NREF,NMSTAN,NBLOCK,IHO,IKO,ILO,IND,ITYPE,
|
|
$ AP,APS,CANGS,SANGS,CANG,SANG,JMIN,JMAX,
|
|
$ RTHETA,ROMEGA,RCHI,RPHI,IH,IK,IL,
|
|
$ NINTOR,REOTOL,NATTEN,ATTEN,ICADSL,ICADSW
|
|
READ (IID,REC=3) IDH,ISCAN,FRAC,IBSECT,IPRFLG,ISYS,SINABS,
|
|
$ ILN,DELAY
|
|
READ (IID,REC=10) SGSYMB
|
|
IF (KI .EQ. 'RB') KI = ' '
|
|
ELSE
|
|
C-----------------------------------------------------------------------
|
|
C If called from GOLOOP, or WB, or creating file, write to IDATA
|
|
C If called from WB, write to IDATA after confirming
|
|
C-----------------------------------------------------------------------
|
|
IF (KI .EQ. 'WB') THEN
|
|
WRITE (COUT,11000)
|
|
CALL YESNO ('Y',ANS)
|
|
IF (ANS .EQ. 'N') THEN
|
|
KI = ' '
|
|
RETURN
|
|
ENDIF
|
|
ENDIF
|
|
CALL ANGET (RTHETA,ROMEGA,RCHI,RPHI)
|
|
WRITE (IID,REC=1) R,WAVE,DCHI,DOMEGA,DTHETA,THEMIN,THEMAX,
|
|
$ AS,BS,CS,DPSI,PSIMIN,PSIMAX,PRESET,QTIME,
|
|
$ TMAX,PA,PM,IHMAX,IKMAX,ILMAX,NCOND,ICOND,
|
|
$ IHS,IKS,ILS,IR,IS,STEP,STEPOF,
|
|
$ DFTYPE,DFMODL,NSTAN,NINTRR,
|
|
$ IHSTAN,IKSTAN,ILSTAN
|
|
WRITE (IID,REC=2) NSEG,NMSEG,
|
|
$ NREF,NMSTAN,NBLOCK,IHO,IKO,ILO,IND,ITYPE,
|
|
$ AP,APS,CANGS,SANGS,CANG,SANG,JMIN,JMAX,
|
|
$ RTHETA,ROMEGA,RCHI,RPHI,IH,IK,IL,
|
|
$ NINTOR,REOTOL,NATTEN,ATTEN,ICADSL,ICADSW
|
|
WRITE (IID,REC=3) IDH,ISCAN,FRAC,IBSECT,IPRFLG,ISYS,SINABS,
|
|
$ ILN,DELAY
|
|
WRITE (IID,REC=10) SGSYMB
|
|
C-----------------------------------------------------------------------
|
|
C Now force an update of the directory by closing and reopening IID
|
|
C-----------------------------------------------------------------------
|
|
IDREC = 85*IBYLEN
|
|
STATUS = 'OD'
|
|
CALL IBMFIL (IDNAME,-IID,IDREC,STATUS,IERR)
|
|
CALL IBMFIL (IDNAME, IID,IDREC,STATUS,IERR)
|
|
IF (KI .EQ. 'WB') KI = ' '
|
|
ENDIF
|
|
RETURN
|
|
10000 FORMAT (' Read the Basic Data (Y) ? ',$)
|
|
11000 FORMAT (' Write the Basic Data (Y) ? ',$)
|
|
END
|