Nbody6
 All Files Functions Variables
mydump.f
Go to the documentation of this file.
1  SUBROUTINE mydump(II,J)
2 *
3 *
4 * COMMON save or read.
5 * --------------------
6 *
7  IMPLICIT REAL*8 (a-h,o-z)
8  include 'params.h'
9  parameter(na=84,nb=168,nc=530,nd=392+mlr+mld+mlv,ne=24,nm=40,
10  & ng=84+2*kmax,nl=99,no=20*mcl+16,np=32*ntmax,nq=31*mmax,
11  & ns=44*mmax)
12  REAL*4 a,b,c,d,e,g,l,m,o,p,q,s
13  INTEGER k,i,ntsave
14 *
15  common/names/ ntot,npairs,nttot,a(na)
16  common/counts/ b(nb)
17  common/params/ c(nc)
18  common/stars/ d(nd)
19  common/plpot/ e(ne)
20  common/blocks/ g(ng)
21  common/rand2/ l(nl)
22  common/galaxy/ m(nm)
23  common/clouds/ o(no)
24  common/modes/ p(np)
25  common/rche/ q(nq)
26  common/binary/ s(ns)
27 
28  common/nbody/ x(3,nmax),x0(3,nmax),x0dot(3,nmax),f(3,nmax),
29  & fdot(3,nmax),body(nmax),rs(nmax),xdot(3,nmax),
30  & fi(3,nmax),d1(3,nmax),d2(3,nmax),d3(3,nmax),
31  & fr(3,nmax),d1r(3,nmax),d2r(3,nmax),d3r(3,nmax),
32  & step(nmax),t0(nmax),stepr(nmax),t0r(nmax),
33  & tnew(nmax),radius(nmax),tev(nmax),tev0(nmax),
34  & body0(nmax),epoch(nmax),spin(nmax),xstar(nmax),
35  & zlmsty(nmax),fidot(3,nmax),d0(3,nmax),
36  & frdot(3,nmax),d0r(3,nmax),kstar(nmax)
37 *
38  common/pairs/ u(4,kmax),u0(4,kmax),udot(4,kmax),fu(4,kmax),
39  & fudot(4,kmax),fudot2(4,kmax),fudot3(4,kmax),
40  & h(kmax),hdot(kmax),hdot2(kmax),hdot3(kmax),
41  & hdot4(kmax),dtau(kmax),tdot2(kmax),tdot3(kmax),
42  & r(kmax),r0(kmax),gamma(kmax),sf(7,kmax),h0(kmax),
43  & fp0(4,kmax),fd0(4,kmax),tblist,dtb,kblist(kmax),
44  & kslow(kmax),name(nmax),list(lmax,nmax)
45 *
46 * Open unit #J by reading dummy and rewinding.
47  rewind j
48  READ (j,err=10,end=10) dummy
49  10 rewind j
50 *
51 * Read or save all COMMON variables (valid for tape or disc).
52  IF (ii.NE.0) THEN
53 
54  WRITE (j) ntot,npairs,nttot,a,b,c,d,e,g,l,m,o,p,q,s
55 
56 * Check expanding arrays to include possible tidal tails (up to NTTOT).
57  ntsave = ntot
58  IF (nttot.GT.0) THEN
59  ntot = nttot
60  END IF
61 
62  WRITE (j) ((x(k,i),k=1,3),i=1,ntot),((x0(k,i),k=1,3),i=1,ntot)
63  * ,((x0dot(k,i),k=1,3),i=1,ntot),((f(k,i),k=1,3),i=1,ntot),
64  * ((fdot(k,i),k=1,3),i=1,ntot),(body(i),i=1,ntot),
65  * (rs(i),i=1,ntot),((xdot(k,i),k=1,3),i=1,ntot),
66  * ((fi(k,i),k=1,3),i=1,ntot),((d1(k,i),k=1,3),i=1,ntot),
67  * ((d2(k,i),k=1,3),i=1,ntot),((d3(k,i),k=1,3),i=1,ntot),
68  * ((fr(k,i),k=1,3),i=1,ntot),((d1r(k,i),k=1,3),i=1,ntot),
69  * ((d2r(k,i),k=1,3),i=1,ntot),((d3r(k,i),k=1,3),i=1,ntot),
70  * (step(i),i=1,ntot),(t0(i),i=1,ntot),(stepr(i),i=1,ntot),
71  * (t0r(i),i=1,ntot),(tnew(i),i=1,ntot),(radius(i),i=1,ntot),
72  * (tev(i),i=1,ntot),
73  * (tev0(i),i=1,ntot),(body0(i),i=1,ntot),(epoch(i),i=1,ntot),
74  * (spin(i),i=1,ntot),(xstar(i),i=1,ntot),(zlmsty(i),i=1,ntot),
75  * ((fidot(k,i),k=1,3),i=1,ntot),((d0(k,i),k=1,3),i=1,ntot),
76  * ((frdot(k,i),k=1,3),i=1,ntot),((d0r(k,i),k=1,3),i=1,ntot),
77  * (kstar(i),i=1,ntot)
78 
79  write (j) ((u(k,i),k=1,4),i=1,npairs),((u0(k,i),k=1,4),i=1,
80  * npairs),((udot(k,i),k=1,4),i=1,npairs),((fu(k,i),k=1,4),i=1,
81  * npairs),((fudot(k,i),k=1,4),i=1,npairs),((fudot2(k,i),k=1,4),
82  * i=1,npairs),((fudot3(k,i),k=1,4),i=1,npairs),(h(i),i=1,
83  * npairs),(hdot(i),i=1,npairs),(hdot2(i),i=1,npairs),
84  * (hdot3(i),i=1,npairs),(hdot4(i),i=1,npairs),(dtau(i),
85  * i=1,npairs),(tdot2(i),i=1,npairs),(tdot3(i),i=1,npairs),
86  * (r(i),i=1,npairs),(r0(i),i=1,npairs),(gamma(i),i=1,npairs),
87  * ((sf(k,i),k=1,7),i=1,npairs),(h0(i),i=1,npairs),((fp0(k,i),
88  * k=1,4),i=1,npairs),((fd0(k,i),k=1,4),i=1,npairs),tblist,dtb,
89  * (kblist(i),i=1,kmax),(kslow(i),i=1,npairs),(name(i),i=1,ntot)
90 
91  write (j) ((list(k,i),k=1,list(1,i)+1),i=1,ntot)
92 
93  END file j
94  CLOSE (unit=j)
95 * Restore standard array pointer.
96  ntot = ntsave
97  else
98 
99  READ (j) ntot,npairs,nttot,a,b,c,d,e,g,l,m,o,p,q,s
100 
101  if (ntot.gt.nmax) then
102  write (*,*) "DANGER NTOT > NMAX !"
103  stop
104  end if
105 
106  if (npairs.gt.kmax) then
107  write (*,*) "DANGER NPAIRS > KMAX !"
108  stop
109  end if
110 
111  ntsave = ntot
112  IF (nttot.GT.0) THEN
113  ntot = nttot
114  END IF
115 
116  read (j) ((x(k,i),k=1,3),i=1,ntot),((x0(k,i),k=1,3),i=1,ntot)
117  * ,((x0dot(k,i),k=1,3),i=1,ntot),((f(k,i),k=1,3),i=1,ntot),
118  * ((fdot(k,i),k=1,3),i=1,ntot),(body(i),i=1,ntot),
119  * (rs(i),i=1,ntot),((xdot(k,i),k=1,3),i=1,ntot),
120  * ((fi(k,i),k=1,3),i=1,ntot),((d1(k,i),k=1,3),i=1,ntot),
121  * ((d2(k,i),k=1,3),i=1,ntot),((d3(k,i),k=1,3),i=1,ntot),
122  * ((fr(k,i),k=1,3),i=1,ntot),((d1r(k,i),k=1,3),i=1,ntot),
123  * ((d2r(k,i),k=1,3),i=1,ntot),((d3r(k,i),k=1,3),i=1,ntot),
124  * (step(i),i=1,ntot),(t0(i),i=1,ntot),(stepr(i),i=1,ntot),
125  * (t0r(i),i=1,ntot),(tnew(i),i=1,ntot),(radius(i),i=1,ntot),
126  * (tev(i),i=1,ntot),
127  * (tev0(i),i=1,ntot),(body0(i),i=1,ntot),(epoch(i),i=1,ntot),
128  * (spin(i),i=1,ntot),(xstar(i),i=1,ntot),(zlmsty(i),i=1,ntot),
129  * ((fidot(k,i),k=1,3),i=1,ntot),((d0(k,i),k=1,3),i=1,ntot),
130  * ((frdot(k,i),k=1,3),i=1,ntot),((d0r(k,i),k=1,3),i=1,ntot),
131  * (kstar(i),i=1,ntot)
132 
133  read (j) ((u(k,i),k=1,4),i=1,npairs),((u0(k,i),k=1,4),i=1,
134  * npairs),((udot(k,i),k=1,4),i=1,npairs),((fu(k,i),k=1,4),i=1,
135  * npairs),((fudot(k,i),k=1,4),i=1,npairs),((fudot2(k,i),k=1,4),
136  * i=1,npairs),((fudot3(k,i),k=1,4),i=1,npairs),(h(i),i=1,
137  * npairs),(hdot(i),i=1,npairs),(hdot2(i),i=1,npairs),
138  * (hdot3(i),i=1,npairs),(hdot4(i),i=1,npairs),(dtau(i),
139  * i=1,npairs),(tdot2(i),i=1,npairs),(tdot3(i),i=1,npairs),
140  * (r(i),i=1,npairs),(r0(i),i=1,npairs),(gamma(i),i=1,npairs),
141  * ((sf(k,i),k=1,7),i=1,npairs),(h0(i),i=1,npairs),((fp0(k,i),
142  * k=1,4),i=1,npairs),((fd0(k,i),k=1,4),i=1,npairs),tblist,dtb,
143  * (kblist(i),i=1,kmax),(kslow(i),i=1,npairs),(name(i),i=1,ntot)
144 
145  read (j) (list(1,i),(list(k,i),k=2,list(1,i)+1),i=1,ntot)
146  ntot = ntsave
147  END IF
148 *
149  RETURN
150 *
151  END