https://github.com/florentrenaud/nbody6tt
Raw File
Tip revision: 8aea50c213fd132d500c415511ae1e27eeabab80 authored by florent on 14 February 2015, 16:38:53 UTC
corrected mb typo in ttgalaxy
Tip revision: 8aea50c
mydump.f
      SUBROUTINE MYDUMP(II,J)
*
*
*       COMMON save or read.
*       --------------------
*
      IMPLICIT REAL*8  (A-H,O-Z)
      INCLUDE 'params.h'
      PARAMETER  (NA=84,NB=168,NC=530,ND=392+MLR+MLD+MLV,NE=24,NM=40,
     &    NG=84+2*KMAX,NL=99,NO=20*MCL+16,NP=32*NTMAX,NQ=31*MMAX,
     &    NS=44*MMAX)
      REAL*4  A,B,C,D,E,G,L,M,O,P,Q,S
      INTEGER K,I,NTSAVE
*** FlorentR - File name used for secured saving
      CHARACTER(LEN=8) FILENAME
*** FRenaud
*
      COMMON/NAMES/  NTOT,NPAIRS,NTTOT,A(NA)
      COMMON/COUNTS/ B(NB)
      COMMON/PARAMS/ C(NC)
      COMMON/STARS/  D(ND)
      COMMON/PLPOT/  E(NE)
      COMMON/BLOCKS/ G(NG)
      COMMON/RAND2/  L(NL)
      COMMON/GALAXY/ M(NM)
      COMMON/CLOUDS/ O(NO)
      COMMON/MODES/  P(NP)
      COMMON/RCHE/   Q(NQ)
      COMMON/BINARY/ S(NS)

      COMMON/NBODY/  X(3,NMAX),X0(3,NMAX),X0DOT(3,NMAX),F(3,NMAX),
     &               FDOT(3,NMAX),BODY(NMAX),RS(NMAX),XDOT(3,NMAX),
     &               FI(3,NMAX),D1(3,NMAX),D2(3,NMAX),D3(3,NMAX),
     &               FR(3,NMAX),D1R(3,NMAX),D2R(3,NMAX),D3R(3,NMAX),
     &               STEP(NMAX),T0(NMAX),STEPR(NMAX),T0R(NMAX),
     &               TNEW(NMAX),RADIUS(NMAX),TEV(NMAX),TEV0(NMAX),
     &               BODY0(NMAX),EPOCH(NMAX),SPIN(NMAX),XSTAR(NMAX),
     &               ZLMSTY(NMAX),FIDOT(3,NMAX),D0(3,NMAX),
     &               FRDOT(3,NMAX),D0R(3,NMAX),KSTAR(NMAX)
*
      COMMON/PAIRS/  U(4,KMAX),U0(4,KMAX),UDOT(4,KMAX),FU(4,KMAX),
     &               FUDOT(4,KMAX),FUDOT2(4,KMAX),FUDOT3(4,KMAX),
     &               H(KMAX),HDOT(KMAX),HDOT2(KMAX),HDOT3(KMAX),
     &               HDOT4(KMAX),DTAU(KMAX),TDOT2(KMAX),TDOT3(KMAX),
     &               R(KMAX),R0(KMAX),GAMMA(KMAX),SF(7,KMAX),H0(KMAX),
     &               FP0(4,KMAX),FD0(4,KMAX),TBLIST,DTB,KBLIST(KMAX),
     &               KSLOW(KMAX),NAME(NMAX),LIST(LMAX,NMAX)
*** FlorentR - New block used for tt treatment
      COMMON/TT/     TTENS(3,3,NBTTMAX),TTEFF(3,3),DTTEFF(3,3),
     &               TTTIME(NBTTMAX), TTUNIT, NBTT, TTMODE, TTDX
*** FRenaud
*
*       Open unit #J by reading dummy and rewinding.
      REWIND J
      READ (J,ERR=10,END=10)  DUMMY
   10 REWIND J
*
*       Read or save all COMMON variables (valid for tape or disc).
      IF (II.NE.0) THEN
*** FlorentR - save previous restart file
        IF (j.EQ.2) THEN
           CALL RENAME('restart.tmp','restart.prev')
        ENDIF
*** FRenaud

        WRITE (J) ntot,npairs,nttot,a,b,c,d,e,g,l,m,o,p,q,s

*       Check expanding arrays to include possible tidal tails (up to NTTOT).
        NTSAVE = NTOT
        IF (NTTOT.GT.0) THEN
            NTOT = NTTOT
        END IF

        WRITE (J) ((x(k,i),k=1,3),i=1,ntot),((x0(k,i),k=1,3),i=1,ntot)
     *   ,((x0dot(k,i),k=1,3),i=1,ntot),((f(k,i),k=1,3),i=1,ntot),
     *   ((fdot(k,i),k=1,3),i=1,ntot),(body(i),i=1,ntot),
     *   (rs(i),i=1,ntot),((xdot(k,i),k=1,3),i=1,ntot),
     *   ((fi(k,i),k=1,3),i=1,ntot),((d1(k,i),k=1,3),i=1,ntot),
     *   ((d2(k,i),k=1,3),i=1,ntot),((d3(k,i),k=1,3),i=1,ntot),
     *   ((fr(k,i),k=1,3),i=1,ntot),((d1r(k,i),k=1,3),i=1,ntot),
     *   ((d2r(k,i),k=1,3),i=1,ntot),((d3r(k,i),k=1,3),i=1,ntot),
     *   (step(i),i=1,ntot),(t0(i),i=1,ntot),(stepr(i),i=1,ntot),
     *   (t0r(i),i=1,ntot),(tnew(i),i=1,ntot),(radius(i),i=1,ntot),
     *   (tev(i),i=1,ntot),
     *   (tev0(i),i=1,ntot),(body0(i),i=1,ntot),(epoch(i),i=1,ntot),
     *   (spin(i),i=1,ntot),(xstar(i),i=1,ntot),(zlmsty(i),i=1,ntot),
     *   ((fidot(k,i),k=1,3),i=1,ntot),((d0(k,i),k=1,3),i=1,ntot),
     *   ((frdot(k,i),k=1,3),i=1,ntot),((d0r(k,i),k=1,3),i=1,ntot),
     *   (kstar(i),i=1,ntot)

        write (J) ((u(k,i),k=1,4),i=1,npairs),((u0(k,i),k=1,4),i=1,
     *    npairs),((udot(k,i),k=1,4),i=1,npairs),((fu(k,i),k=1,4),i=1,
     *    npairs),((fudot(k,i),k=1,4),i=1,npairs),((fudot2(k,i),k=1,4),
     *    i=1,npairs),((fudot3(k,i),k=1,4),i=1,npairs),(h(i),i=1,
     *    npairs),(hdot(i),i=1,npairs),(hdot2(i),i=1,npairs),  
     *    (hdot3(i),i=1,npairs),(hdot4(i),i=1,npairs),(dtau(i),
     *    i=1,npairs),(tdot2(i),i=1,npairs),(tdot3(i),i=1,npairs),
     *    (r(i),i=1,npairs),(r0(i),i=1,npairs),(gamma(i),i=1,npairs),
     *    ((sf(k,i),k=1,7),i=1,npairs),(h0(i),i=1,npairs),((fp0(k,i), 
     *    k=1,4),i=1,npairs),((fd0(k,i),k=1,4),i=1,npairs),tblist,dtb,
     *   (kblist(i),i=1,kmax),(kslow(i),i=1,kmax),(name(i),i=1,ntot)

        write (J) ((list(k,i),k=1,list(1,i)+2),i=1,ntot)
*** FlorentR
        write (J) ttunit, nbtt, ttmode
        write (J) (((ttens(k,i,kk),k=1,3),i=1,3),kk=1,nbtt),
     *      ((tteff(k,i),k=1,3),i=1,3),((dtteff(k,i),k=1,3),i=1,3),
     *      (tttime(i),i=1,nbtt)
*** FRenaud

        END FILE J
        CLOSE (UNIT=J)
*** FlorentR - There is a risk that the code stops before fort.x
*       (x=1 or 2) is fully written. To avoid that, fort.x is renamed 
*       into restart.tmp when it is complete.
        WRITE(FILENAME,'("fort.",I1)') J
	    CALL RENAME(FILENAME,'restart.tmp')
*** FRenaud
*       Restore standard array pointer.
        NTOT = NTSAVE
      else
*** FlorentR - open explicitely
        OPEN(UNIT=J,FILE='restart.dat',STATUS='UNKNOWN',
     *     FORM='UNFORMATTED')
*** FRenaud
        READ (J) ntot,npairs,nttot,a,b,c,d,e,g,l,m,o,p,q,s

        if (ntot.gt.nmax) then
          write (*,*) "DANGER NTOT > NMAX !"
          stop
        end if

        if (npairs.gt.kmax) then
          write (*,*) "DANGER NPAIRS > KMAX !"
          stop
        end if 

        NTSAVE = NTOT
        IF (NTTOT.GT.0) THEN
            NTOT = NTTOT
        END IF
         
        read (J) ((x(k,i),k=1,3),i=1,ntot),((x0(k,i),k=1,3),i=1,ntot)
     *   ,((x0dot(k,i),k=1,3),i=1,ntot),((f(k,i),k=1,3),i=1,ntot),
     *   ((fdot(k,i),k=1,3),i=1,ntot),(body(i),i=1,ntot),
     *   (rs(i),i=1,ntot),((xdot(k,i),k=1,3),i=1,ntot),
     *   ((fi(k,i),k=1,3),i=1,ntot),((d1(k,i),k=1,3),i=1,ntot),
     *   ((d2(k,i),k=1,3),i=1,ntot),((d3(k,i),k=1,3),i=1,ntot),
     *   ((fr(k,i),k=1,3),i=1,ntot),((d1r(k,i),k=1,3),i=1,ntot),
     *   ((d2r(k,i),k=1,3),i=1,ntot),((d3r(k,i),k=1,3),i=1,ntot),
     *   (step(i),i=1,ntot),(t0(i),i=1,ntot),(stepr(i),i=1,ntot),
     *   (t0r(i),i=1,ntot),(tnew(i),i=1,ntot),(radius(i),i=1,ntot),
     *   (tev(i),i=1,ntot),
     *   (tev0(i),i=1,ntot),(body0(i),i=1,ntot),(epoch(i),i=1,ntot),
     *   (spin(i),i=1,ntot),(xstar(i),i=1,ntot),(zlmsty(i),i=1,ntot),
     *   ((fidot(k,i),k=1,3),i=1,ntot),((d0(k,i),k=1,3),i=1,ntot),
     *   ((frdot(k,i),k=1,3),i=1,ntot),((d0r(k,i),k=1,3),i=1,ntot),
     *   (kstar(i),i=1,ntot)

        read (J) ((u(k,i),k=1,4),i=1,npairs),((u0(k,i),k=1,4),i=1,
     *    npairs),((udot(k,i),k=1,4),i=1,npairs),((fu(k,i),k=1,4),i=1,
     *    npairs),((fudot(k,i),k=1,4),i=1,npairs),((fudot2(k,i),k=1,4),
     *    i=1,npairs),((fudot3(k,i),k=1,4),i=1,npairs),(h(i),i=1,
     *    npairs),(hdot(i),i=1,npairs),(hdot2(i),i=1,npairs),
     *    (hdot3(i),i=1,npairs),(hdot4(i),i=1,npairs),(dtau(i),
     *    i=1,npairs),(tdot2(i),i=1,npairs),(tdot3(i),i=1,npairs),
     *    (r(i),i=1,npairs),(r0(i),i=1,npairs),(gamma(i),i=1,npairs),
     *    ((sf(k,i),k=1,7),i=1,npairs),(h0(i),i=1,npairs),((fp0(k,i),
     *    k=1,4),i=1,npairs),((fd0(k,i),k=1,4),i=1,npairs),tblist,dtb,
     *   (kblist(i),i=1,kmax),(kslow(i),i=1,kmax),(name(i),i=1,ntot)

        read (J) (list(1,i),(list(k,i),k=2,list(1,i)+2),i=1,ntot)
*** FlorentR
        read (J) ttunit, nbtt, ttmode

        if (nbtt.gt.nbttmax.AND.TTMODE.EQ.TRUE) then
          write (*,*) "DANGER NBTT > NBTTMAX !"
          stop
        end if

        read (J) (((ttens(k,i,kk),k=1,3),i=1,3),kk=1,nbtt),
     *    ((tteff(k,i),k=1,3),i=1,3),((dtteff(k,i),k=1,3),i=1,3),
     *    (tttime(i),i=1,nbtt)

        CLOSE(J)
*** FRenaud
        NTOT = NTSAVE
      END IF
*
      RETURN
*
      END
back to top