SUBROUTINE ABQMAIN
C
C     POSTPROCESSING PROGRAM SDVFVFOR
C
C
C Postprocessing program for transferring solution dependent state variables
C from a heat transfer analysis as field variables in the subsequent stress 
C analysis. The appropriate attribute corresponsing to record key 5 is copied
C to the second attribute of record key 201
C============================================================================
C This program must be compiled and linked with the ABAQUS SHARED and 
C INTERFACE libraries by running "abaqus make job=fjoinfor".
C============================================================================
C  Input results file: 'FNAME'.fil
C  Output file name:   'FNAME'.fin
C
C The input results file should be a binary file and the output will be
C written as a binary file.
C
C============================================================================
C
C  Variables used by this program:
C
C   ARRAY  -- Real array containing values read from results file (.fil).
C               Equivalenced to JRRAY.
C   JRRAY  -- Integer array containing values read from results file (.fil).
C               Equivalenced to ARRAY.
C   FNAME  -- Root file name of input file(s) and output file.
C   NRU    -- Number of results files (.fil) to be read.
C   LRUNIT -- Array containing unit number and format of results files:
C               LRUNIT(1,*) --> Unit number of input file.
C               LRUNIT(2,*) --> Format of input file.
C   LOUTF  -- Format of output file:
C               1 --> ABAQUS results file ASCII format.
C               2 --> ABAQUS results file binary format.
C   JUNIT  -- Unit number of file to be opened.
C   JRCD   -- Error check return code:
C               .EQ. 0 --> No errors.
C               .NE. 0 --> Errors detected.
C   KEY    -- Current record key identifier.
C
C============================================================================
C
C  The use of ABA_PARAM.INC eliminates the need to have different versions  
C  of the code for single and double precision.  ABA_PARAM.INC defines an 
C  appropriate IMPLICIT REAL statement and sets the value of NPRECD to 1 or 
C  2, depending on whether the machine uses single or double precision.  
C  ABA_PARAM.INC is referenced from the [.SITE] (for VMS) or /site (for Unix) 
C  ABAQUS release subdirectory when ABAQUS/Make is executed.
C
C============================================================================
C
      INCLUDE 'aba_param.inc'
      DIMENSION  ARRAY(513), JRRAY(NPRECD,513), XSDV(10000)
      EQUIVALENCE (ARRAY(1), JRRAY(1,1))
C     
      INTEGER  LRUNIT(2,1),NNUM
      CHARACTER  FNAME*80
      LRUNIT(1,1)=8
      LRUNIT(2,1)=2
      LOUTF=2
      FNAME='xsdvttrt'
C     
      CALL  INITPF (FNAME, 1, LRUNIT, LOUTF)
C     
      KEYPRV = 0
      JUNIT = LRUNIT(1,1)
      CALL  DBRNU (JUNIT)
C     
C     Cover a maximum of 10 million records in the file.
C     
      DO 80 IXX2 = 1, 100
         DO 80 IXX = 1, 100
            CALL DBFILE(0,ARRAY,JRCD)
C     IF KEY=1, STORE THE NODE NUMBER FROM THE APPROPRIATE ATTRIBUTE.
            IF(JRRAY(1,2) .EQ. 1) THEN
               NNUM=JRRAY(1,3)
            ENDIF
C     IF KEY=5, STORE THE STATE VAR. FROM THE APPROPRIATE ATTRIBUTE.
            IF(JRRAY(1,2) .EQ. 5) THEN
               XSDV(NNUM)=ARRAY(3)
            ENDIF
C     IF KEY=201, SAVE THE STATE VAR. FROM THE APPROPRIATE ATTRIBUTE.
            IF(JRRAY(1,2) .EQ. 201) THEN
               ARRAY(4)=XSDV(JRRAY(1,3))
            ENDIF
            IF (JRCD .NE. 0 .AND. KEYPRV .EQ. 2001) THEN
               WRITE(6,*) 'END OF FILE '
               CLOSE (JUNIT)
               GOTO 110
            ELSE IF (JRCD .NE. 0) THEN
               WRITE(6,*) 'ERROR READING FILE '
               CLOSE (JUNIT)
               GOTO 110
            ENDIF
            KEY=JRRAY(1,2)
            IF((KEY.EQ.1900).OR.(KEY.EQ.1901).OR.(KEY.EQ.1902).OR.
     1           (KEY.EQ.1910).OR.(KEY.EQ.1911).OR.(KEY.EQ.1921).OR.
     2           (KEY.EQ.1922).OR.(KEY.EQ.1980).OR.(KEY.EQ.2000).OR.
     3           (KEY.EQ.2001).OR.(KEY.EQ.1).OR.(KEY.EQ.201)) THEN
               CALL DBFILW(1,ARRAY,JRCD)
            ENDIF      
            KEYPRV = JRRAY(1,2)
 80      CONTINUE
 110     CONTINUE
         END