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