source: CPL/oasis3-mct/branches/OASIS3-MCT_5.0_branch/lib/mct/mpeu/m_mall.F90

Last change on this file was 6331, checked in by aclsce, 17 months ago

Moved oasis-mct_5.0 in oasis3-mct/branches directory.
File size: 44.6 KB
Line 
1!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
3!-----------------------------------------------------------------------
4! CVS $Id$
5! CVS $Name$
6!-----------------------------------------------------------------------
7!BOP
8!
9! !MODULE: m_mall - A bookkeeper of user allocated memories
10!
11! !DESCRIPTION:
12!
13! !INTERFACE:
14
15    module m_mall
16      implicit none
17      private   ! except
18
19      public :: mall_ci
20      public :: mall_co
21      public :: mall_mci
22      public :: mall_mco
23      public :: mall_flush
24      public :: mall_reset
25
26                ! mall_ activity controls
27
28      public :: mall_ison
29      public :: mall_set
30
31      interface mall_ci;    module procedure ci_; end interface
32      interface mall_co;    module procedure co_; end interface
33
34      interface mall_mci;    module procedure   &
35        ciI0_,  &
36        ciI1_,  &
37        ciI2_,  &
38        ciI3_,  &
39        ciR0_,  &
40        ciR1_,  &
41        ciR2_,  &
42        ciR3_,  &
43        ciD0_,  &
44        ciD1_,  &
45        ciD2_,  &
46        ciD3_,  &
47        ciL0_,  &
48        ciL1_,  &
49        ciL2_,  &
50        ciL3_,  &
51        ciC0_,  &
52        ciC1_,  &
53        ciC2_,  &
54        ciC3_
55      end interface
56
57      interface mall_mco;    module procedure   &
58        coI0_,  &
59        coI1_,  &
60        coI2_,  &
61        coI3_,  &
62        coR0_,  &
63        coR1_,  &
64        coR2_,  &
65        coR3_,  &
66        coD0_,  &
67        coD1_,  &
68        coD2_,  &
69        coD3_,  &
70        coL0_,  &
71        coL1_,  &
72        coL2_,  &
73        coL3_,  &
74        coC0_,  &
75        coC1_,  &
76        coC2_,  &
77        coC3_
78      end interface
79
80      interface mall_flush; module procedure flush_; end interface
81      interface mall_reset; module procedure reset_; end interface
82
83      interface mall_ison; module procedure ison_; end interface
84      interface mall_set;  module procedure set_;  end interface
85
86! !REVISION HISTORY:
87!       13Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
88!EOP
89!_______________________________________________________________________
90  character(len=*),parameter :: myname='MCT(MPEU)::m_mall'
91
92#if SYSUNICOS || SYSIRIX64 || _R8_
93  integer,parameter :: NBYTE_PER_WORD = 8
94#else
95  integer,parameter :: NBYTE_PER_WORD = 4
96#endif
97
98  integer,parameter :: NSZ= 32
99  integer,parameter :: MXL=250
100
101  integer, save :: nreset = 0           ! number of reset_() calls
102  logical, save :: started = .false.    ! the module is in use
103
104  integer, save :: n_ =0                ! number of accouting bins.
105  character(len=NSZ),dimension(MXL),save :: name_
106
107  ! integer, dimension(1) :: mall
108                                        ! names of the accouting bins
109
110  logical,save :: mall_on=.false.       ! mall activity switch
111
112  integer,save :: mci
113  integer,dimension(MXL),save :: mci_   ! maximum ci_() calls
114  integer,save :: nci
115  integer,dimension(MXL),save :: nci_   ! net ci_() calls
116  integer,save :: hwm
117  integer,dimension(MXL),save :: hwm_   ! high-water-mark of allocate()
118  integer,save :: nwm
119  integer,dimension(MXL),save :: nwm_   ! net-water-mark of allocate()
120
121contains
122!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
123!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
124!BOP -------------------------------------------------------------------
125!
126! !IROUTINE: ison_ -
127!
128! !DESCRIPTION:
129!
130! !INTERFACE:
131
132    function ison_()
133      implicit none
134      logical :: ison_
135
136! !REVISION HISTORY:
137!       25Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
138!               - initial prototype/prolog/code
139!EOP ___________________________________________________________________
140
141  character(len=*),parameter :: myname_=myname//'::ison_'
142
143  ison_=mall_on
144
145end function ison_
146
147!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
148!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
149!BOP -------------------------------------------------------------------
150!
151! !IROUTINE: set_ - set the switch on
152!
153! !DESCRIPTION:
154!
155! !INTERFACE:
156
157    subroutine set_(on)
158      implicit none
159      logical,optional,intent(in) :: on
160
161! !REVISION HISTORY:
162!       25Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
163!               - initial prototype/prolog/code
164!EOP ___________________________________________________________________
165
166  character(len=*),parameter :: myname_=myname//'::set_'
167
168  mall_on=.true.
169  if(present(on)) mall_on=on
170
171end subroutine set_
172
173!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
174!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
175!BOP -------------------------------------------------------------------
176!
177! !IROUTINE: ciI0_ - check in as an integer scalar
178!
179! !DESCRIPTION:
180!
181! !INTERFACE:
182
183    subroutine ciI0_(marg,thread)
184      implicit none
185      integer,intent(in) :: marg
186      character(len=*),intent(in) :: thread
187
188! !REVISION HISTORY:
189!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
190!               - initial prototype/prolog/code
191!EOP ___________________________________________________________________
192
193  character(len=*),parameter :: myname_=myname//'::ciI0_'
194
195  if(mall_on) call ci_(1,thread)
196
197end subroutine ciI0_
198
199!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
200!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
201!BOP -------------------------------------------------------------------
202!
203! !IROUTINE: ciI1_ - check in as an integer rank 1 array
204!
205! !DESCRIPTION:
206!
207! !INTERFACE:
208
209    subroutine ciI1_(marg,thread)
210      implicit none
211      integer,dimension(:),intent(in) :: marg
212      character(len=*),intent(in) :: thread
213
214! !REVISION HISTORY:
215!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
216!               - initial prototype/prolog/code
217!EOP ___________________________________________________________________
218
219  character(len=*),parameter :: myname_=myname//'::ciI1_'
220
221  if(mall_on) call ci_(size(marg),thread)
222
223end subroutine ciI1_
224
225!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
226!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
227!BOP -------------------------------------------------------------------
228!
229! !IROUTINE: ciI2_ - check in as an integer rank 2 array
230!
231! !DESCRIPTION:
232!
233! !INTERFACE:
234
235    subroutine ciI2_(marg,thread)
236      implicit none
237      integer,dimension(:,:),intent(in) :: marg
238      character(len=*),intent(in) :: thread
239
240! !REVISION HISTORY:
241!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
242!               - initial prototype/prolog/code
243!EOP ___________________________________________________________________
244
245  character(len=*),parameter :: myname_=myname//'::ciI2_'
246
247  if(mall_on) call ci_(size(marg),thread)
248
249end subroutine ciI2_
250
251!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
252!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
253!BOP -------------------------------------------------------------------
254!
255! !IROUTINE: ciI3_ - check in as an integer rank 3 array
256!
257! !DESCRIPTION:
258!
259! !INTERFACE:
260
261    subroutine ciI3_(marg,thread)
262      implicit none
263      integer,dimension(:,:,:),intent(in) :: marg
264      character(len=*),intent(in) :: thread
265
266! !REVISION HISTORY:
267!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
268!               - initial prototype/prolog/code
269!EOP ___________________________________________________________________
270
271  character(len=*),parameter :: myname_=myname//'::ciI3_'
272
273  if(mall_on) call ci_(size(marg),thread)
274
275end subroutine ciI3_
276
277!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
278!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
279!BOP -------------------------------------------------------------------
280!
281! !IROUTINE: ciR0_ - check in as a real(SP) scalar
282!
283! !DESCRIPTION:
284!
285! !INTERFACE:
286
287    subroutine ciR0_(marg,thread)
288      use m_realkinds, only : SP
289      implicit none
290      real(SP),intent(in) :: marg
291      character(len=*),intent(in) :: thread
292
293! !REVISION HISTORY:
294!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
295!               - initial prototype/prolog/code
296!EOP ___________________________________________________________________
297
298  character(len=*),parameter :: myname_=myname//'::ciR0_'
299
300  if(mall_on) call ci_(1,thread)
301
302end subroutine ciR0_
303
304!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
305!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
306!BOP -------------------------------------------------------------------
307!
308! !IROUTINE: ciR1_ - check in as a real(SP) rank 1 array
309!
310! !DESCRIPTION:
311!
312! !INTERFACE:
313
314    subroutine ciR1_(marg,thread)
315      use m_realkinds, only : SP
316      implicit none
317      real(SP),dimension(:),intent(in) :: marg
318      character(len=*),intent(in) :: thread
319
320! !REVISION HISTORY:
321!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
322!               - initial prototype/prolog/code
323!EOP ___________________________________________________________________
324
325  character(len=*),parameter :: myname_=myname//'::ciR1_'
326
327  if(mall_on) call ci_(size(marg),thread)
328
329end subroutine ciR1_
330
331!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
332!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
333!BOP -------------------------------------------------------------------
334!
335! !IROUTINE: ciR2_ - check in as a real(SP) rank 2 array
336!
337! !DESCRIPTION:
338!
339! !INTERFACE:
340
341    subroutine ciR2_(marg,thread)
342      use m_realkinds, only : SP
343      implicit none
344      real(SP),dimension(:,:),intent(in) :: marg
345      character(len=*),intent(in) :: thread
346
347! !REVISION HISTORY:
348!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
349!               - initial prototype/prolog/code
350!EOP ___________________________________________________________________
351
352  character(len=*),parameter :: myname_=myname//'::ciR2_'
353
354  if(mall_on) call ci_(size(marg),thread)
355
356end subroutine ciR2_
357
358!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
359!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
360!BOP -------------------------------------------------------------------
361!
362! !IROUTINE: ciR3_ - check in as a real(SP) rank 3 array
363!
364! !DESCRIPTION:
365!
366! !INTERFACE:
367
368    subroutine ciR3_(marg,thread)
369      use m_realkinds, only : SP
370      implicit none
371      real(SP),dimension(:,:,:),intent(in) :: marg
372      character(len=*),intent(in) :: thread
373
374! !REVISION HISTORY:
375!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
376!               - initial prototype/prolog/code
377!EOP ___________________________________________________________________
378
379  character(len=*),parameter :: myname_=myname//'::ciR3_'
380
381  if(mall_on) call ci_(size(marg),thread)
382
383end subroutine ciR3_
384
385!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
386!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
387!BOP -------------------------------------------------------------------
388!
389! !IROUTINE: ciD0_ - check in as a real(DP) scalar
390!
391! !DESCRIPTION:
392!
393! !INTERFACE:
394
395    subroutine ciD0_(marg,thread)
396      use m_realkinds, only : DP
397      implicit none
398      real(DP),intent(in) :: marg
399      character(len=*),intent(in) :: thread
400
401! !REVISION HISTORY:
402!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
403!               - initial prototype/prolog/code
404!EOP ___________________________________________________________________
405
406  character(len=*),parameter :: myname_=myname//'::ciD0_'
407
408  if(mall_on) call ci_(2,thread)
409
410end subroutine ciD0_
411
412!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
413!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
414!BOP -------------------------------------------------------------------
415!
416! !IROUTINE: ciD1_ - check in as a real(DP) rank 1 array
417!
418! !DESCRIPTION:
419!
420! !INTERFACE:
421
422    subroutine ciD1_(marg,thread)
423      use m_realkinds, only : DP
424      implicit none
425      real(DP),dimension(:),intent(in) :: marg
426      character(len=*),intent(in) :: thread
427
428! !REVISION HISTORY:
429!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
430!               - initial prototype/prolog/code
431!EOP ___________________________________________________________________
432
433  character(len=*),parameter :: myname_=myname//'::ciD1_'
434
435  if(mall_on) call ci_(2*size(marg),thread)
436
437end subroutine ciD1_
438
439!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
440!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
441!BOP -------------------------------------------------------------------
442!
443! !IROUTINE: ciD2_ - check in as a real(DP) rank 2 array
444!
445! !DESCRIPTION:
446!
447! !INTERFACE:
448
449    subroutine ciD2_(marg,thread)
450      use m_realkinds, only : DP
451      implicit none
452      real(DP),dimension(:,:),intent(in) :: marg
453      character(len=*),intent(in) :: thread
454
455! !REVISION HISTORY:
456!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
457!               - initial prototype/prolog/code
458!EOP ___________________________________________________________________
459
460  character(len=*),parameter :: myname_=myname//'::ciD2_'
461
462  if(mall_on) call ci_(2*size(marg),thread)
463
464end subroutine ciD2_
465
466!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
467!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
468!BOP -------------------------------------------------------------------
469!
470! !IROUTINE: ciD3_ - check in as a real(DP) rank 3 array
471!
472! !DESCRIPTION:
473!
474! !INTERFACE:
475
476    subroutine ciD3_(marg,thread)
477      use m_realkinds, only : DP
478      implicit none
479      real(DP),dimension(:,:,:),intent(in) :: marg
480      character(len=*),intent(in) :: thread
481
482! !REVISION HISTORY:
483!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
484!               - initial prototype/prolog/code
485!EOP ___________________________________________________________________
486
487  character(len=*),parameter :: myname_=myname//'::ciD3_'
488
489  if(mall_on) call ci_(2*size(marg),thread)
490
491end subroutine ciD3_
492
493!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
494!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
495!BOP -------------------------------------------------------------------
496!
497! !IROUTINE: ciL0_ - check in as a logical scalar
498!
499! !DESCRIPTION:
500!
501! !INTERFACE:
502
503    subroutine ciL0_(marg,thread)
504      implicit none
505      logical,intent(in) :: marg
506      character(len=*),intent(in) :: thread
507
508! !REVISION HISTORY:
509!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
510!               - initial prototype/prolog/code
511!EOP ___________________________________________________________________
512
513  character(len=*),parameter :: myname_=myname//'::ciL0_'
514
515  if(mall_on) call ci_(1,thread)
516
517end subroutine ciL0_
518
519!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
520!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
521!BOP -------------------------------------------------------------------
522!
523! !IROUTINE: ciL1_ - check in as a logical rank 1 array
524!
525! !DESCRIPTION:
526!
527! !INTERFACE:
528
529    subroutine ciL1_(marg,thread)
530      implicit none
531      logical,dimension(:),intent(in) :: marg
532      character(len=*),intent(in) :: thread
533
534! !REVISION HISTORY:
535!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
536!               - initial prototype/prolog/code
537!EOP ___________________________________________________________________
538
539  character(len=*),parameter :: myname_=myname//'::ciL1_'
540
541  if(mall_on) call ci_(size(marg),thread)
542
543end subroutine ciL1_
544
545!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
546!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
547!BOP -------------------------------------------------------------------
548!
549! !IROUTINE: ciL2_ - check in as a logical rank 2 array
550!
551! !DESCRIPTION:
552!
553! !INTERFACE:
554
555    subroutine ciL2_(marg,thread)
556      implicit none
557      logical,dimension(:,:),intent(in) :: marg
558      character(len=*),intent(in) :: thread
559
560! !REVISION HISTORY:
561!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
562!               - initial prototype/prolog/code
563!EOP ___________________________________________________________________
564
565  character(len=*),parameter :: myname_=myname//'::ciL2_'
566
567  if(mall_on) call ci_(size(marg),thread)
568
569end subroutine ciL2_
570
571!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
572!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
573!BOP -------------------------------------------------------------------
574!
575! !IROUTINE: ciL3_ - check in as a logical rank 3 array
576!
577! !DESCRIPTION:
578!
579! !INTERFACE:
580
581    subroutine ciL3_(marg,thread)
582      implicit none
583      logical,dimension(:,:,:),intent(in) :: marg
584      character(len=*),intent(in) :: thread
585
586! !REVISION HISTORY:
587!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
588!               - initial prototype/prolog/code
589!EOP ___________________________________________________________________
590
591  character(len=*),parameter :: myname_=myname//'::ciL3_'
592
593  if(mall_on) call ci_(size(marg),thread)
594
595end subroutine ciL3_
596
597!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
598!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
599!BOP -------------------------------------------------------------------
600!
601! !IROUTINE: ciC0_ - check in as a character scalar
602!
603! !DESCRIPTION:
604!
605! !INTERFACE:
606
607    subroutine ciC0_(marg,thread)
608      implicit none
609      character(len=*),intent(in) :: marg
610      character(len=*),intent(in) :: thread
611
612! !REVISION HISTORY:
613!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
614!               - initial prototype/prolog/code
615!EOP ___________________________________________________________________
616
617  character(len=*),parameter :: myname_=myname//'::ciC0_'
618  integer :: nw
619
620  if(.not.mall_on) return
621  nw=(len(marg)+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
622  call ci_(nw,thread)
623
624end subroutine ciC0_
625
626!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
627!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
628!BOP -------------------------------------------------------------------
629!
630! !IROUTINE: ciC1_ - check in as a character rank 1 array
631!
632! !DESCRIPTION:
633!
634! !INTERFACE:
635
636    subroutine ciC1_(marg,thread)
637      implicit none
638      character(len=*),dimension(:),intent(in) :: marg
639      character(len=*),intent(in) :: thread
640
641! !REVISION HISTORY:
642!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
643!               - initial prototype/prolog/code
644!EOP ___________________________________________________________________
645
646  character(len=*),parameter :: myname_=myname//'::ciC1_'
647  integer :: nw
648
649  if(.not.mall_on) return
650  nw=(len(marg(1))+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
651  call ci_(size(marg)*nw,thread)
652
653end subroutine ciC1_
654
655!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
656!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
657!BOP -------------------------------------------------------------------
658!
659! !IROUTINE: ciC2_ - check in as a character rank 2 array
660!
661! !DESCRIPTION:
662!
663! !INTERFACE:
664
665    subroutine ciC2_(marg,thread)
666      implicit none
667      character(len=*),dimension(:,:),intent(in) :: marg
668      character(len=*),intent(in) :: thread
669
670! !REVISION HISTORY:
671!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
672!               - initial prototype/prolog/code
673!EOP ___________________________________________________________________
674
675  character(len=*),parameter :: myname_=myname//'::ciC2_'
676  integer :: nw
677
678  if(.not.mall_on) return
679  nw=(len(marg(1,1))+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
680  call ci_(size(marg)*nw,thread)
681
682end subroutine ciC2_
683
684!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
685!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
686!BOP -------------------------------------------------------------------
687!
688! !IROUTINE: ciC3_ - check in as a character rank 3 array
689!
690! !DESCRIPTION:
691!
692! !INTERFACE:
693
694    subroutine ciC3_(marg,thread)
695      implicit none
696      character(len=*),dimension(:,:,:),intent(in) :: marg
697      character(len=*),intent(in) :: thread
698
699! !REVISION HISTORY:
700!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
701!               - initial prototype/prolog/code
702!EOP ___________________________________________________________________
703
704  character(len=*),parameter :: myname_=myname//'::ciC3_'
705  integer :: nw
706
707  if(.not.mall_on) return
708  nw=(len(marg(1,1,1))+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
709  call ci_(size(marg)*nw,thread)
710
711end subroutine ciC3_
712
713!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
714!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
715!-----------------------------------------------------------------------
716!BOP
717!
718! !IROUTINE: ci_ - check-in allocate activity
719!
720! !DESCRIPTION:
721!
722! !INTERFACE:
723
724    subroutine ci_(nword,thread)
725      use m_stdio, only : stderr
726      use m_die, only : die
727      implicit none
728      integer,intent(in) :: nword
729      character(len=*),intent(in) :: thread
730
731! !REVISION HISTORY:
732!       13Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
733!EOP
734!_______________________________________________________________________
735  character(len=*),parameter :: myname_=myname//'::ci_'
736  integer :: ith
737
738  if(.not.mall_on) return
739
740  if(nword < 0) then
741    write(stderr,'(2a,i4)') myname_,    &
742        ': invalide argument, nword = ',nword
743    call die(myname_)
744  endif
745
746  ith=lookup_(thread)
747
748        ! update the account
749
750  nci_(ith)=nci_(ith)+1
751  mci_(ith)=mci_(ith)+1
752  nwm_(ith)=nwm_(ith)+nword
753  if(hwm_(ith).lt.nwm_(ith)) hwm_(ith)=nwm_(ith)
754
755        ! update the total budget
756
757  nci=nci+1
758  mci=mci+1
759  nwm=nwm+nword
760  if(hwm.lt.nwm) hwm=nwm
761
762end subroutine ci_
763
764!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
765!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
766!BOP -------------------------------------------------------------------
767!
768! !IROUTINE: coI0_ - check in as an integer scalar
769!
770! !DESCRIPTION:
771!
772! !INTERFACE:
773
774    subroutine coI0_(marg,thread)
775      implicit none
776      integer,intent(in) :: marg
777      character(len=*),intent(in) :: thread
778
779! !REVISION HISTORY:
780!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
781!               - initial prototype/prolog/code
782!EOP ___________________________________________________________________
783
784  character(len=*),parameter :: myname_=myname//'::coI0_'
785
786  if(mall_on) call co_(1,thread)
787
788end subroutine coI0_
789
790!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
791!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
792!BOP -------------------------------------------------------------------
793!
794! !IROUTINE: coI1_ - check in as an integer rank 1 array
795!
796! !DESCRIPTION:
797!
798! !INTERFACE:
799
800    subroutine coI1_(marg,thread)
801      implicit none
802      integer,dimension(:),intent(in) :: marg
803      character(len=*),intent(in) :: thread
804
805! !REVISION HISTORY:
806!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
807!               - initial prototype/prolog/code
808!EOP ___________________________________________________________________
809
810  character(len=*),parameter :: myname_=myname//'::coI1_'
811
812  if(mall_on) call co_(size(marg),thread)
813
814end subroutine coI1_
815
816!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
817!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
818!BOP -------------------------------------------------------------------
819!
820! !IROUTINE: coI2_ - check in as an integer rank 2 array
821!
822! !DESCRIPTION:
823!
824! !INTERFACE:
825
826    subroutine coI2_(marg,thread)
827      implicit none
828      integer,dimension(:,:),intent(in) :: marg
829      character(len=*),intent(in) :: thread
830
831! !REVISION HISTORY:
832!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
833!               - initial prototype/prolog/code
834!EOP ___________________________________________________________________
835
836  character(len=*),parameter :: myname_=myname//'::coI2_'
837
838  if(mall_on) call co_(size(marg),thread)
839
840end subroutine coI2_
841
842!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
843!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
844!BOP -------------------------------------------------------------------
845!
846! !IROUTINE: coI3_ - check in as an integer rank 3 array
847!
848! !DESCRIPTION:
849!
850! !INTERFACE:
851
852    subroutine coI3_(marg,thread)
853      implicit none
854      integer,dimension(:,:,:),intent(in) :: marg
855      character(len=*),intent(in) :: thread
856
857! !REVISION HISTORY:
858!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
859!               - initial prototype/prolog/code
860!EOP ___________________________________________________________________
861
862  character(len=*),parameter :: myname_=myname//'::coI3_'
863
864  if(mall_on) call co_(size(marg),thread)
865
866end subroutine coI3_
867
868!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
869!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
870!BOP -------------------------------------------------------------------
871!
872! !IROUTINE: coR0_ - check in as a real(SP) scalar
873!
874! !DESCRIPTION:
875!
876! !INTERFACE:
877
878    subroutine coR0_(marg,thread)
879      use m_realkinds, only : SP
880      implicit none
881      real(SP),intent(in) :: marg
882      character(len=*),intent(in) :: thread
883
884! !REVISION HISTORY:
885!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
886!               - initial prototype/prolog/code
887!EOP ___________________________________________________________________
888
889  character(len=*),parameter :: myname_=myname//'::coR0_'
890
891  if(mall_on) call co_(1,thread)
892
893end subroutine coR0_
894
895!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
896!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
897!BOP -------------------------------------------------------------------
898!
899! !IROUTINE: coR1_ - check in as a real(SP) rank 1 array
900!
901! !DESCRIPTION:
902!
903! !INTERFACE:
904
905    subroutine coR1_(marg,thread)
906      use m_realkinds, only : SP
907      implicit none
908      real(SP),dimension(:),intent(in) :: marg
909      character(len=*),intent(in) :: thread
910
911! !REVISION HISTORY:
912!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
913!               - initial prototype/prolog/code
914!EOP ___________________________________________________________________
915
916  character(len=*),parameter :: myname_=myname//'::coR1_'
917
918  if(mall_on) call co_(size(marg),thread)
919
920end subroutine coR1_
921
922!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
923!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
924!BOP -------------------------------------------------------------------
925!
926! !IROUTINE: coR2_ - check in as a real(SP) rank 2 array
927!
928! !DESCRIPTION:
929!
930! !INTERFACE:
931
932    subroutine coR2_(marg,thread)
933      use m_realkinds, only : SP
934      implicit none
935      real(SP),dimension(:,:),intent(in) :: marg
936      character(len=*),intent(in) :: thread
937
938! !REVISION HISTORY:
939!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
940!               - initial prototype/prolog/code
941!EOP ___________________________________________________________________
942
943  character(len=*),parameter :: myname_=myname//'::coR2_'
944
945  if(mall_on) call co_(size(marg),thread)
946
947end subroutine coR2_
948
949!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
950!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
951!BOP -------------------------------------------------------------------
952!
953! !IROUTINE: coR3_ - check in as a real(SP) rank 3 array
954!
955! !DESCRIPTION:
956!
957! !INTERFACE:
958
959    subroutine coR3_(marg,thread)
960      use m_realkinds, only : SP
961      implicit none
962      real(SP),dimension(:,:,:),intent(in) :: marg
963      character(len=*),intent(in) :: thread
964
965! !REVISION HISTORY:
966!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
967!               - initial prototype/prolog/code
968!EOP ___________________________________________________________________
969
970  character(len=*),parameter :: myname_=myname//'::coR3_'
971
972  if(mall_on) call co_(size(marg),thread)
973
974end subroutine coR3_
975
976!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
977!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
978!BOP -------------------------------------------------------------------
979!
980! !IROUTINE: coD0_ - check in as a real(DP) scalar
981!
982! !DESCRIPTION:
983!
984! !INTERFACE:
985
986    subroutine coD0_(marg,thread)
987      use m_realkinds, only : DP
988      implicit none
989      real(DP),intent(in) :: marg
990      character(len=*),intent(in) :: thread
991
992! !REVISION HISTORY:
993!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
994!               - initial prototype/prolog/code
995!EOP ___________________________________________________________________
996
997  character(len=*),parameter :: myname_=myname//'::coD0_'
998
999  if(mall_on) call co_(2,thread)
1000
1001end subroutine coD0_
1002
1003!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1004!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1005!BOP -------------------------------------------------------------------
1006!
1007! !IROUTINE: coD1_ - check in as a real(DP) rank 1 array
1008!
1009! !DESCRIPTION:
1010!
1011! !INTERFACE:
1012
1013    subroutine coD1_(marg,thread)
1014      use m_realkinds, only : DP
1015      implicit none
1016      real(DP),dimension(:),intent(in) :: marg
1017      character(len=*),intent(in) :: thread
1018
1019! !REVISION HISTORY:
1020!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
1021!               - initial prototype/prolog/code
1022!EOP ___________________________________________________________________
1023
1024  character(len=*),parameter :: myname_=myname//'::coD1_'
1025
1026  if(mall_on) call co_(2*size(marg),thread)
1027
1028end subroutine coD1_
1029
1030!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1031!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1032!BOP -------------------------------------------------------------------
1033!
1034! !IROUTINE: coD2_ - check in as a real(DP) rank 2 array
1035!
1036! !DESCRIPTION:
1037!
1038! !INTERFACE:
1039
1040    subroutine coD2_(marg,thread)
1041      use m_realkinds, only : DP
1042      implicit none
1043      real(DP),dimension(:,:),intent(in) :: marg
1044      character(len=*),intent(in) :: thread
1045
1046! !REVISION HISTORY:
1047!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
1048!               - initial prototype/prolog/code
1049!EOP ___________________________________________________________________
1050
1051  character(len=*),parameter :: myname_=myname//'::coD2_'
1052
1053  if(mall_on) call co_(2*size(marg),thread)
1054
1055end subroutine coD2_
1056
1057!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1058!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1059!BOP -------------------------------------------------------------------
1060!
1061! !IROUTINE: coD3_ - check in as a real(DP) rank 3 array
1062!
1063! !DESCRIPTION:
1064!
1065! !INTERFACE:
1066
1067    subroutine coD3_(marg,thread)
1068      use m_realkinds, only : DP
1069      implicit none
1070      real(DP),dimension(:,:,:),intent(in) :: marg
1071      character(len=*),intent(in) :: thread
1072
1073! !REVISION HISTORY:
1074!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
1075!               - initial prototype/prolog/code
1076!EOP ___________________________________________________________________
1077
1078  character(len=*),parameter :: myname_=myname//'::coD3_'
1079
1080  if(mall_on) call co_(2*size(marg),thread)
1081
1082end subroutine coD3_
1083
1084!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1085!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1086!BOP -------------------------------------------------------------------
1087!
1088! !IROUTINE: coL0_ - check in as a logical scalar
1089!
1090! !DESCRIPTION:
1091!
1092! !INTERFACE:
1093
1094    subroutine coL0_(marg,thread)
1095      implicit none
1096      logical,intent(in) :: marg
1097      character(len=*),intent(in) :: thread
1098
1099! !REVISION HISTORY:
1100!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
1101!               - initial prototype/prolog/code
1102!EOP ___________________________________________________________________
1103
1104  character(len=*),parameter :: myname_=myname//'::coL0_'
1105
1106  if(mall_on) call co_(1,thread)
1107
1108end subroutine coL0_
1109
1110!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1111!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1112!BOP -------------------------------------------------------------------
1113!
1114! !IROUTINE: coL1_ - check in as a logical rank 1 array
1115!
1116! !DESCRIPTION:
1117!
1118! !INTERFACE:
1119
1120    subroutine coL1_(marg,thread)
1121      implicit none
1122      logical,dimension(:),intent(in) :: marg
1123      character(len=*),intent(in) :: thread
1124
1125! !REVISION HISTORY:
1126!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
1127!               - initial prototype/prolog/code
1128!EOP ___________________________________________________________________
1129
1130  character(len=*),parameter :: myname_=myname//'::coL1_'
1131
1132  if(mall_on) call co_(size(marg),thread)
1133
1134end subroutine coL1_
1135
1136!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1137!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1138!BOP -------------------------------------------------------------------
1139!
1140! !IROUTINE: coL2_ - check in as a logical rank 2 array
1141!
1142! !DESCRIPTION:
1143!
1144! !INTERFACE:
1145
1146    subroutine coL2_(marg,thread)
1147      implicit none
1148      logical,dimension(:,:),intent(in) :: marg
1149      character(len=*),intent(in) :: thread
1150
1151! !REVISION HISTORY:
1152!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
1153!               - initial prototype/prolog/code
1154!EOP ___________________________________________________________________
1155
1156  character(len=*),parameter :: myname_=myname//'::coL2_'
1157
1158  if(mall_on) call co_(size(marg),thread)
1159
1160end subroutine coL2_
1161
1162!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1163!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1164!BOP -------------------------------------------------------------------
1165!
1166! !IROUTINE: coL3_ - check in as a logical rank 3 array
1167!
1168! !DESCRIPTION:
1169!
1170! !INTERFACE:
1171
1172    subroutine coL3_(marg,thread)
1173      implicit none
1174      logical,dimension(:,:,:),intent(in) :: marg
1175      character(len=*),intent(in) :: thread
1176
1177! !REVISION HISTORY:
1178!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
1179!               - initial prototype/prolog/code
1180!EOP ___________________________________________________________________
1181
1182  character(len=*),parameter :: myname_=myname//'::coL3_'
1183
1184  if(mall_on) call co_(size(marg),thread)
1185
1186end subroutine coL3_
1187
1188!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1189!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1190!BOP -------------------------------------------------------------------
1191!
1192! !IROUTINE: coC0_ - check in as a character scalar
1193!
1194! !DESCRIPTION:
1195!
1196! !INTERFACE:
1197
1198    subroutine coC0_(marg,thread)
1199      implicit none
1200      character(len=*),intent(in) :: marg
1201      character(len=*),intent(in) :: thread
1202
1203! !REVISION HISTORY:
1204!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
1205!               - initial prototype/prolog/code
1206!EOP ___________________________________________________________________
1207
1208  character(len=*),parameter :: myname_=myname//'::coC0_'
1209  integer :: nw
1210
1211  if(.not.mall_on) return
1212  nw=(len(marg)+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
1213  call co_(nw,thread)
1214
1215end subroutine coC0_
1216
1217!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1218!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1219!BOP -------------------------------------------------------------------
1220!
1221! !IROUTINE: coC1_ - check in as a character rank 1 array
1222!
1223! !DESCRIPTION:
1224!
1225! !INTERFACE:
1226
1227    subroutine coC1_(marg,thread)
1228      implicit none
1229      character(len=*),dimension(:),intent(in) :: marg
1230      character(len=*),intent(in) :: thread
1231
1232! !REVISION HISTORY:
1233!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
1234!               - initial prototype/prolog/code
1235!EOP ___________________________________________________________________
1236
1237  character(len=*),parameter :: myname_=myname//'::coC1_'
1238  integer :: nw
1239
1240  if(.not.mall_on) return
1241  nw=(len(marg(1))+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
1242  call co_(size(marg)*nw,thread)
1243
1244end subroutine coC1_
1245
1246!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1247!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1248!BOP -------------------------------------------------------------------
1249!
1250! !IROUTINE: coC2_ - check in as a character rank 2 array
1251!
1252! !DESCRIPTION:
1253!
1254! !INTERFACE:
1255
1256    subroutine coC2_(marg,thread)
1257      implicit none
1258      character(len=*),dimension(:,:),intent(in) :: marg
1259      character(len=*),intent(in) :: thread
1260
1261! !REVISION HISTORY:
1262!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
1263!               - initial prototype/prolog/code
1264!EOP ___________________________________________________________________
1265
1266  character(len=*),parameter :: myname_=myname//'::coC2_'
1267  integer :: nw
1268
1269  if(.not.mall_on) return
1270  nw=(len(marg(1,1))+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
1271  call co_(size(marg)*nw,thread)
1272
1273end subroutine coC2_
1274
1275!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1276!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1277!BOP -------------------------------------------------------------------
1278!
1279! !IROUTINE: coC3_ - check in as a character rank 3 array
1280!
1281! !DESCRIPTION:
1282!
1283! !INTERFACE:
1284
1285    subroutine coC3_(marg,thread)
1286      implicit none
1287      character(len=*),dimension(:,:,:),intent(in) :: marg
1288      character(len=*),intent(in) :: thread
1289
1290! !REVISION HISTORY:
1291!       21Oct99 - Jing Guo <guo@dao.gsfc.nasa.gov>
1292!               - initial prototype/prolog/code
1293!EOP ___________________________________________________________________
1294
1295  character(len=*),parameter :: myname_=myname//'::coC3_'
1296  integer :: nw
1297
1298  if(.not.mall_on) return
1299  nw=(len(marg(1,1,1))+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
1300  call co_(size(marg)*nw,thread)
1301
1302end subroutine coC3_
1303
1304!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1305!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1306!-----------------------------------------------------------------------
1307!BOP
1308!
1309! !IROUTINE: co_ - check-out allocate activity
1310!
1311! !DESCRIPTION:
1312!
1313! !INTERFACE:
1314
1315    subroutine co_(nword,thread)
1316      use m_stdio, only : stderr
1317      use m_die, only : die
1318      implicit none
1319      integer,intent(in) :: nword
1320      character(len=*),intent(in) :: thread
1321
1322! !REVISION HISTORY:
1323!       13Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
1324!EOP
1325!_______________________________________________________________________
1326  character(len=*),parameter :: myname_=myname//'::co_'
1327  integer :: ith
1328
1329  if(.not.mall_on) return
1330
1331  if(nword < 0) then
1332    write(stderr,'(2a,i4)') myname_,    &
1333        ': invalide argument, nword = ',nword
1334    call die(myname_)
1335  endif
1336
1337        ! if the thread is "unknown", it would be treated as a
1338        ! new thread with net negative memory activity.
1339
1340  ith=lookup_(thread)
1341
1342        ! update the account
1343
1344  nci_(ith)=nci_(ith)-1
1345  nwm_(ith)=nwm_(ith)-nword
1346
1347        ! update the total budget
1348
1349  nci=nci-1
1350  nwm=nwm-nword
1351
1352end subroutine co_
1353
1354!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1355!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1356!-----------------------------------------------------------------------
1357!BOP
1358!
1359! !IROUTINE: cix_ - handling macro ALLOC_() error
1360!
1361! !DESCRIPTION:
1362!
1363! !INTERFACE:
1364
1365    subroutine cix_(thread,stat,fnam,line)
1366      use m_stdio, only : stderr
1367      use m_die, only : die
1368      implicit none
1369      character(len=*),intent(in) :: thread
1370      integer,intent(in) :: stat
1371      character(len=*),intent(in) :: fnam
1372      integer,intent(in) :: line
1373
1374
1375! !REVISION HISTORY:
1376!       13Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
1377!EOP
1378!_______________________________________________________________________
1379  character(len=*),parameter :: myname_=myname//'::cix_'
1380
1381  write(stderr,'(2a,i4)') trim(thread), &
1382        ': ALLOC_() error, stat =',stat
1383  call die('ALLOC_',fnam,line)
1384
1385end subroutine cix_
1386!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1387!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1388!-----------------------------------------------------------------------
1389!BOP
1390!
1391! !IROUTINE: cox_ - handling macro DEALLOC_() error
1392!
1393! !DESCRIPTION:
1394!
1395! !INTERFACE:
1396
1397    subroutine cox_(thread,stat,fnam,line)
1398      use m_stdio, only : stderr
1399      use m_die, only : die
1400      implicit none
1401      character(len=*),intent(in) :: thread
1402      integer,intent(in) :: stat
1403      character(len=*),intent(in) :: fnam
1404      integer,intent(in) :: line
1405
1406! !REVISION HISTORY:
1407!       13Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
1408!EOP
1409!_______________________________________________________________________
1410  character(len=*),parameter :: myname_=myname//'::cox_'
1411
1412  write(stderr,'(2a,i4)') trim(thread), &
1413        ': DEALLOC_() error, stat =',stat
1414  call die('DEALLOC_',fnam,line)
1415
1416end subroutine cox_
1417
1418!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1419!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1420!-----------------------------------------------------------------------
1421!BOP
1422!
1423! !IROUTINE: flush_ - balancing the up-to-date ci/co calls
1424!
1425! !DESCRIPTION:
1426!
1427! !INTERFACE:
1428
1429    subroutine flush_(lu)
1430      use m_stdio, only : stderr
1431      use m_ioutil, only : luflush
1432      use m_die, only : die
1433      implicit none
1434      integer,intent(in) :: lu
1435
1436! !REVISION HISTORY:
1437!       17Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
1438!EOP
1439!_______________________________________________________________________
1440  character(len=*),parameter :: myname_=myname//'::flush_'
1441
1442  integer,parameter :: lnmax=38
1443  character(len=max(lnmax,NSZ)) :: name
1444
1445  character(len=6) :: hwm_wd,nwm_wd
1446  character(len=1) :: flag_ci,flag_wm
1447  integer :: i,ier,ln
1448
1449  if(.not.mall_on) return
1450
1451  if(.not.started) call reset_()
1452
1453  write(lu,'(72a/)',iostat=ier) ('_',i=1,72)
1454  if(ier /= 0) then
1455    write(stderr,'(2a,i3)') myname_,': can not write(), unit =',lu
1456    call die(myname_)
1457  endif
1458
1459  write(lu,'(a,t39,4(2x,a))',iostat=ier) '[MALL]',      &
1460                'max-ci','net-ci ','max-wm','net-wm'
1461  if(ier /= 0) then
1462    write(stderr,'(2a,i4)') myname_,': can not write(), unit =',lu
1463    call die(myname_)
1464  endif
1465
1466  call luflush(lu)
1467
1468!23.|....1....|....2....|....3....|....4....|....5....|....6....|....7..
1469!_______________________________________________________________________
1470!
1471![MALL]                                 max_ci  net-ci   max-wm  net-wm
1472!-----------------------------------------------------------------------
1473!total.                                 ...333  ...333*  ..333M  ..333i*
1474!_______________________________________________________________________
1475
1476  write(lu,'(72a)') ('-',i=1,72)
1477
1478  do i=1,min(n_,MXL)
1479    call wcount_(hwm_(i),hwm_wd)
1480    call wcount_(nwm_(i),nwm_wd)
1481
1482    flag_ci=' '
1483    if(nci_(i) /= 0) flag_ci='*'
1484
1485    flag_wm=' '
1486    if(nwm_(i) /= 0) flag_wm='*'
1487
1488    name=name_(i)
1489    ln=max(len_trim(name),lnmax)
1490    write(lu,'(a,2(2x,i6),a,2(2x,a6),a)') name(1:ln),   &
1491        mci_(i),nci_(i),flag_ci,hwm_wd,nwm_wd,flag_wm
1492  end do
1493
1494  call wcount_(hwm,hwm_wd)
1495  call wcount_(nwm,nwm_wd)
1496
1497  flag_ci=' '
1498  if(nci /= 0) flag_ci='*'
1499  flag_wm=' '
1500  if(nwm /= 0) flag_wm='*'
1501
1502  name='.total.'
1503  ln=max(len_trim(name),lnmax)
1504  write(lu,'(a,2(2x,i6),a,2(2x,a6),a)') name(1:ln),     &
1505        mci,nci,flag_ci,hwm_wd,nwm_wd,flag_wm
1506
1507  write(lu,'(72a/)') ('_',i=1,72)
1508
1509  if(nreset /= 1) write(lu,'(2a,i3,a)') myname_,        &
1510        ': reset_ ',nreset,' times'
1511
1512  call luflush(lu)
1513end subroutine flush_
1514
1515!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1516!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1517!-----------------------------------------------------------------------
1518!BOP
1519!
1520! !IROUTINE: wcount_ - generate word count output with unit
1521!
1522! !DESCRIPTION:
1523!
1524! !INTERFACE:
1525
1526    subroutine wcount_(wknt,cknt)
1527      implicit none
1528
1529      integer,         intent(in)  :: wknt ! given an integer value
1530      character(len=6),intent(out) :: cknt ! return a string value
1531
1532! !REVISION HISTORY:
1533!       17Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
1534!EOP
1535!_______________________________________________________________________
1536  character(len=*),parameter :: myname_=myname//'::wcount_'
1537
1538character(len=1) :: cwd
1539integer,parameter :: KWD=1024
1540integer,parameter :: MWD=1024*1024
1541integer,parameter :: GWD=1024*1024*1024
1542
1543integer :: iwd
1544
1545if(wknt < 0) then
1546  cknt='------'
1547else
1548  cwd='i'
1549  iwd=wknt
1550  if(iwd > 9999) then
1551    cwd='K'
1552    iwd=(wknt+KWD-1)/KWD
1553  endif
1554  if(iwd > 9999) then
1555    cwd='M'
1556    iwd=(wknt+MWD-1)/MWD
1557  endif
1558  if(iwd > 9999) then
1559    cwd='G'
1560    iwd=(wknt+GWD-1)/GWD
1561  endif
1562  write(cknt,'(i5,a)') iwd,cwd
1563endif
1564end subroutine wcount_
1565
1566!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1567!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1568!-----------------------------------------------------------------------
1569!BOP
1570!
1571! !IROUTINE: lookup_ - search/insert a name in a list
1572!
1573! !DESCRIPTION:
1574!
1575! !INTERFACE:
1576
1577    function lookup_(thread)
1578      use m_chars, only : uppercase
1579      implicit none
1580      character(len=*),intent(in) :: thread
1581      integer :: lookup_
1582
1583! !REVISION HISTORY:
1584!       17Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
1585!EOP
1586!_______________________________________________________________________
1587  character(len=*),parameter :: myname_=myname//'::lookup_'
1588
1589  logical :: found
1590  integer :: ith
1591
1592  if(.not.started) call reset_()
1593
1594!----------------------------------------
1595ith=0
1596found=.false.
1597do while(.not.found .and. ith < min(n_,MXL))
1598  ith=ith+1
1599  found= uppercase(thread) == uppercase(name_(ith))
1600end do
1601
1602if(.not.found) then
1603  if(n_==0) then
1604    nci=0
1605    mci=0
1606    nwm=0
1607    hwm=0
1608  endif
1609
1610  n_=n_+1
1611  if(n_ == MXL) then
1612    ith=MXL
1613    name_(ith)='.overflow.'
1614  else
1615    ith=n_
1616    name_(ith)=thread
1617  endif
1618
1619  nci_(ith)=0
1620  mci_(ith)=0
1621  nwm_(ith)=0
1622  hwm_(ith)=0
1623endif
1624
1625lookup_=ith
1626
1627end function lookup_
1628!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1629!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1630!-----------------------------------------------------------------------
1631!BOP
1632!
1633! !IROUTINE: reset_ - initialize the module data structure
1634!
1635! !DESCRIPTION:
1636!
1637! !INTERFACE:
1638
1639    subroutine reset_()
1640      implicit none
1641
1642! !REVISION HISTORY:
1643!       16Mar98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
1644!EOP
1645!_______________________________________________________________________
1646  character(len=*),parameter :: myname_=myname//'::reset_'
1647
1648  if(.not.mall_on) return
1649
1650  nreset=nreset+1
1651  started=.true.
1652
1653  name_(1:n_)=' '
1654
1655  mci_(1:n_)=0
1656  nci_(1:n_)=0
1657  hwm_(1:n_)=0
1658  nwm_(1:n_)=0
1659
1660  n_ =0
1661
1662  mci=0
1663  nci=0
1664  hwm=0
1665  nwm=0
1666
1667end subroutine reset_
1668!=======================================================================
1669end module m_mall
Note: See TracBrowser for help on using the repository browser.