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