1 subroutine uccsdt_triples_amplitudes(d_amp, spina, spinc) 2 implicit none 3#include "errquit.fh" 4#include "cuccsdtP.fh" 5#include "global.fh" 6#include "mafdecls.fh" 7#include "amplitudes.fh" 8 integer ind, list, 9 & max_lenia, symkc, lenkc, l_t2, k_t2, symia, 10 & a, alo, ahi, syma, asub, asublo, asubhi, asubdim, spina, 11 & b, blo, bhi, symb, bsub, bsublo, bsubhi, bsubdim, spinb, 12 & c, clo, chi, symc, csub, csublo, csubhi, csubdim, spinc, 13 & e, elo, ehi, syme, esub, esublo, esubhi, esubdim, spine, 14 & i, ilo, ihi, symi, isub, isublo, isubhi, isubdim, spini, 15 & j, jlo, jhi, symj, jsub, jsublo, jsubhi, jsubdim, spinj, 16 & k, klo, khi, symk, ksub, ksublo, ksubhi, ksubdim, spink, 17 & m, mlo, mhi, symm, msub, msublo, msubhi, msubdim, spinm, 18 $ nproc, me, ei, cik, ma, kbc, mb, ia, ek, aki, l, lenia, 19 $ symib, symie, symke, symmc, lenke, kc, max_lenke, 20 $ ptr, d_amp, g_t2, kac, offset, actual_lenkc, actual_lenia, 21 $ mc, ica, actual_lenib, ib, bki, icb, 22 $ max_lenje, symje, lenje, symmb, aji, ej, iab, bji 23 24 double precision buf(1000) 25c 26c Offset maps a 4-d array into a 1-d array. It is used to look up 27c ptr(ind,i,j,k,l) where ptr is dimensioned ptr(2,dim1,dim2,dim3,dim4) 28c with dim1-4 = listinfo(6-9,list) 29c 30 offset(ind,i,j,k,l,list) = 31 $ ind-1 + 32 $ 2*(i-1 + 33 $ listinfo(6,list)*(j-1 + 34 $ listinfo(7,list)*(k-1 + 35 $ listinfo(8,list)*(l-1)))) 36c 37c t(ia,kc) 38c 39 spink = spinc 40 spini = spina 41 spinb = spina 42 spine = spina 43c 44c get local memory of size max "lenkc" 45c 46 max_lenia = 0 47 do symia = 0,7 48 lenia = ov_len(symia,spini,spina) 49 if (lenia.gt.max_lenia)max_lenia = lenia 50 enddo 51 if(.not.ma_push_get(mt_dbl,max_lenia,'t2',l_t2,k_t2)) 52 $ call errquit('t2s: t2?',max_lenia, MA_ERR) 53c 54 me = ga_nodeid() 55 nproc = ga_nnodes() 56c 57c loop over symkc 58c 59 alo = asuper(1) 60 ahi = asuper(2) 61 blo = bsuper(1) 62 bhi = bsuper(2) 63 clo = csuper(1) 64 chi = csuper(2) 65 ilo = nc(spini) + 1 66 ihi = nc(spini) + no(spini) 67 do symkc = 0,7 68 symia = symkc 69 symib = symkc 70 symie = symkc 71 lenia = ov_len(symia,spini,spina) 72 actual_lenkc = ov_off(chi+1,symkc,spink,spinc) - 73 $ ov_off(clo,symkc,spink,spinc) 74 if(actual_lenkc.gt.0.and.lenia.gt.0) then 75 if (.not.uccsdt_ampfile_read_t2(d_amp, 76 $ spini, spina, spink, spinc, symkc, clo, chi, 77 $ g_t2, .true., 'column')) 78 $ call errquit('amp_read_t2: reading t2 failed', d_amp, 79 & DISK_ERR) 80 kc = 1 81 do c = clo, chi 82 csub = cblock_inv(c) 83 csublo = cblock(1,csub) 84 csubdim = cblock(2,csub) - cblock(1,csub) + 1 85 symc = cblock(3,csub) 86 symk = ieor(symkc,symc) 87 do k = o_sym(1,symk,spink), o_sym(2,symk,spink) 88 IF (MOD(KC,NPROC).eq.ME) THEN 89 ksub = oblock_inv(k,spink) 90 ksublo = oblock(1,ksub,spink) 91 ksubdim = oblock(2,ksub,spink) - 92 $ oblock(1,ksub,spink) + 1 93 call ga_get(g_t2,1,lenia,kc,kc,dbl_mb(k_t2),1) 94c if (.not.ma_verify_allocator_stuff()) 95c $ call errquit(' after ga ',0) 96c 97c 14. t(e,c,i,k) spin(e)=spin(a) mixed = t(a,c,i,k) 98c 99 do i = ilo, ihi 100 isub = oblock_inv(i,spini) 101 isublo = oblock(1,isub,spini) 102 isubdim = oblock(2,isub,spini) - 103 $ oblock(1,isub,spini) + 1 104 symi = oblock(3,isub,spini) 105 syme = ieor(symie,symi) 106 esublo = v_sym(1,syme,spine) 107 esubhi = v_sym(2,syme,spine) 108 esubdim = esubhi - esublo + 1 109 if (esubdim.gt.0)then 110 cik = (c-csublo + csubdim*(i-isublo + 111 $ isubdim*(k-ksublo))) 112 list = 14 113 ptr = int_mb(listinfo(2,list) + 114 $ offset(1,1,csub,isub,ksub,list)) 115 ptr = ptr + esubdim*cik 116 ei = k_t2 + ov_off(esublo,symie,spini,spine) + 117 $ i - o_sym(1,symi,spini) 118 call dfill(1000, 0.0d0, buf, 1) 119 do e = 1, esubdim 120 buf(e) = dbl_mb(ei+(e-1)*no_sym(symi,spini)) 121 enddo 122 call ga_put(listinfo(5,list),ptr, 123 $ ptr+esubdim-1,1,1,buf,1) 124 endif 125 enddo 126c 127c 20. t(m,k,a,c) spin(m)=spin(a) mixed = t(i,a,k,c) m=i 128c 129 do a = alo, ahi 130 asub = ablock_inv(a) 131 asublo = ablock(1,asub) 132 asubdim = ablock(2,asub) - ablock(1,asub) + 1 133 syma = ablock(3,asub) 134 symm = ieor(symia,syma) 135 spinm = spini 136 msublo = o_sym(1,symm,spinm) 137 msubhi = o_sym(2,symm,spinm) 138 msubdim = msubhi - msublo + 1 139 if (msubdim.gt.0)then 140 kac = (k-ksublo + ksubdim*(a-asublo + 141 $ asubdim*(c-csublo))) 142 list = 20 143 ptr = int_mb(listinfo(2,list) + 144 $ offset(1,1,ksub,asub,csub,list)) 145 ptr = ptr + msubdim*kac 146 ma = k_t2 + ov_off(a,symia,spini,spina) 147 call ga_put(listinfo(5,list),ptr, 148 $ ptr+msubdim-1,1,1,dbl_mb(ma),1) 149 endif 150 enddo 151c 152c 21. t(m,k,b,c) spin(m)=spin(b) mixed = t(i,a,k,c) m=i 153c 154 do b = blo, bhi 155 bsub = bblock_inv(b) 156 bsublo = bblock(1,bsub) 157 bsubdim = bblock(2,bsub) - bblock(1,bsub) + 1 158 symb = bblock(3,bsub) 159 symm = ieor(symib,symb) 160 spinm = spini 161 msublo = o_sym(1,symm,spinm) 162 msubhi = o_sym(2,symm,spinm) 163 msubdim = msubhi - msublo + 1 164 if (msubdim.gt.0)then 165 kbc = (k-ksublo + ksubdim*(b-bsublo + 166 $ bsubdim*(c-csublo))) 167 list = 21 168 ptr = int_mb(listinfo(2,list) + 169 $ offset(1,1,ksub,bsub,csub,list)) 170 ptr = ptr + msubdim*kbc 171 mb = k_t2 + ov_off(b,symib,spini,spinb) 172 call ga_put(listinfo(5,list),ptr, 173 $ ptr+msubdim-1,1,1,dbl_mb(mb),1) 174 endif 175 enddo 176 ENDIF ! end parallel work 177 kc = kc + 1 178 enddo 179 enddo 180 if (.not. ga_destroy(g_t2)) 181 $ call errquit('t2s: ga_destroy?',1, GA_ERR) 182 endif 183 enddo 184 if (.not. ma_pop_stack(l_t2)) 185 $ call errquit('t2s: ma_pop_stack?',1, MA_ERR) 186c 187c get local memory of size max "lenkc" 188c 189 spine = spink 190 max_lenke = 0 191 do symke = 0,7 192 lenke = ov_len(symke,spink,spine) 193 if (lenke.gt.max_lenke)max_lenke = lenke 194 enddo 195 if(.not.ma_push_get(mt_dbl,max_lenke,'t2',l_t2,k_t2)) 196 $ call errquit('t2s: t2?',max_lenke, MA_ERR) 197c 198 klo = nc(spink) + 1 199 khi = nc(spink) + no(spink) 200 do symia = 0,7 201 symke = symia 202 symmc = symia 203 lenke = ov_len(symke,spink,spine) 204 actual_lenia = ov_off(ahi+1,symia,spini,spina) - 205 $ ov_off(alo,symia,spini,spina) 206 if(actual_lenia.gt.0.and.lenke.gt.0) then 207 if (.not.uccsdt_ampfile_read_t2(d_amp, 208 $ spink, spine, spini, spina, symia, alo, ahi, 209 $ g_t2, .true., 'column')) 210 $ call errquit('amp_read_t2: reading t2 failed', d_amp, 211 & DISK_ERR) 212 ia = 1 213 do a = alo, ahi 214 asub = ablock_inv(a) 215 asublo = ablock(1,asub) 216 asubdim = ablock(2,asub) - ablock(1,asub) + 1 217 syma = ablock(3,asub) 218 symi = ieor(symia,syma) 219 do i = o_sym(1,symi,spini), o_sym(2,symi,spini) 220 IF (MOD(IA,NPROC).eq.ME) THEN 221 isub = oblock_inv(i,spini) 222 isublo = oblock(1,isub,spini) 223 isubdim = oblock(2,isub,spini) - 224 $ oblock(1,isub,spini) + 1 225 call ga_get(g_t2,1,lenke,ia,ia,dbl_mb(k_t2),1) 226c if (.not.ma_verify_allocator_stuff()) 227c $ call errquit(' after ga ',0) 228c 229c 17. t(e,a,k,i) spin(e)=spin(k) mixed = t(k,e,i,a) 230c 231 do k = klo, khi 232 ksub = oblock_inv(k,spink) 233 ksublo = oblock(1,ksub,spink) 234 ksubdim = oblock(2,ksub,spink) - 235 $ oblock(1,ksub,spink) + 1 236 symk = oblock(3,ksub,spink) 237 syme = ieor(symke,symk) 238 esublo = v_sym(1,syme,spine) 239 esubhi = v_sym(2,syme,spine) 240 esubdim = esubhi - esublo + 1 241 if (esubdim.gt.0)then 242 aki = (a-asublo + asubdim*(k-ksublo + 243 $ ksubdim*(i-isublo))) 244 list = 17 245 ptr = int_mb(listinfo(2,list) + 246 $ offset(1,1,asub,ksub,isub,list)) 247 ptr = ptr + esubdim*aki 248 ek = k_t2 + ov_off(esublo,symke,spink,spine) + 249 $ k - o_sym(1,symk,spink) 250 call dfill(1000, 0.0d0, buf, 1) 251 do e = 1, esubdim 252 buf(e) = dbl_mb(ek+(e-1)*no_sym(symk,spink)) 253 enddo 254 call ga_put(listinfo(5,list),ptr, 255 $ ptr+esubdim-1,1,1,buf,1) 256 endif 257 enddo 258c 259c 22. t(m,i,c,a) spin(m)=spin(c) mixed = t(m,c,i,a) 260c 261 do c = clo, chi 262 csub = cblock_inv(c) 263 csublo = cblock(1,csub) 264 csubdim = cblock(2,csub) - cblock(1,csub) + 1 265 symc = cblock(3,csub) 266 symm = ieor(symmc,symc) 267 spinm = spinc 268 msublo = o_sym(1,symm,spinm) 269 msubhi = o_sym(2,symm,spinm) 270 msubdim = msubhi - msublo + 1 271 if (msubdim.gt.0)then 272 ica = (i-isublo + isubdim*(c-csublo + 273 $ csubdim*(a-asublo))) 274 list = 22 275 ptr = int_mb(listinfo(2,list) + 276 $ offset(1,1,isub,csub,asub,list)) 277 ptr = ptr + msubdim*ica 278 mc = k_t2 + ov_off(c,symmc,spinm,spinc) 279 call ga_put(listinfo(5,list),ptr, 280 $ ptr+msubdim-1,1,1,dbl_mb(mc),1) 281 endif 282 enddo 283 ENDIF ! end parallel work 284 ia = ia + 1 285 enddo 286 enddo 287 if (.not. ga_destroy(g_t2)) 288 $ call errquit('t2s: ga_destroy?',1, GA_ERR) 289 endif 290 enddo 291c 292 do symib = 0,7 293 symke = symib 294 symmc = symib 295 lenke = ov_len(symke,spink,spine) 296 actual_lenib = ov_off(bhi+1,symib,spini,spinb) - 297 $ ov_off(blo,symib,spini,spinb) 298 if(actual_lenib.gt.0.and.lenke.gt.0) then 299 if (.not.uccsdt_ampfile_read_t2(d_amp, 300 $ spink, spine, spini, spinb, symib, blo, bhi, 301 $ g_t2, .true., 'column')) 302 $ call errquit('amp_read_t2: reading t2 failed', d_amp, 303 & DISK_ERR) 304 ib = 1 305 do b = blo, bhi 306 bsub = bblock_inv(b) 307 bsublo = bblock(1,bsub) 308 bsubdim = bblock(2,bsub) - bblock(1,bsub) + 1 309 symb = bblock(3,bsub) 310 symi = ieor(symib,symb) 311 do i = o_sym(1,symi,spini), o_sym(2,symi,spini) 312 IF (MOD(IB,NPROC).eq.ME) THEN 313 isub = oblock_inv(i,spini) 314 isublo = oblock(1,isub,spini) 315 isubdim = oblock(2,isub,spini) - 316 $ oblock(1,isub,spini) + 1 317 call ga_get(g_t2,1,lenke,ib,ib,dbl_mb(k_t2),1) 318c if (.not.ma_verify_allocator_stuff()) 319c $ call errquit(' after ga ',0) 320c 321c 18. t(e,b,k,i) spin(e)=spin(k) mixed = t(k,e,i,b) 322c 323 do k = klo, khi 324 ksub = oblock_inv(k,spink) 325 ksublo = oblock(1,ksub,spink) 326 ksubdim = oblock(2,ksub,spink) - 327 $ oblock(1,ksub,spink) + 1 328 symk = oblock(3,ksub,spink) 329 syme = ieor(symke,symk) 330 esublo = v_sym(1,syme,spine) 331 esubhi = v_sym(2,syme,spine) 332 esubdim = esubhi - esublo + 1 333 if (esubdim.gt.0)then 334 bki = (b-bsublo + bsubdim*(k-ksublo + 335 $ ksubdim*(i-isublo))) 336 list = 18 337 ptr = int_mb(listinfo(2,list) + 338 $ offset(1,1,bsub,ksub,isub,list)) 339 ptr = ptr + esubdim*bki 340 ek = k_t2 + ov_off(esublo,symke,spink,spine) + 341 $ k - o_sym(1,symk,spink) 342 call dfill(1000, 0.0d0, buf, 1) 343 do e = 1, esubdim 344 buf(e) = dbl_mb(ek+(e-1)*no_sym(symk,spink)) 345 enddo 346 call ga_put(listinfo(5,list),ptr, 347 $ ptr+esubdim-1,1,1,buf,1) 348 endif 349 enddo 350c 351c 23. t(m,i,c,b) spin(m)=spin(c) mixed = t(m,c,i,b) 352c 353 do c = clo, chi 354 csub = cblock_inv(c) 355 csublo = cblock(1,csub) 356 csubdim = cblock(2,csub) - cblock(1,csub) + 1 357 symc = cblock(3,csub) 358 symm = ieor(symmc,symc) 359 spinm = spinc 360 msublo = o_sym(1,symm,spinm) 361 msubhi = o_sym(2,symm,spinm) 362 msubdim = msubhi - msublo + 1 363 if (msubdim.gt.0)then 364 icb = (i-isublo + isubdim*(c-csublo + 365 $ csubdim*(b-bsublo))) 366 list = 23 367 ptr = int_mb(listinfo(2,list) + 368 $ offset(1,1,isub,csub,bsub,list)) 369 ptr = ptr + msubdim*icb 370 mc = k_t2 + ov_off(c,symmc,spinm,spinc) 371 call ga_put(listinfo(5,list),ptr, 372 $ ptr+msubdim-1,1,1,dbl_mb(mc),1) 373 endif 374 enddo 375 ENDIF ! end parallel work 376 ib = ib + 1 377 enddo 378 enddo 379 if (.not. ga_destroy(g_t2)) 380 $ call errquit('t2s: ga_destroy?',1, GA_ERR) 381 endif 382 enddo 383 384 if (.not. ma_pop_stack(l_t2)) 385 $ call errquit('t2s: ma_pop_stack?',1, MA_ERR) 386 387c 388c get local memory of size max "lenkc" 389c 390 spinj = spini 391 spine = spinj 392 max_lenje = 0 393 do symje = 0,7 394 lenje = ov_len(symje,spinj,spine) 395 if (lenje.gt.max_lenje)max_lenje = lenje 396 enddo 397 if(.not.ma_push_get(mt_dbl,max_lenje,'t2',l_t2,k_t2)) 398 $ call errquit('t2s: t2?',max_lenje, MA_ERR) 399c 400 jlo = nc(spinj) + 1 401 jhi = nc(spinj) + no(spinj) 402 do symia = 0,7 403 symje = symia 404 symmb = symia 405 lenje = ov_len(symje,spinj,spine) 406 actual_lenia = ov_off(ahi+1,symia,spini,spina) - 407 $ ov_off(alo,symia,spini,spina) 408 if(actual_lenia.gt.0.and.lenje.gt.0) then 409 if (.not.uccsdt_ampfile_read_t2(d_amp, 410 $ spinj, spine, spini, spina, symia, alo, ahi, 411 $ g_t2, .true., 'column')) 412 $ call errquit('amp_read_t2: reading t2 failed', d_amp, 413 & DISK_ERR) 414 ia = 1 415 do a = alo, ahi 416 asub = ablock_inv(a) 417 asublo = ablock(1,asub) 418 asubdim = ablock(2,asub) - ablock(1,asub) + 1 419 syma = ablock(3,asub) 420 symi = ieor(symia,syma) 421 do i = o_sym(1,symi,spini), o_sym(2,symi,spini) 422 IF (MOD(IA,NPROC).eq.ME) THEN 423 isub = oblock_inv(i,spini) 424 isublo = oblock(1,isub,spini) 425 isubdim = oblock(2,isub,spini) - 426 $ oblock(1,isub,spini) + 1 427 call ga_get(g_t2,1,lenje,ia,ia,dbl_mb(k_t2),1) 428c if (.not.ma_verify_allocator_stuff()) 429c $ call errquit(' after ga ',0) 430c 431c 15. t(e,a,j,i) spin(e)=spin(j) pure = t(j,e,i,a) 432c 433 do j = jlo, jhi 434 jsub = oblock_inv(j,spinj) 435 jsublo = oblock(1,jsub,spinj) 436 jsubdim = oblock(2,jsub,spinj) - 437 $ oblock(1,jsub,spinj) + 1 438 symj = oblock(3,jsub,spinj) 439 syme = ieor(symje,symj) 440 esublo = v_sym(1,syme,spine) 441 esubhi = v_sym(2,syme,spine) 442 esubdim = esubhi - esublo + 1 443 if (esubdim.gt.0)then 444 aji = (a-asublo + asubdim*(j-jsublo + 445 $ jsubdim*(i-isublo))) 446 list = 15 447 ptr = int_mb(listinfo(2,list) + 448 $ offset(1,1,asub,jsub,isub,list)) 449 ptr = ptr + esubdim*aji 450 ej = k_t2 + ov_off(esublo,symje,spinj,spine) + 451 $ j - o_sym(1,symj,spinj) 452 call dfill(1000, 0.0d0, buf, 1) 453 do e = 1, esubdim 454 buf(e) = dbl_mb(ej+(e-1)*no_sym(symj,spinj)) 455 enddo 456 call ga_put(listinfo(5,list),ptr, 457 $ ptr+esubdim-1,1,1,buf,1) 458 endif 459 enddo 460c 461c 19. t(m,i,a,b) pure spin = -t(m,b,i,a) 462c 463 do b = blo, bhi 464 bsub = bblock_inv(b) 465 bsublo = bblock(1,bsub) 466 bsubdim = bblock(2,bsub) - bblock(1,bsub) + 1 467 symb = bblock(3,bsub) 468 symm = ieor(symmb,symb) 469 spinm = spinb 470 msublo = o_sym(1,symm,spinm) 471 msubhi = o_sym(2,symm,spinm) 472 msubdim = msubhi - msublo + 1 473 if (msubdim.gt.0)then 474 iab = (i-isublo + isubdim*(a-asublo + 475 $ asubdim*(b-bsublo))) 476 list = 19 477 ptr = int_mb(listinfo(2,list) + 478 $ offset(1,1,isub,asub,bsub,list)) 479 ptr = ptr + msubdim*iab 480 mb = k_t2 + ov_off(b,symmb,spinm,spinb) 481 call dscal(msubdim,-1.0d0,dbl_mb(mb),1) 482 call ga_put(listinfo(5,list),ptr, 483 $ ptr+msubdim-1,1,1,dbl_mb(mb),1) 484 call dscal(msubdim,-1.0d0,dbl_mb(mb),1) 485 endif 486 enddo 487 ENDIF ! end parallel work 488 ia = ia + 1 489 enddo 490 enddo 491 if (.not. ga_destroy(g_t2)) 492 $ call errquit('t2s: ga_destroy?',1, GA_ERR) 493 endif 494 enddo 495 do symib = 0,7 496 symje = symib 497 symmb = symib 498 lenje = ov_len(symje,spinj,spine) 499 actual_lenib = ov_off(bhi+1,symib,spini,spinb) - 500 $ ov_off(blo,symib,spini,spinb) 501 if(actual_lenib.gt.0.and.lenje.gt.0) then 502 if (.not.uccsdt_ampfile_read_t2(d_amp, 503 $ spinj, spine, spini, spinb, symib, blo, bhi, 504 $ g_t2, .true., 'column')) 505 $ call errquit('amp_read_t2: reading t2 failed', d_amp, 506 & DISK_ERR) 507 ib = 1 508 do b = blo, bhi 509 bsub = bblock_inv(b) 510 bsublo = bblock(1,bsub) 511 bsubdim = bblock(2,bsub) - bblock(1,bsub) + 1 512 symb = bblock(3,bsub) 513 symi = ieor(symib,symb) 514 do i = o_sym(1,symi,spini), o_sym(2,symi,spini) 515 IF (MOD(IB,NPROC).eq.ME) THEN 516 isub = oblock_inv(i,spini) 517 isublo = oblock(1,isub,spini) 518 isubdim = oblock(2,isub,spini) - 519 $ oblock(1,isub,spini) + 1 520 call ga_get(g_t2,1,lenje,ib,ib,dbl_mb(k_t2),1) 521c if (.not.ma_verify_allocator_stuff()) 522c $ call errquit(' after ga ',0) 523c 524c 16. t(e,b,j,i) spin(e)=spin(j) pure = t(j,e,i,b) 525c 526 do j = jlo, jhi 527 jsub = oblock_inv(j,spinj) 528 jsublo = oblock(1,jsub,spinj) 529 jsubdim = oblock(2,jsub,spinj) - 530 $ oblock(1,jsub,spinj) + 1 531 symj = oblock(3,jsub,spinj) 532 syme = ieor(symje,symj) 533 esublo = v_sym(1,syme,spine) 534 esubhi = v_sym(2,syme,spine) 535 esubdim = esubhi - esublo + 1 536 if (esubdim.gt.0)then 537 bji = (b-bsublo + bsubdim*(j-jsublo + 538 $ jsubdim*(i-isublo))) 539 list = 16 540 ptr = int_mb(listinfo(2,list) + 541 $ offset(1,1,bsub,jsub,isub,list)) 542 ptr = ptr + esubdim*bji 543 ej = k_t2 + ov_off(esublo,symje,spinj,spine) + 544 $ j - o_sym(1,symj,spinj) 545 call dfill(1000, 0.0d0, buf, 1) 546 do e = 1, esubdim 547 buf(e) = dbl_mb(ej+(e-1)*no_sym(symj,spinj)) 548 enddo 549 call ga_put(listinfo(5,list),ptr, 550 $ ptr+esubdim-1,1,1,buf,1) 551 endif 552 enddo 553 ENDIF ! end parallel work 554 ib = ib + 1 555 enddo 556 enddo 557 if (.not. ga_destroy(g_t2)) 558 $ call errquit('t2s: ga_destroy?',1, GA_ERR) 559 endif 560 enddo 561 if (.not. ma_pop_stack(l_t2)) 562 $ call errquit('t2s: ma_pop_stack?',1, MA_ERR) 563c 564 end 565 566c $Id$ 567