      SUBROUTINE FOGCM(IUINPT,IPROCC)
C     ****
C     ****     THIS SUBROUTINE RUNS THE TIEGCM IN MANNER DETERMINED BY
C     ****       PARAMETERS IUINPT, IPROC AND BY CONTENTS OF LEXICAL REA
C     ****
C     ****       IUINPT = UNIT NUMBER FOR LEXICAL READ
C     ****             (= 5 FOR NORMAL MODEL RUN)
C     ****       IPROCC = 0 FOR NORMAL MODEL RUN
C     ****              = 1 FOR PROCESSOR RUN
C     ****
C     ****
C     ****                   CRAY1 VERSION OF THIRD GENERATION GCM
C     ****                   DECEMBER, 1977
C     ****
      include "params.h"
      include "blnk.h"
      include "buff.h"
      include "vscr.h"
      include "rfft.h"
      include "cons.h"
      include "index.h"
      include "strt.h"
      include "tlib.h"
      include "unit.h"
      include "sechis.h"
      include "amie.h"
C     ****                   SET UP ADDRESS FOR RETURN OF CONTROL
C     ****                   IN THE EVENT OF AN ERROR EXIT
C     ****                   INITIALIZE THE MODEL
C     ****
C     ****
C     ****     COPY IPROCC TO IPROC IN COMMON/STRT/
C     ****
      IPROC = IPROCC
C     ****     INITIALIZE GKS
C     ****
      IF(IPROC.EQ.0)CALL OPNGKS
      CALL START
C     ****
C     ****     IF IPROC.EQ.1, ALLOCATE SPACE FOR HISTORY FIELDS
C     ****
      IF(IPROC.EQ.1)CALL ALOCBF
      GO TO 20
C     ****                   ADVANCE THE MODEL IN TIME
   10 CALL ADVNCE
C     ****     CHECK FOR HISTORY FILE WRITE
!     write(6,"('FOGCM after ADVNCE: ihis=',i3,' ihissech=',i3,
!    +  ' isav=',i3,' isavsech=',i3)") ihis,ihissech,isav,isavsech
 20   if (ihis.ne.0.and.ihissech.ne.0) goto 30
      IF (IPROC.LE.0) THEN
        if (ihis.eq.0) call output(0)           ! write a full restart history
        if (ihissech.eq.0) call output(1)       ! write a secondary history
      ELSE
        UTHR = AMOD(FLOAT(ITER)*C(4),86400.) / 3600.
        write(6,"('FOGCM: uthr=',f7.3,' mtime=',3i4)") uthr,mtime
      ENDIF
C     ****     CHECK FOR ERROR IN OUTPUT
      IF(NERR.EQ.0)GO TO 30
      NERR=0
      if (iproc.le.0) then
        if (isav.eq.0) call wtsave(0)
        if (isavsech.eq.0) call wtsave(1)
      endif
C     ****
C     ****     CLOSE UNITS 8, 9, 16, GKS
C     ****
      IF(IPROC.EQ.0)CALL CLSGKS
      CLOSE(UNIT=8,IOSTAT=IOS1,STATUS='DELETE',ERR=7890)
 7890 CONTINUE
      CLOSE(UNIT=9,IOSTAT=IOS2,STATUS='DELETE',ERR=8901)
 8901 CONTINUE
      IOS3 = 3
      CLOSE(UNIT=17,IOSTAT=IOS3,STATUS='DELETE',ERR=9012)
 9012 CONTINUE
      IOS4 = 0
      IOS5 = 0
      IF(IAMIE.EQ.1)THEN
	CLOSE(UNIT=15,IOSTAT=IOS4,STATUS='DELETE',ERR=1234)
 1234   CONTINUE
	CLOSE(UNIT=16,IOSTAT=IOS5,STATUS='DELETE',ERR=1235)
 1235   CONTINUE
      ENDIF
      IF(IOS1+IOS2+IOS3+IOS4+IOS5.NE.0)THEN
	WRITE(6,6543)IOS1,IOS2,IOS3,IOS4,IOS5
 6543   FORMAT(* FOGCM --- PROBLEM CLOSING UNITS 8,9,17,15,16 IOS=*,5I5)
        STOP
      ENDIF
      RETURN
C     ****     CHECK FOR SAVE TAPE WRITE
 30   if (isav.ne.0.and.isavsech.ne.0) goto 40
      if (iproc.le.0) then
        if (isav.eq.0) call wtsave(0)
        if (isavsech.eq.0) call wtsave(1)
      endif
 40   if (iter.lt.nstp) goto 10                 ! do another advnce call
      if (iend.eq.2) then
        nstp = nnstp(2)
        mhis = mmhis(2)
        ihis = mhis
        ihissech = mhissech
        iend = 1
        goto 10
      endif
c
c 5/98: secondary histories do not check for iend==2.
      IF(IEND.EQ.2) THEN
          NSTP=NNSTP(2)
          MHIS=MMHIS(2)
          IHIS=MHIS
          IEND=1
          GO TO 10
      END IF
      WRITE(6,100)ITER
  100 FORMAT(*1NORMAL EXIT AT ITER=*I6)
C     ****
C     ****     CLOSE UNITS 8, 9, 16, GKS
C     ****
      IF(IPROC.EQ.0)CALL CLSGKS
      CLOSE(UNIT=8,IOSTAT=IOS1,STATUS='DELETE',ERR=9876)
 9876 CONTINUE
      CLOSE(UNIT=9,IOSTAT=IOS2,STATUS='DELETE',ERR=8765)
 8765 CONTINUE
      IOS3 = 3
      CLOSE(UNIT=17,IOSTAT=IOS3,STATUS='DELETE',ERR=7654)
 7654 CONTINUE
      IOS4 = 0
      IOS5 = 0
      IF(IAMIE.EQ.1)THEN
	CLOSE(UNIT=15,IOSTAT=IOS4,STATUS='DELETE',ERR=2234)
 2234   CONTINUE
	CLOSE(UNIT=16,IOSTAT=IOS5,STATUS='DELETE',ERR=2235)
 2235   CONTINUE
      ENDIF
      IF(IOS1+IOS2+IOS3+IOS4+IOS5.NE.0)THEN
	WRITE(6,6543)IOS1,IOS2,IOS3,IOS4,IOS5
        STOP
      ENDIF

C  Close XDR files
c     subroutine wrxdr(flnm,f,nx,ny,xx,yy,xlab,ylab,lab1,
c    +  lab2,lab3,lab4,mtime,iclose)
c
!         iclose = 1
!	  istat = wrxdr('tec.xdr',
!    +  dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,idum,iclose) 
!	  istat = wrxdr('qjn.xdr',
!    +  dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,idum,iclose) 
!	  istat = wrxdr('sigp.xdr',
!    +  dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,idum,iclose) 
!	  istat = wrxdr('sigh.xdr',
!    +  dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,idum,iclose) 
!	  istat = wrxdr('qwind.xdr',
!    +  dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,idum,iclose) 
!	  istat = wrxdr('qamie.xdr',
!    +  dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,idum,iclose) 
!	  istat = wrxdr('wtot.xdr',
!    +  dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,idum,iclose) 
!	  istat = wrxdr('work.xdr',
!    +  dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,idum,iclose) 
!	  istat = wrxdr('ftot.xdr',
!    +  dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,idum,iclose) 
!	  istat = wrxdr('famie.xdr',
!    +  dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,idum,iclose) 
!	  istat = wrxdr('fwind.xdr',
!    +  dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,dum,idum,iclose) 
c	call sendms('tec.xdr','/GANGLU/TIEO95/TEC19_O95.XDR')
c	call sendms('qjn.xdr','/GANGLU/TIEO95/QJN19_O95.XDR')
c	call sendms('sigp.xdr','/GANGLU/TIEO95/SIGP19_O95.XDR')
c	call sendms('sigh.xdr','/GANGLU/TIEO95/SIGH19_O95.XDR')
c	call sendms('qwind.xdr','/GANGLU/TIEO95/QWIND19_O95.XDR')
c	call sendms('qamie.xdr','/GANGLU/TIEO95/QAMIE19_O95.XDR')
c	call sendms('wtot.xdr','/GANGLU/TIEO95/WTOT19_O95.XDR')
c	call sendms('work.xdr','/GANGLU/TIEO95/WORK19_O95.XDR')
c	call sendms('ftot.xdr','/GANGLU/TIEO95/FTOT19_O95.XDR')
c	call sendms('famie.xdr','/GANGLU/TIEO95/FAMIE19_O95.XDR')
c	call sendms('fwind.xdr','/GANGLU/TIEO95/FWIND19_O95.XDR')
c     call rcpfile (0,'tec.xdr',
c    +  'cedar.hao:/d/ganglu/xdr/tec19_o95.xdr')
c     call rcpfile (0,'qjn.xdr',
c    +  'cedar.hao:/d/ganglu/xdr/qjn19_o95.xdr')
c     call rcpfile(0,'sigp.xdr',
c    +	'cedar.hao:/d/ganglu/xdr/sigp19_o95.xdr')
c     call rcpfile(0,'sigh.xdr',
c    +	'cedar.hao:/d/ganglu/xdr/sigh19_o95.xdr')
c     call rcpfile (0,'qwind.xdr',
c    +	'cedar.hao:/d/ganglu/xdr/qwind19_o95.xdr')
c     call rcpfile (0,'qamie.xdr',
c    +	'cedar.hao:/d/ganglu/xdr/qamie19_o95.xdr')
c     call rcpfile(0,'wtot.xdr',
c    +	'cedar.hao:/d/ganglu/xdr/wtot19_o95.xdr')
c     call rcpfile(0,'work.xdr',
c    +	'cedar.hao:/d/ganglu/xdr/work19_o95.xdr')
c     call rcpfile (0,'fwind.xdr',
c    +	'cedar.hao:/d/ganglu/xdr/fwind19_o95.xdr')
c     call rcpfile (0,'famie.xdr',
c    +	'cedar.hao:/d/ganglu/xdr/famie19_o95.xdr')
c     call rcpfile(0,'ftot.xdr',
c    +	'cedar.hao:/d/ganglu/xdr/ftot19_o95.xdr')

!	  call sendms('tec.xdr','/GANGLU/TIEJ97/TEC11_J97.XDR')
!	  call sendms('qjn.xdr','/GANGLU/TIEJ97/QJN11_J97.XDR')
!	  call sendms('sigp.xdr','/GANGLU/TIEJ97/SIGP11_J97.XDR')
!	  call sendms('sigh.xdr','/GANGLU/TIEJ97/SIGH11_J97.XDR')
!	  call sendms('qwind.xdr','/GANGLU/TIEJ97/QWIND11_J97.XDR')
!	  call sendms('qamie.xdr','/GANGLU/TIEJ97/QAMIE11_J97.XDR')
!	  call sendms('wtot.xdr','/GANGLU/TIEJ97/WTOT11_J97.XDR')
!	  call sendms('work.xdr','/GANGLU/TIEJ97/WORK11_J97.XDR')
!	  call sendms('ftot.xdr','/GANGLU/TIEJ97/FTOT11_J97.XDR')
!	  call sendms('famie.xdr','/GANGLU/TIEJ97/FAMIE11_J97.XDR')
!	  call sendms('fwind.xdr','/GANGLU/TIEJ97/FWIND11_J97.XDR')
!     call rcpfile (0,'tec.xdr',
!    +  'cedar.hao:/d/ganglu/xdr/tec11_j97.xdr')
!     call rcpfile (0,'qjn.xdr',
!    +  'cedar.hao:/d/ganglu/xdr/qjn11_j97.xdr')
!     call rcpfile(0,'sigp.xdr',
!    +	'cedar.hao:/d/ganglu/xdr/sigp11_j97.xdr')
!     call rcpfile(0,'sigh.xdr',
!    +	'cedar.hao:/d/ganglu/xdr/sigh11_j97.xdr')
!     call rcpfile (0,'qwind.xdr',
!    +	'cedar.hao:/d/ganglu/xdr/qwind11_j97.xdr')
!     call rcpfile (0,'qamie.xdr',
!    +	'cedar.hao:/d/ganglu/xdr/qamie11_j97.xdr')
!     call rcpfile(0,'wtot.xdr',
!    +	'cedar.hao:/d/ganglu/xdr/wtot11_j97.xdr')
!     call rcpfile(0,'work.xdr',
!    +	'cedar.hao:/d/ganglu/xdr/work11_j97.xdr')
!     call rcpfile (0,'fwind.xdr',
!    +	'cedar.hao:/d/ganglu/xdr/fwind11_j97.xdr')
!     call rcpfile (0,'famie.xdr',
!    +	'cedar.hao:/d/ganglu/xdr/famie11_j97.xdr')
!     call rcpfile(0,'ftot.xdr',
!    +	'cedar.hao:/d/ganglu/xdr/ftot11_j97.xdr')

      RETURN
      END
C
