*IF DEF,C91_1A                                                             HOWBIG1A.2      
C ******************************COPYRIGHT******************************    GTS2F400.3997   
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.3998   
C                                                                          GTS2F400.3999   
C Use, duplication or disclosure of this code is subject to the            GTS2F400.4000   
C restrictions as set forth in the contract.                               GTS2F400.4001   
C                                                                          GTS2F400.4002   
C                Meteorological Office                                     GTS2F400.4003   
C                London Road                                               GTS2F400.4004   
C                BRACKNELL                                                 GTS2F400.4005   
C                Berkshire UK                                              GTS2F400.4006   
C                RG12 2SZ                                                  GTS2F400.4007   
C                                                                          GTS2F400.4008   
C If no contract has been raised with this copy of the code, the use,      GTS2F400.4009   
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.4010   
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.4011   
C Modelling at the above address.                                          GTS2F400.4012   
C ******************************COPYRIGHT******************************    GTS2F400.4013   
C                                                                          GTS2F400.4014   

      SUBROUTINE HOWBIG(SUB,I)                                             ,1HOWBIG1A.3      
CFPP$ NOCONCUR R                                                           HOWBIG1A.4      
CLL                                                                        HOWBIG1A.5      
CLL SUBROUTINE HOWBIG                                                      HOWBIG1A.6      
CLL -----------------                                                      HOWBIG1A.7      
CLL                                                                        HOWBIG1A.8      
CLL PURPOSE                                                                HOWBIG1A.9      
CLL -------                                                                HOWBIG1A.10     
CLL TO IDENTIFY HOW MUCH HEAP MEMORY IS AVAILABLE                          HOWBIG1A.11     
CLL 1.WHEN CALLED WITH 'I=1' A LOG IS KEPT OF THE MINIMUM HEAP SPARE       HOWBIG1A.12     
CLL  FROM EACHED CALLED ROUTINE . THE VALUE IS PRINTED OUT ON FIRST        HOWBIG1A.13     
CLL  CALL OR IF IT IS LOWER THAN FROM  ANY PREVIOUS CALL .                 HOWBIG1A.14     
CLL 2.WHEN CALLED WITH 'I=2' A SUMMARY TABLE IS PRINTED LISTING THE        HOWBIG1A.15     
CLL  MINIMUM HEAP SPACE USED BY EACH ROUTINE OF  THOSE CALLING             HOWBIG1A.16     
CLL  'HOWBIG' WITH 'I=1'                                                   HOWBIG1A.17     
CLL 3.NOTE THAT THIS ROUTINE IS ONLY USEFUL IF CALLED FROM THE LOWEST      HOWBIG1A.18     
CLL  LEVEL OF A PARTICULAR SUBROUTINE TREE AND HENCE CANNOT  BE            HOWBIG1A.19     
CLL  INCLUDED PERMANENTLY WITHOUT SOME EXPENSE                             HOWBIG1A.20     
CLL                                                                        HOWBIG1A.21     
CLL CALLED BY   : ANY ROUTINE AS REQUIRED (WITH I=1)                       HOWBIG1A.22     
CLL             : + FROM SECTION 5 OF U_MODEL (WITH I=2)                   HOWBIG1A.23     
CLL             : (AUTHORS NOTE : I HAVE A CORRECTION SET TO INSERT        HOWBIG1A.24     
CLL             :                 CALLS INTO MOST ROUTINES IN UMPL1.4)     HOWBIG1A.25     
CLL                                                                        HOWBIG1A.26     
CLL CALLS       : ORDERS (SYSTEM UTILITY TO ORDER PRINTOUT)                HOWBIG1A.27     
CLL -----       : IHPSTAT(SYSTEM UTILITY TO CHECK ON HEAP)                 HOWBIG1A.28     
CLL                                                                        HOWBIG1A.29     
CLL AUTHOR      :STUART BELL                                               HOWBIG1A.30     
CLL                                                                        HOWBIG1A.31     
CLL  MODEL            MODIFICATION HISTORY FROM MODEL VERSION 3.0:         HOWBIG1A.32     
CLL VERSION  DATE                                                          HOWBIG1A.33     
CLL                                                                        HOWBIG1A.34     
CLL                                                                        HOWBIG1A.35     
      CHARACTER*8 SUB          ! NAME OF CALLING ROUTINE                   HOWBIG1A.36     
      INTEGER I                ! =1 TO CHECK HEAP, =2 FOR SUMMARY          HOWBIG1A.37     
      CHARACTER*8 SUBNAME(300)                                             HOWBIG1A.38     
      INTEGER IHEAP(300),IWORK(257),INDEX(300)                             HOWBIG1A.39     
      LOGICAL NEWSUB                                                       HOWBIG1A.40     
      INTEGER K,IHPT,IHP11,IHP12,NSUBS                                     HOWBIG1A.41     
      SAVE SUBNAME,IHEAP,NSUBS                                             HOWBIG1A.42     
      DATA NSUBS/0/                                                        HOWBIG1A.43     
CL                                                                         HOWBIG1A.44     
CL 1 OPTION TO CHECK HEAP                                                  HOWBIG1A.45     
CL-----------------------                                                  HOWBIG1A.46     
      IF (I.EQ.1)THEN                                                      HOWBIG1A.47     
       NEWSUB=.FALSE.                                                      HOWBIG1A.48     
       IF (NSUBS.GT.0)THEN                                                 HOWBIG1A.49     
C CHECK SUBROUTINE NAME ALREADY PRESENT                                    HOWBIG1A.50     
        DO 10 K=1,NSUBS                                                    HOWBIG1A.51     
        IF(SUBNAME(K).EQ.SUB)GOTO11                                        HOWBIG1A.52     
10      CONTINUE                                                           HOWBIG1A.53     
       ENDIF                                                               HOWBIG1A.54     
C                                                                          HOWBIG1A.55     
C NEW SUBROUTINE ENTERED                                                   HOWBIG1A.56     
       NEWSUB=.TRUE.                                                       HOWBIG1A.57     
       IF(NSUBS.EQ.300)THEN                                                HOWBIG1A.58     
C CHECK THAT DIMENSIONS ARE NOT EXCEEDED                                   HOWBIG1A.59     
        WRITE(7,*)' INCREASE ARRAY SIZES IN HOWBIG'                        HOWBIG1A.60     
        GOTO 999                                                           HOWBIG1A.61     
       ELSE                                                                HOWBIG1A.62     
        NSUBS=NSUBS+1                                                      HOWBIG1A.63     
       ENDIF                                                               HOWBIG1A.64     
       SUBNAME(NSUBS)=SUB                                                  HOWBIG1A.65     
       K=NSUBS                                                             HOWBIG1A.66     
11     CONTINUE                                                            HOWBIG1A.67     
C                                                                          HOWBIG1A.68     
C GET HEAP SPACE                                                           HOWBIG1A.69     
       IHP11=IHPSTAT(11)                                                   HOWBIG1A.70     
       IHP12=IHPSTAT(12)                                                   HOWBIG1A.71     
       IHPT=IHP11+IHP12                                                    HOWBIG1A.72     
C CHECK PREVIOUS HEAP SPACE WITH PRESENT HEAP SPACE EXCEPT ON 1ST CALL     HOWBIG1A.73     
       IF(NEWSUB)THEN                                                      HOWBIG1A.74     
        IHEAP(K)=IHPT                                                      HOWBIG1A.75     
        WRITE(7,777)IHPT,IHP12,IHP11,SUB                                   HOWBIG1A.76     
777     FORMAT(1X,' HEAP SPACE LEFT ',I8,' WORDS (',I8,'+',I8,             HOWBIG1A.77     
     *  ' ) AT CALL FROM ',A8)                                             HOWBIG1A.78     
       ELSE                                                                HOWBIG1A.79     
        IF(IHPT.LT.IHEAP(K)) THEN                                          HOWBIG1A.80     
         IHEAP(K)=IHPT                                                     HOWBIG1A.81     
         WRITE(7,777)IHPT,IHP12,IHP11,SUB                                  HOWBIG1A.82     
        ENDIF                                                              HOWBIG1A.83     
       ENDIF                                                               HOWBIG1A.84     
C                                                                          HOWBIG1A.85     
CL 2 OPTION TO PRINT SUMMARY TABLE                                         HOWBIG1A.86     
CL--------------------------------                                         HOWBIG1A.87     
      ELSE                                                                 HOWBIG1A.88     
        WRITE(7,701)                                                       HOWBIG1A.89     
701     FORMAT('1',//,20X,' HEAP SUMMARY',/)                               HOWBIG1A.90     
       IF(NSUBS.GT.0)THEN                                                  HOWBIG1A.91     
C GET INDEX FOR ORDERED PRINTING                                           HOWBIG1A.92     
        CALL ORDERS(1,IWORK,IHEAP,INDEX,NSUBS,1,8,1)                       HOWBIG1A.93     
C                                                                          HOWBIG1A.94     
        WRITE(7,702)                                                       HOWBIG1A.95     
702     FORMAT(4X,'ROUTINE',6X,'HEAP LEFT')                                HOWBIG1A.96     
        DO 20 K=1,NSUBS                                                    HOWBIG1A.97     
        WRITE(7,703)K,SUBNAME(INDEX(K)),IHEAP(INDEX(K))                    HOWBIG1A.98     
703     FORMAT(1X,I3,1X,A8,1X,I10)                                         HOWBIG1A.99     
20      CONTINUE                                                           HOWBIG1A.100    
       ELSE                                                                HOWBIG1A.101    
        WRITE(7,*)' YOU FORGOT TO CALL THE ROUTINE WITH OPTION 1'          HOWBIG1A.102    
       ENDIF                                                               HOWBIG1A.103    
C                                                                          HOWBIG1A.104    
      ENDIF                                                                HOWBIG1A.105    
C                                                                          HOWBIG1A.106    
999   RETURN                                                               HOWBIG1A.107    
      END                                                                  HOWBIG1A.108    
*ENDIF                                                                     HOWBIG1A.109