1 subroutine argos_cafe_copya(ia,nami,wgti,numa,nam,wgt,num,ityp) 2c 3 implicit none 4c 5#include "argos_cafe_common.fh" 6#include "mafdecls.fh" 7c 8 integer ia 9 character*6 nami(24),nam(mat,nparms) 10 real*8 wgti(24),wgt(mat,mset) 11 integer numa(24),num(mat,nparms),ityp(mat,nparms) 12c 13 integer i 14c 15 if(.not.lfree) then 16 do 1 i=1,nparms 17 nam(ia,i)=nami(i) 18 wgt(ia,i)=wgti(i) 19 num(ia,i)=numa(i) 20 ityp(ia,i)=0 21 if(nam(ia,i)(6:6).eq.'Q') ityp(ia,i)=1 22 if(nam(ia,i)(6:6).eq.'H') ityp(ia,i)=2 23 1 continue 24 else 25 do 2 i=1,3 26 nam(ia,i)=nami(i) 27 wgt(ia,i)=wgti(i) 28 num(ia,i)=numa(i) 29 ityp(ia,i)=0 30 if(nam(ia,i)(6:6).eq.'Q') ityp(ia,i)=1 31 if(nam(ia,i)(6:6).eq.'H') ityp(ia,i)=2 32 2 continue 33 wgt(ia,4)=wgt(ia,3)-wgt(ia,2) 34 wgt(ia,5)=wgt(ia,2) 35 wgt(ia,6)=wgt(ia,3) 36 endif 37c 38 return 39 end 40c $Id$ 41