*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