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