1 subroutine util_allocga() 2c $Id$ 3 implicit none 4#include "mafdecls.fh" 5#include "global.fh" 6 integer ncrap,g_crapa,g_crapb, 7 A mappa(8),ii 8 integer global_b,global 9 logical status 10chack 11chack one big ga_create to bypass shmem/armci bug 12chack for asymmetric armci memory allocation 13chack 14c 15 global_b = ga_memory_avail() 16 If ( Global_B .ge. 0) then 17 global = MA_SizeOf(MT_Byte, global_b, MT_Dbl) 18 Else 19 global = 0 20 EndIf 21 ncrap=sqrt(0.85d0*(global*ga_nnodes())) 22#if 0 23 if(ga_nodeid().eq.0) 24 W write(0,*) ga_nodeid(),' ncrap ',ncrap,global 25 call ga_sync() 26#endif 27 mappa(1)=1 28 do ii=2,ga_nnodes() 29 mappa(ii)=(ii-1)*ncrap/ga_nnodes()+1 30 enddo 31 status = ga_create_irreg(MT_DBL, ncrap, ncrap,'da', 32 $ mappa, ga_nnodes(), 33 $ mappa, 1, g_crapa) 34 if (.not. ga_destroy(g_crapa)) call errquit 35 E (' gadestroy failed ',0,0) 36#if 0 37 if(ga_nodeid().eq.0) write(0,*) ' gadestr ok' 38#endif 39 return 40 end 41