1      subroutine argos_space_wtmro(lfnmro,stime,pres,temp,tempw,temps,
2     + iwl,iwlp,xw,vw,xwcr,isl,islp,xs,vs,ipl)
3c
4      implicit none
5c
6#include "argos_space_common.fh"
7#include "mafdecls.fh"
8#include "global.fh"
9c
10      integer lfnmro
11      real*8 stime,pres,temp,tempw,temps
12      integer iwl(mwm,miw2),isl(msa,mis2)
13      integer iwlp(mwm,npackw),islp(msa,npack)
14      real*8 xw(mwm,3,mwa),vw(mwm,3,mwa),xwcr(mwm,3)
15      real*8 xs(msa,3),vs(msa,3)
16      integer ipl(mbox,mip2)
17c
18      integer j,k,l,nwmn,nsan,node,ilp,ihp,jlp,jhp,ili,ihi,jli,jhi
19      integer ilw,ihw,jlw,jhw,ils,ihs,jls,jhs
20      character*10 rdate,rtime
21      character*18 user
22#ifdef USE_POSIXF
23      integer ilen,ierror
24#endif
25c
26      write(lfnmro) nwm,nwa,nsa,stime,temp,pres,vlat,nhist
27c
28      call swatch(rdate,rtime)
29#ifdef USE_POSIXF
30      call pxfgetlogin(user, ilen, ierror)
31#else
32      call getlog(user)
33#endif
34      if(user(18:18).ne.' ') user='                  '
35      hist(nhist)(1:18)=user
36      hist(nhist)(19:28)=rdate
37      hist(nhist)(29:48)=rtime
38      hist(nhist)(49:108)=project(1:60)
39      write(lfnmro) (hist(j),j=1,nhist)
40c
41      do 1 node=np-1,0,-1
42      call ga_distribution(ga_ip,node,ilp,ihp,jlp,jhp)
43      call ga_get(ga_ip,ilp,ihp,jlp,jhp,ipl,mbox)
44      write(lfnmro) ((ipl(j,k),j=1,mbox),k=1,mip2)
45      nwmn=ipl(1,2)
46      nsan=ipl(2,2)
47      if(nwmn.gt.0) then
48      call ga_distribution(ga_iw,node,ili,ihi,jli,jhi)
49      if(npackw.eq.0) then
50      call ga_get(ga_iw,ili,ili+nwmn-1,jli,jhi,iwl,mwm)
51      else
52      call ga_get(ga_iw,ili,ili+nwmn-1,jli,jli+npackw-1,iwlp,mwm)
53      call argos_space_unpackw(nwmn,iwl,iwlp)
54      endif
55      call ga_distribution(ga_w,node,ilw,ihw,jlw,jhw)
56      call ga_get(ga_w,ilw,ilw+nwmn-1,jlw,jlw+3*mwa-1,xw,mwm)
57      call ga_get(ga_w,ilw,ilw+nwmn-1,jlw+3*mwa,jlw+6*mwa-1,vw,mwm)
58      write(lfnmro) ((iwl(j,k),j=1,nwmn),k=1,miw2)
59      write(lfnmro) (((xw(j,k,l),j=1,nwmn),k=1,3),l=1,nwa)
60      write(lfnmro) (((vw(j,k,l),j=1,nwmn),k=1,3),l=1,nwa)
61      endif
62      if(nsan.gt.0) then
63      call ga_distribution(ga_is,node,ili,ihi,jli,jhi)
64      if(npack.eq.0) then
65      call ga_get(ga_is,ili,ili+nsan-1,jli,jhi,isl,msa)
66      else
67      call ga_get(ga_is,ili,ili+nsan-1,jli,jli+npack-1,islp,msa)
68      call argos_space_unpack(nsan,isl,islp)
69      endif
70      call ga_distribution(ga_s,node,ils,ihs,jls,jhs)
71      call ga_get(ga_s,ils,ils+nsan-1,jls,jls+2,xs,msa)
72      call ga_get(ga_s,ils,ils+nsan-1,jls+3,jls+5,vs,msa)
73      write(lfnmro) ((isl(j,k),j=1,nsan),k=1,mis2)
74      write(lfnmro) ((xs(j,k),j=1,nsan),k=1,3)
75      write(lfnmro) ((vs(j,k),j=1,nsan),k=1,3)
76      endif
77    1 continue
78c
79      return
80      end
81c $Id$
82