1 logical function argos_prep_mktop(lfnout,title,nparms,mparms, 2 + lfnseq,filseq,lfntop,filtop,lfnsgm,lfnpar, 3 + lfnmod,filmod,lfnmat,lfnhdb,lfnhop,filhop, 4 + lfnbsg,filbsg,ignore,slvnam,itopol,icomb) 5c 6c $Id$ 7c 8c in : integer lfnout = logical file number output file 9c char*80 ffield = force field from [amber] 10c integer lfnseq = logical file number for seq file 11c char*80 filseq = file name of seq file 12c integer lfntop = logical file number for top file 13c char*80 filtop = file name of top file 14c integer lfnsgm = logical file number for sgm file 15c 16 implicit none 17c 18#include "mafdecls.fh" 19#include "util.fh" 20#include "argos_prep_common.fh" 21c 22 logical argos_prep_seqsiz,argos_prep_rdseq,argos_prep_term, 23 + argos_prep_dimens,argos_prep_mklist 24 external argos_prep_seqsiz,argos_prep_rdseq,argos_prep_term, 25 + argos_prep_dimens,argos_prep_mklist 26 logical argos_prep_params,argos_prep_natyps,argos_prep_wrttop, 27 + argos_prep_third,argos_prep_excl 28 external argos_prep_params,argos_prep_natyps,argos_prep_wrttop, 29 + argos_prep_third,argos_prep_excl 30 logical argos_prep_nonbon,argos_prep_modify 31 external argos_prep_nonbon,argos_prep_modify 32c 33 integer lfnout,lfnseq,lfntop,lfnsgm,lfnpar,lfnmod,ignore,lfnmat 34 integer lfnhdb,lfnhop,lfnbsg 35 integer nparms,mparms,itopol,icomb 36 character*80 title(2,3) 37 character*255 filseq,filtop,filmod,filhop,filbsg 38 character*3 slvnam 39c 40 integer mseq,nseq 41 integer l_lseq,i_lseq,l_cseq,i_cseq 42c 43 integer mlnk,nlnk 44 integer l_llnk,i_llnk,l_clnk,i_clnk 45c 46 integer matm,natm 47 integer l_latm,i_latm,l_catm,i_catm,l_qatm,i_qatm 48c 49 integer mbnd,nbnd 50 integer l_lbnd,i_lbnd,l_rbnd,i_rbnd 51c 52 integer mang,nang 53 integer l_lang,i_lang,l_rang,i_rang 54c 55 integer mdih,ndih 56 integer l_ldih,i_ldih,l_kdih,i_kdih,l_rdih,i_rdih,l_ndih,i_ndih 57c 58 integer mimp,nimp 59 integer l_limp,i_limp,l_rimp,i_rimp,l_kimp,i_kimp 60c 61 integer matt,natt,mats,nats 62 integer l_latt,i_latt,l_catt,i_catt,l_patt,i_patt,l_ratt,i_ratt 63 integer l_lats,i_lats 64c 65 integer nval 66 integer l_ival,i_ival,l_rval,i_rval,l_ndx,i_ndx 67c 68 integer m3rd,n3rd 69 integer i_l3rd,l_l3rd 70c 71 integer mexc,nexc 72 integer i_lexc,l_lexc 73c 74 integer mnon,nnon 75 integer i_lnon,l_lnon 76c 77 integer natmt,nbndt,nangt,ndiht,nimpt,n3rdt,mqu 78c 79 real*8 releps,q14fac,wcorr(10) 80c 81 logical lupdat 82c 83 real*8 timer_wall_total 84 external timer_wall_total 85c 86 lupdat=.false. 87c 88 if(util_print('topology',print_debug)) then 89 write(lfnout,1000) 90 1000 format('TOPOLOGY GENERATION') 91 endif 92c 93 call timer_init() 94 if(.not.argos_prep_seqsiz(lfnout,lfnseq,filseq,nseq,nlnk)) 95 + call md_abort('argos_prep_seqsize failed',9999) 96c 97 mseq=nseq+2 98 mlnk=nlnk+1 99c 100 if(util_print('topology',print_debug)) then 101 write(lfnout,1001) nseq 102 1001 format('sequence length is',i10) 103 endif 104c 105c allocate memory for sequence 106c ---------------------------- 107c 108c integer lseq(1,mseq) : number of sequence entry 109c 2 : link type 110c 3 : index of first atom of sequence entry 111c 4 : molecule number 112c 113 if(.not.ma_push_get(mt_int,6*mseq,'lseq',l_lseq,i_lseq)) 114 + call md_abort('Memory allocation failed for lseq',9999) 115c 116c char*5 cseq(1,mseq) : name of sequence entry on pdb 117c 2 : name of sequence entry on top 118c 119 if(.not.ma_push_get(mt_byte,10*mseq,'cseq',l_cseq,i_cseq)) 120 + call md_abort('Memory allocation failed for cseq',9999) 121c 122c allocate memory for link list 123c ----------------------------- 124c 125c integer llnk(1,mlnk) : link segment 1 126c 2 : link segment 2 127c 3 : link type : 0: normal 128c 1: forced 129c char*4 clnk(1,mlnk) : link segment 1 atom name 130c 2 : link segment 2 atom name 131c 132 if(.not.ma_push_get(mt_int,3*mlnk,'llnk',l_llnk,i_llnk)) 133 + call md_abort('Memory allocation failed for llnk',9999) 134 if(.not.ma_push_get(mt_byte,8*mlnk,'clnk',l_clnk,i_clnk)) 135 + call md_abort('Memory allocation failed for clnk',9999) 136c 137c read the sequence file 138c ---------------------- 139c 140 if(.not.argos_prep_rdseq(lfnout,lfnseq,filseq, 141 + int_mb(i_lseq),byte_mb(i_cseq),mseq,nseq, 142 + int_mb(i_llnk),byte_mb(i_clnk),mlnk,nlnk)) 143 + call md_abort('argos_prep_rdseq failed',9999) 144c 145 if(util_print('topology',print_debug)) then 146 write(lfnout,1002) 147 1002 format('sequence is read') 148 endif 149c 150c determine termini 151c ----------------- 152c 153 if(.not.argos_prep_term(lfnout,lfnsgm, 154 + int_mb(i_lseq),byte_mb(i_cseq),mseq,nseq, 155 + int_mb(i_llnk),byte_mb(i_clnk),mlnk,nlnk)) 156 + call md_abort('argos_prep_term failed',9999) 157c 158 if(util_print('topology',print_debug)) then 159 write(lfnout,1003) 160 1003 format('termini are determined') 161 endif 162c 163c determine array dimensions 164c -------------------------- 165c 166 if(.not.argos_prep_dimens(lfnout,lfnsgm, 167 + int_mb(i_lseq),byte_mb(i_cseq),mseq,nseq, 168 + natm,nbnd,nang,ndih,nimp,nparms)) 169 + call md_abort('argos_prep_dimens failed',9999) 170 mparms=nparms+1 171c 172c adjust dimension to account for links 173c ------------------------------------- 174c 175 matm=natm+1 176 mbnd=nbnd+3*nseq+1 177 mang=nang+27*nseq+1 178 mdih=ndih+45*nseq+1 179 mimp=nimp+6*nseq+1 180c 181 if(util_print('topology',print_debug)) then 182 write(lfnout,1004) mseq,matm,mbnd,mang,mdih,mimp 183 1004 format('list dimensions are determined:',/, 184 + ' number of segments ',i10,/, 185 + ' number of atoms ',i10,/, 186 + ' number of bonds ',i10,/, 187 + ' number of angles ',i10,/, 188 + ' number of dihedrals ',i10,/, 189 + ' number of impropers ',i10) 190 endif 191c 192c allocate memory for atomic lists 193c -------------------------------- 194c 195c integer latm(1,matm) : charge group 196c 2 : polarization group 197c 3 : link number 198c 4 : center type 199c 5 : segment number 200c 6 : molecule number 201c 7 : atomic number 202c 8 : fraction 203c 9 : ??? 204c 205c 206c char*6 catm( 1,matm) : atom name 207c i+1 : atom type set i, i=1,nparms 208c 209 if(.not.ma_push_get(mt_int,11*matm,'latm',l_latm,i_latm)) 210 + call md_abort('Memory allocation failed for latm',9999) 211 if(.not.ma_push_get(mt_byte,6*mparms*matm,'catm',l_catm,i_catm)) 212 + call md_abort('Memory allocation failed for catm',9999) 213c 214c real*8 qatm(nparms,1,matm) : partial atomic charges sets 1,..,nparms 215c 2 : polarizabilities sets 1,..,nparms 216c 217 mqu=3*matm 218 if(.not.ma_push_get(mt_dbl,2*nparms*mqu,'qatm',l_qatm,i_qatm)) 219 + call md_abort('Memory allocation failed for qatm',9999) 220c 221c allocate memory for bonded lists 222c -------------------------------- 223c 224c integer lbnd(1:2,mbnd) : bond indices 225c 3 : parameter source 226c 4 : constraint type 227c real*8 rbnd(nparms,1,mbnd) : bond length set 1 228c 2 : force constant set 1 229c 230 if(.not.ma_push_get(mt_int,4*mbnd,'lbnd',l_lbnd,i_lbnd)) 231 + call md_abort('Memory allocation failed for lbnd',9999) 232 if(.not.ma_push_get(mt_dbl,2*nparms*mbnd,'rbnd',l_rbnd,i_rbnd)) 233 + call md_abort('Memory allocation failed for rbnd',9999) 234c 235c integer lang(1:3,mang) : angle indices 236c 4 : parameter source 237c 5 : constraint type 238c real*8 rang(nparms,1,mang) : angle set 1 239c 2 : force constant set 1 240c 241 if(.not.ma_push_get(mt_int,5*mang,'lang',l_lang,i_lang)) 242 + call md_abort('Memory allocation failed for lang',9999) 243 if(.not.ma_push_get(mt_dbl,4*nparms*mang,'rang',l_rang,i_rang)) 244 + call md_abort('Memory allocation failed for rang',9999) 245c 246c integer ldih(1:4,mdih) : torsion indices 247c 5 : parameter source 248c 6 : constraint type 249c 250c integer nfdih(nparms,mdih) : number of functions 251c 252c integer kdih(6,nparms,mdih) : multiplicity set 1 253c 254c real*8 rdih(6,nparms,1,mdih) : phase angle set 1 255c 2 : force constant set 1 256c 257 if(.not.ma_push_get(mt_int,6*mdih,'ldih',l_ldih,i_ldih)) 258 + call md_abort('Memory allocation failed for ldih',9999) 259 if(.not.ma_push_get(mt_int,nparms*mdih,'nfdih',l_ndih,i_ndih)) 260 + call md_abort('Memory allocation failed for ldih',9999) 261 if(.not.ma_push_get(mt_int,6*nparms*mdih,'kdih',l_kdih,i_kdih)) 262 + call md_abort('Memory allocation failed for ldih',9999) 263 if(.not.ma_push_get(mt_dbl,12*nparms*mdih,'rdih',l_rdih,i_rdih)) 264 + call md_abort('Memory allocation failed for rdih',9999) 265c 266c integer limp(1:4,mimp) : improper torsion indices 267c 5 : parameter source 268c 6 : constraint type 269c 270c integer kimp(nparms,mimp) : multiplicity 271c 272c real*8 rimp(nparms,1,mimp) : phase angle set 1 273c 2 : force constant set 1 274c 275 if(.not.ma_push_get(mt_int,6*mimp,'limp',l_limp,i_limp)) 276 + call md_abort('Memory allocation failed for limp',9999) 277 if(.not.ma_push_get(mt_int,nparms*mimp,'kimp',l_kimp,i_kimp)) 278 + call md_abort('Memory allocation failed for limp',9999) 279 if(.not.ma_push_get(mt_dbl,2*nparms*mimp,'rimp',l_rimp,i_rimp)) 280 + call md_abort('Memory allocation failed for rimp',9999) 281c 282c generate the atomic and bonded lists 283c ------------------------------------ 284c 285 natm=0 286 nbnd=0 287 nang=0 288 ndih=0 289 nimp=0 290c 291 nval=max(mbnd,mang,mdih,mimp,1) 292 if(.not.ma_push_get(mt_int,nval,'ival',l_ival,i_ival)) 293 + call md_abort('Memory allocation failed for ival',9999) 294 if(.not.ma_push_get(mt_int,nval,'ndx',l_ndx,i_ndx)) 295 + call md_abort('Memory allocation failed for ndx',9999) 296 if(.not.ma_push_get(mt_dbl,nval,'rval',l_rval,i_rval)) 297 + call md_abort('Memory allocation failed for rval',9999) 298 if(.not.argos_prep_mklist(lfnout,lfnsgm,lfnmat,nparms,mparms, 299 + int_mb(i_lseq),byte_mb(i_cseq),mseq,nseq, 300 + int_mb(i_llnk),byte_mb(i_clnk),mlnk,nlnk, 301 + int_mb(i_latm),byte_mb(i_catm),dbl_mb(i_qatm),matm,natm, 302 + int_mb(i_lbnd),dbl_mb(i_rbnd),mbnd,nbnd, 303 + int_mb(i_lang),dbl_mb(i_rang),mang,nang, 304 + int_mb(i_ldih),int_mb(i_ndih),int_mb(i_kdih), 305 + dbl_mb(i_rdih),mdih,ndih, 306 + int_mb(i_limp),int_mb(i_kimp),dbl_mb(i_rimp),mimp,nimp, 307 + natmt,nbndt,nangt,ndiht,nimpt,wcorr, 308 + nval,int_mb(i_ival),dbl_mb(i_rval),int_mb(i_ndx),itopol)) 309 + call md_abort('argos_prep_mklist failed',9999) 310 if(.not.ma_pop_stack(l_rval)) 311 + call md_abort('Memory deallocation failed for rval',9999) 312 if(.not.ma_pop_stack(l_ndx)) 313 + call md_abort('Memory deallocation failed for ndx',9999) 314 if(.not.ma_pop_stack(l_ival)) 315 + call md_abort('Memory deallocation failed for ival',9999) 316c 317 if(util_print('topology',print_debug)) then 318 write(lfnout,1005) 319 1005 format('lists are generated') 320 endif 321c 322c apply topology modifications to atom types 323c ------------------------------------------ 324 if(.not.argos_prep_modify(1,lfnout,lfnmod,filmod,nparms,mparms, 325 + int_mb(i_latm),byte_mb(i_catm),dbl_mb(i_qatm),matm,natm, 326 + int_mb(i_lseq),byte_mb(i_cseq),mseq,nseq, 327 + int_mb(i_lbnd),dbl_mb(i_rbnd),mbnd,nbnd,nbndt, 328 + int_mb(i_lang),dbl_mb(i_rang),mang,nang,nangt, 329 + int_mb(i_ldih),int_mb(i_ndih),int_mb(i_kdih), 330 + dbl_mb(i_rdih),mdih,ndih,ndiht, 331 + int_mb(i_limp),int_mb(i_kimp),dbl_mb(i_rimp),mimp,nimp,nimpt, 332 + lupdat)) 333 + call md_abort('argos_prep_modify failed',9999) 334c 335c get number of atom types 336c ------------------------ 337c 338 if(.not.argos_prep_natyps(lfnout,nparms,mparms, 339 + byte_mb(i_catm),matm,natmt,natt,nats)) 340 + call md_abort('argos_prep_natyps failed',9999) 341 matt=natt 342 mats=nats 343c 344 if(util_print('topology',print_debug)) then 345 write(lfnout,1006) natt 346 1006 format(' Number of atom types is ',i10) 347 endif 348c 349c allocate memory for atom type lists 350c ----------------------------------- 351c 352 if(.not.ma_push_get(mt_int,3*matt,'latt',l_latt,i_latt)) 353 + call md_abort('Memory allocation failed for latt',9999) 354 if(.not.ma_push_get(mt_int,nparms*mats,'lats',l_lats,i_lats)) 355 + call md_abort('Memory allocation failed for lats',9999) 356 if(.not.ma_push_get(mt_byte,36*matt,'catt',l_catt,i_catt)) 357 + call md_abort('Memory allocation failed for catt',9999) 358 if(.not.ma_push_get(mt_dbl,12*matt*matt,'patt',l_patt,i_patt)) 359 + call md_abort('Memory allocation failed for patt',9999) 360 if(.not.ma_push_get(mt_dbl,3*matt,'ratt',l_ratt,i_ratt)) 361 + call md_abort('Memory allocation failed for ratt',9999) 362c 363c substitute force field parameters 364c --------------------------------- 365c 366 if(.not.argos_prep_params(lfnpar,lfnout,nparms,mparms, 367 + releps,q14fac,ignore, 368 + int_mb(i_latm),byte_mb(i_catm),matm,natmt, 369 + int_mb(i_lbnd),dbl_mb(i_rbnd),mbnd,nbndt, 370 + int_mb(i_lang),dbl_mb(i_rang),mang,nangt, 371 + int_mb(i_ldih),int_mb(i_ndih),int_mb(i_kdih), 372 + dbl_mb(i_rdih),mdih,ndiht, 373 + int_mb(i_limp),int_mb(i_kimp),dbl_mb(i_rimp),mimp,nimpt, 374 + int_mb(i_latt),int_mb(i_lats),byte_mb(i_catt),dbl_mb(i_patt), 375 + dbl_mb(i_ratt),matt,natt,mats,nats, 376 + int_mb(i_lseq),byte_mb(i_cseq),mseq,nseq,icomb)) 377 + call md_abort('argos_prep_params failed',9999) 378c 379 if(util_print('topology',print_debug)) then 380 write(lfnout,1007) 381 1007 format('force field parameters are substituted') 382 endif 383c 384c allocate memory for third neighbor list 385c --------------------------------------- 386c 387 m3rd=6*mang 388 n3rd=0 389 if(.not.ma_push_get(mt_int,2*m3rd,'l3rd',l_l3rd,i_l3rd)) 390 + call md_abort('Memory allocation failed for l3rd',9999) 391 nval=max(m3rd,matm,1) 392 if(.not.ma_push_get(mt_int,nval,'ival',l_ival,i_ival)) 393 + call md_abort('Memory allocation failed for ival',9999) 394 if(.not.ma_push_get(mt_int,nval,'ndx',l_ndx,i_ndx)) 395 + call md_abort('Memory allocation failed for ndx',9999) 396c 397c construct third neighbor list 398c ----------------------------- 399c 400 if(.not.argos_prep_third(int_mb(i_lbnd),mbnd,nbnd,int_mb(i_lang), 401 + mang,nang,int_mb(i_l3rd),m3rd,n3rd,1,1,1, 402 + nval,int_mb(i_ival),int_mb(i_ndx),matm)) 403 + call md_abort('argos_prep_third failed',9999) 404c 405 n3rdt=n3rd 406 if(nbndt.gt.nbnd.and.nangt.gt.nang) then 407 if(.not.argos_prep_third(int_mb(i_lbnd),mbnd,nbndt,int_mb(i_lang), 408 + mang,nangt,int_mb(i_l3rd),m3rd,n3rdt,nbnd+1,nang+1,n3rd+1, 409 + nval,int_mb(i_ival),int_mb(i_ndx),matm)) 410 + call md_abort('argos_prep_third failed',9999) 411 endif 412 if(.not.ma_pop_stack(l_ndx)) 413 + call md_abort('Memory deallocation failed for ndx',9999) 414 if(.not.ma_pop_stack(l_ival)) 415 + call md_abort('Memory deallocation failed for ival',9999) 416c 417 if(util_print('topology',print_high)) then 418 write(lfnout,1008) n3rd 419 1008 format(' Solute third neighbor list length is',i10) 420 endif 421c 422c allocate memory for excluded pair list 423c -------------------------------------- 424c 425 mexc=n3rd+nbnd+nang+300 426 nexc=0 427 if(.not.ma_push_get(mt_int,2*mexc,'lexc',l_lexc,i_lexc)) 428 + call md_abort('Memory allocation failed for lexc',9999) 429c 430c construct excluded pair list 431c ---------------------------- 432c 433 nval=max(mexc,1) 434 if(.not.ma_push_get(mt_int,nval,'ival',l_ival,i_ival)) 435 + call md_abort('Memory allocation failed for ival',9999) 436 if(.not.ma_push_get(mt_int,nval,'ndx',l_ndx,i_ndx)) 437 + call md_abort('Memory allocation failed for ndx',9999) 438 if(.not.argos_prep_excl(int_mb(i_l3rd),m3rd,n3rd,int_mb(i_lbnd), 439 + mbnd,nbnd,int_mb(i_lang),mang,nang,int_mb(i_lexc),mexc,nexc, 440 + nval,int_mb(i_ival),int_mb(i_ndx),byte_mb(i_catt),matt, 441 + int_mb(i_lats),nparms,mats,int_mb(i_latm),matm,natm,lupdat)) 442 + call md_abort('argos_prep_excl failed',9999) 443 if(.not.ma_pop_stack(l_ndx)) 444 + call md_abort('Memory deallocation failed for ndx',9999) 445 if(.not.ma_pop_stack(l_ival)) 446 + call md_abort('Memory deallocation failed for ival',9999) 447c 448 if(util_print('topology',print_high)) then 449 write(lfnout,1009) nexc 450 1009 format(' Solute excluded pair list length is',i10) 451 endif 452c 453c allocate memory for solvent non-bonded list 454c ------------------------------------------- 455c 456 mnon=max(1,(natmt-natm)*(natmt-natm)) 457 nnon=0 458 if(.not.ma_push_get(mt_int,2*mnon,'lnon',l_lnon,i_lnon)) 459 + call md_abort('Memory allocation failed for lnon',9999) 460c 461c construct solvent non-bonded list 462c --------------------------------- 463c 464 if(.not.argos_prep_nonbon(natm+1,natmt,int_mb(i_lbnd), 465 + mbnd,nbnd+1,nbndt, 466 + int_mb(i_lang),mang,nang+1,nangt, 467 + int_mb(i_l3rd),m3rd,n3rd+1,n3rdt, 468 + int_mb(i_lnon),mnon,nnon)) 469 + call md_abort('argos_prep_nonbon failed',9999) 470c 471 if(util_print('topology',print_high)) then 472 write(lfnout,1010) nnon 473 1010 format(' Solvent non-bonded list length is',i10) 474 endif 475c 476c apply topology modifications to bonded parameters 477c ------------------------------------------------- 478c 479 if(.not.argos_prep_modify(2,lfnout,lfnmod,filmod,nparms,mparms, 480 + int_mb(i_latm),byte_mb(i_catm),dbl_mb(i_qatm),matm,natm, 481 + int_mb(i_lseq),byte_mb(i_cseq),mseq,nseq, 482 + int_mb(i_lbnd),dbl_mb(i_rbnd),mbnd,nbnd,nbndt, 483 + int_mb(i_lang),dbl_mb(i_rang),mang,nang,nangt, 484 + int_mb(i_ldih),int_mb(i_ndih),int_mb(i_kdih), 485 + dbl_mb(i_rdih),mdih,ndih,ndiht, 486 + int_mb(i_limp),int_mb(i_kimp),dbl_mb(i_rimp),mimp,nimp,nimpt, 487 + lupdat)) 488 + call md_abort('argos_prep_modify failed',9999) 489c 490c write the topology file 491c ----------------------- 492c 493 if(.not.argos_prep_wrttop(lfnout,title,lfntop,filtop,lfnhdb, 494 + lfnhop,filhop,lfnbsg,filbsg,releps,q14fac, 495 + nparms,mparms,int_mb(i_lseq),byte_mb(i_cseq),mseq,nseq,mqu, 496 + int_mb(i_latt),int_mb(i_lats),byte_mb(i_catt),dbl_mb(i_patt), 497 + dbl_mb(i_ratt),matt,natt,mats,nats,int_mb(i_latm), 498 + byte_mb(i_catm), 499 + dbl_mb(i_qatm),matm,natm,int_mb(i_lbnd),dbl_mb(i_rbnd),mbnd, 500 + nbnd,int_mb(i_lang), 501 + dbl_mb(i_rang),mang,nang,int_mb(i_ldih),int_mb(i_ndih), 502 + int_mb(i_kdih),dbl_mb(i_rdih),mdih,ndih, 503 + int_mb(i_limp),int_mb(i_kimp),dbl_mb(i_rimp),mimp,nimp, 504 + int_mb(i_l3rd), 505 + m3rd,n3rd,int_mb(i_lexc),mexc,nexc,int_mb(i_lnon),mnon,nnon, 506 + natmt,nbndt,nangt,ndiht,nimpt,n3rdt,wcorr,slvnam,itopol)) 507 + call md_abort('argos_prep_wrttop failed',9999) 508c 509 if(util_print('topology',print_debug)) then 510 write(lfnout,1011) 511 1011 format(' Topology file is written') 512 endif 513c 514c deallocate memory 515c ----------------- 516c 517 if(.not.ma_pop_stack(l_lnon)) 518 + call md_abort('Memory deallocation failed for lnon',9999) 519 if(.not.ma_pop_stack(l_lexc)) 520 + call md_abort('Memory deallocation failed for lexc',9999) 521 if(.not.ma_pop_stack(l_l3rd)) 522 + call md_abort('Memory deallocation failed for l3rd',9999) 523 if(.not.ma_pop_stack(l_ratt)) 524 + call md_abort('Memory deallocation failed for ratt',9999) 525 if(.not.ma_pop_stack(l_patt)) 526 + call md_abort('Memory deallocation failed for patt',9999) 527 if(.not.ma_pop_stack(l_catt)) 528 + call md_abort('Memory deallocation failed for catt',9999) 529 if(.not.ma_pop_stack(l_lats)) 530 + call md_abort('Memory deallocation failed for lats',9999) 531 if(.not.ma_pop_stack(l_latt)) 532 + call md_abort('Memory deallocation failed for latt',9999) 533 if(.not.ma_pop_stack(l_rimp)) 534 + call md_abort('Memory deallocation failed for rimp',9999) 535 if(.not.ma_pop_stack(l_kimp)) 536 + call md_abort('Memory deallocation failed for limp',9999) 537 if(.not.ma_pop_stack(l_limp)) 538 + call md_abort('Memory deallocation failed for limp',9999) 539 if(.not.ma_pop_stack(l_rdih)) 540 + call md_abort('Memory deallocation failed for rdih',9999) 541 if(.not.ma_pop_stack(l_kdih)) 542 + call md_abort('Memory deallocation failed for kdih',9999) 543 if(.not.ma_pop_stack(l_ndih)) 544 + call md_abort('Memory deallocation failed for ldih',9999) 545 if(.not.ma_pop_stack(l_ldih)) 546 + call md_abort('Memory deallocation failed for ldih',9999) 547 if(.not.ma_pop_stack(l_rang)) 548 + call md_abort('Memory deallocation failed for rang',9999) 549 if(.not.ma_pop_stack(l_lang)) 550 + call md_abort('Memory deallocation failed for lang',9999) 551 if(.not.ma_pop_stack(l_rbnd)) 552 + call md_abort('Memory deallocation failed for rbnd',9999) 553 if(.not.ma_pop_stack(l_lbnd)) 554 + call md_abort('Memory deallocation failed for lbnd',9999) 555 if(.not.ma_pop_stack(l_qatm)) 556 + call md_abort('Memory deallocation failed for qatm',9999) 557 if(.not.ma_pop_stack(l_catm)) 558 + call md_abort('Memory deallocation failed for catm',9999) 559 if(.not.ma_pop_stack(l_latm)) 560 + call md_abort('Memory deallocation failed for latm',9999) 561 if(.not.ma_pop_stack(l_clnk)) 562 + call md_abort('Memory deallocation failed for clnk',9999) 563 if(.not.ma_pop_stack(l_llnk)) 564 + call md_abort('Memory deallocation failed for llnk',9999) 565 if(.not.ma_pop_stack(l_cseq)) 566 + call md_abort('Memory deallocation failed for cseq',9999) 567 if(.not.ma_pop_stack(l_lseq)) 568 + call md_abort('Memory deallocation failed for lseq',9999) 569c 570 argos_prep_mktop=.true. 571 return 572 end 573