! TITLE: arry_transfer.mac (MANAGEMENT) ! ! ! OBJECTIVE: ! ! This sub-macro transfers the specified contents of an array to a new or ! existing array of a user-specified name. ! ! ! COMMAND SYNTAX: ! ! --NEW ARRAY: ! ! (1) (2) (3) (4) (5) (6) (7) (8) ! ARRY_TRANSFER, 'source', 'target', ri, rf, ci, cf, pi, pf ! ! ! (9) (10) (11) ! --EXISTING ARRAY (additional arguments): ri_t, ci_t, pi_t ! ! ! ARGUMENTS: ! ! (1) source = the origin (source) array name (in single quotes) ! ! (2) target = the name of the new or existing array to transfer ! elements to (in single quotes). ! ! (3,4) ri/rf = initial/final row index: ! -If both are 0 (or blank) or out-of-range, all rows are ! queried. ! -If either one is 0 (or blank), or out-of-range, and the ! other is in-range, then only that row (in-range value) ! is queried. ! -If both are in-range and not equal, then the range is ! from lowest to highest (independent of order). ! ! (5,6) ci/cf = initial/final column index: ! -If both are 0 (or blank) or out-of-range, all columns ! are queried. ! -If either one is 0 (or blank), or out-of-range, and the ! other is in-range, then only that column (in-range value) ! is queried. ! -If both are in-range and not equal, then the range is ! from lowest to highest (independent of order). ! ! (7,8) pi/pf = initial/final plane index: ! -If both are 0 (or blank) or out-of-range, all planes ! are queried. ! -If either one is 0 (or blank), or out-of-range, and the ! other is in-range, then only that plane (in-range value) ! is queried. ! -If both are in-range and not equal, then the range is ! from lowest to highest (independent of order). ! ! If the target array exists, then the following additional arguments ! (9 thru 11) must be specified as the initial target locations within that ! array: ! ! (9) ri_t = initial row index. If left blank, the target initial row ! value defaults to 1. ! ! (10) ci_t = initial column index. If left blank, the target initial ! column value defaults to 1. ! ! (11) pi_t = initial plane index. If left blank, the target initial ! plane value defaults to 1. ! ! ! DESCRIPTION: ! ! If the target array does not exist, then the new target array will be ! created and the specified contents of the source array will be transferred ! to it. Therefore, the dimensions of the target array will acommodate the ! size of the transferred data. Arguments 9 through 11 are ignored. ! ! If the target exists, then the specified contents of the source array will ! be transferred to it. In this case, arguments 9 through 11 may be specified. ! The contents of the source array will be transferred to the target beginning ! with the specified inital row column and plane values. The dimension of the ! target array must accomodate the dimensions of the transferred data. If ! 9 through 11 are left blank, the the default values for ri_t, ci_t and pi_t ! default to 1. ! ! If arguments 3 through 8 are left blank, then the entire contents (and ! therefore its full dimensions) will be transferred to the target array. ! ! *get,prkey_,active,0,prkey /nopr ! snam_=arg1 tnam_=arg2 rinit_=arg3 rfin_=arg4 cinit_=arg5 cfin_=arg6 pinit_=arg7 pfin_=arg8 ! *get,arrexst_,parm,%tnam_%,type ! *get,rsiz_,parm,%snam_%,dim,1 *get,csiz_,parm,%snam_%,dim,2 *get,psiz_,parm,%snam_%,dim,3 ! *do,indx_,1,3,1 *if,indx_,eq,1,then init_='rinit_' fin_='rfin_' siz_='rsiz_' *elseif,indx_,eq,2,then init_='cinit_' fin_='cfin_' siz_='csiz_' *elseif,indx_,eq,3,then init_='pinit_' fin_='pfin_' siz_='psiz_' *endif ! *if,%init_%,le,0,or,%init_%,gt,%siz_%,then *if,%init_%,eq,0,xor,%fin_%,eq,0,then *if,%init_%,eq,0,then *if,%fin_%,gt,0,and,%fin_%,le,%siz_%,then %init_%=%fin_% bypass_=1 *elseif,%fin_%,lt,0,and,%fin_%,gt,%siz_%,then %init_%=1 %fin_%=%siz_% bypass_=1 *endif *else *if,%init_%,gt,0,and,%init_%,le,%siz_%,then %fin_%=%init_% bypass_=1 *elseif,%init_%,lt,0,or,%init_%,gt,%siz_%,then %init_%=1 %fin_%=%siz_% bypass_=1 *endif *endif *elseif,%init_%,eq,0,and,%fin_%,eq,0,then %init_%=1 %fin_%=%siz_% bypass_=1 *endif ! *if,bypass_,ne,1,then *if,%fin_%,lt,0,or,%fin_%,gt,%siz_%,then %init_%=1 %fin_%=%siz_% *elseif,%fin_%,gt,0,and,%fin_%,le,%siz_%,then %init_%=%fin_% *endif *else *set,bypass_, *endif *elseif,%init_%,gt,0,and,%init_%,le,%siz_%,then *if,%fin_%,gt,0,and,%fin_%,le,%siz_%,then *if,%init_%,gt,%fin_%,then rhld_=%init_% %init_%=%fin_% %fin_%=rhld_ *endif *else %fin_%=%init_% *endif *endif *enddo ! roffst_=rinit_-1 coffst_=cinit_-1 poffst_=pinit_-1 ! roffst_=rinit_-1 coffst_=cinit_-1 poffst_=pinit_-1 ! rsize_=rfin_-roffst_ csize_=cfin_-coffst_ psize_=pfin_-poffst_ ! *if,arrexst_,eq,-1,then *dim,%tnam_%,array,rsize_,csize_,psize_ ! *do,riter_,1,rsize_,1 *do,citer_,1,csize_,1 *do,piter_,1,psize_,1 rsourc_=riter_+roffst_ csourc_=citer_+coffst_ psourc_=piter_+poffst_ %tnam_%(riter_,citer_,piter_)=%snam_%(rsourc_,csourc_,psourc_) *enddo *enddo *enddo *elseif,arrexst_,eq,1,then rtinit_=arg9 ctinit_=ar10 ptinit_=ar11 ! *if,rtinit_,le,0,then rtinit_=1 *endif ! *if,ctinit_,le,0,then ctinit_=1 *endif ! *if,ptinit_,le,0,then ptinit_=1 *endif ! rtoffst_=rtinit_-rinit_ ctoffst_=ctinit_-cinit_ ptoffst_=ptinit_-pinit_ ! *do,riter_,rtinit_,(rtinit_+rsize_-1),1 *do,citer_,ctinit_,(ctinit_+csize_-1),1 *do,piter_,ptinit_,(ptinit_+psize_-1),1 rsourc_=riter_-rtoffst_ csourc_=citer_-ctoffst_ psourc_=piter_-ptoffst_ %tnam_%(riter_,citer_,piter_)=%snam_%(rsourc_,csourc_,psourc_) *enddo *enddo *enddo ! *set,rtinit_, *set,ctinit_, *set,ptinit_, *set,rtoffst_, *set,ctoffst_, *set,ptoffst_, *endif ! *set,snam_, *set,tnam_, *set,rsize_, *set,csize_, *set,psize_, *set,rinit_, *set,cinit_, *set,pinit_, *set,rfin_, *set,cfin_, *set,pfin_, *set,riter_, *set,citer_, *set,piter_, *set,roffst_, *set,coffst_, *set,poffst_, *set,rsourc_, *set,csourc_, *set,psourc_, *set,rsiz_, *set,csiz_, *set,psiz_, *set,bypass_, *set,arrexst_, *set,rhld_, ! *if,prkey_,eq,1,then /go *endif