1 subroutine qhop_alloc 2c 3c $Id$ 4c 5 implicit none 6c 7#include "qhop_common.fh" 8#include "mafdecls.fh" 9c 10c original dimensions 11c 12 maxseq=5000 13 mxseq=30 14 maxpar=10000 15 mxar=mxseq*30 16 maxhv=4 17c 18c allocate memory for parameter arrays 19c 20 if(.not.ma_push_get(mt_int,2*maxseq,'iptseq',l_ptseq,i_ptseq)) 21 + call md_abort('Failed to allocate iptseq',0) 22 if(.not.ma_push_get(mt_int,mxseq,'iptarat',l_ptarat,i_ptarat)) 23 + call md_abort('Failed to allocate iptarat',0) 24 if(.not.ma_push_get(mt_int,4*mxar,'iarat',l_iarat,i_iarat)) 25 + call md_abort('Failed to allocate iarat',0) 26 if(.not.ma_push_get(mt_dbl,2*mxar,'racs',l_racs,i_racs)) 27 + call md_abort('Failed to allocate racs',0) 28 if(.not.ma_push_get(mt_int,maxpar,'iptpar',l_ptpar,i_ptpar)) 29 + call md_abort('Failed to allocate iptpar',0) 30 if(.not.ma_push_get(mt_dbl,31*maxpar,'par',l_par,i_par)) 31 + call md_abort('Failed to allocate par',0) 32c 33 return 34 end 35 subroutine qhop_finish 36c 37 implicit none 38c 39#include "qhop_common.fh" 40#include "mafdecls.fh" 41c 42 if(.not.ma_pop_stack(l_par)) 43 + call md_abort('qhop_final: Failed to deallocate par',0) 44 if(.not.ma_pop_stack(l_ptpar)) 45 + call md_abort('qhop_final: Failed to deallocate ptpar',0) 46 if(.not.ma_pop_stack(l_racs)) 47 + call md_abort('qhop_final: Failed to deallocate racs',0) 48 if(.not.ma_pop_stack(l_iarat)) 49 + call md_abort('qhop_final: Failed to deallocate arat',0) 50 if(.not.ma_pop_stack(l_ptarat)) 51 + call md_abort('qhop_final: Failed to deallocate ptarat',0) 52 if(.not.ma_pop_stack(l_ptseq)) 53 + call md_abort('qhop_final: Failed to deallocate ptseq',0) 54c 55 return 56 end 57