Initial revision

2000-02-07 10:38:55 +00:00
commit fdc6b051c9
846 changed files with 230218 additions and 0 deletions
--- a/difrac/wrbas.f
+++ b/difrac/wrbas.f
@@ -0,0 +1,77 @@
+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