1 subroutine argos_diana_edinit() 2c 3 implicit none 4c 5#include "argos_diana_common.fh" 6#include "mafdecls.fh" 7#include "msgids.fh" 8#include "global.fh" 9c 10 if(me.eq.0) then 11 write(*,1000) (ma_sizeof(mt_dbl,3*nsel,mt_byte)+ 12 + ma_sizeof(mt_int,6*nsel,mt_byte))/104857, 13 + ma_inquire_avail(mt_byte)/1048576, 14 + ma_sizeof(mt_dbl,18*nsel*nsel/np,mt_byte)/1048576, 15 + ga_memory_avail()/1048576 16 1000 format(/,' Memory Required Available',//, 17 + ' ma ',2i10,' MB',/, 18 + ' ga ',2i10,' MB',/) 19 endif 20c print*,'nsel=',nsel 21c 22c create nsel x nsel global array covariance matrix 23c 24 if(.not.ga_create(mt_dbl,3*nsel,3*nsel,'covar',0,3*nsel,ga_cov)) 25 + call md_abort('Failed to create global array covar',me) 26 call ga_zero(ga_cov) 27 if(.not.ga_create(mt_dbl,3*nsel,3*nsel,'vector',0,3*nsel,ga_vec)) 28 + call md_abort('Failed to create global array vector',me) 29c 30c allocate memory 31c 32 if(.not.ma_push_get(mt_int,3*nsel,'ndx',l_ndx,i_ndx)) 33 + call md_abort('Failed to allocate memory for ndx',me) 34 if(.not.ma_push_get(mt_dbl,3*nsel,'cov',l_cov,i_cov)) 35 + call md_abort('Failed to allocate memory for cov',me) 36 if(.not.ma_push_get(mt_int,3*nsel,'ord',l_ord,i_ord)) 37 + call md_abort('Failed to allocate memory for ord',me) 38c 39 if(me.eq.0) then 40 write(*,1002) 3*nsel 41 1002 format(' Memory allocated for covariance ',i5) 42 endif 43c 44 return 45 end 46c $Id$ 47