*IF DEF,C84_1A STACUM1A.2
C ******************************COPYRIGHT****************************** GTS2F400.9487
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9488
C GTS2F400.9489
C Use, duplication or disclosure of this code is subject to the GTS2F400.9490
C restrictions as set forth in the contract. GTS2F400.9491
C GTS2F400.9492
C Meteorological Office GTS2F400.9493
C London Road GTS2F400.9494
C BRACKNELL GTS2F400.9495
C Berkshire UK GTS2F400.9496
C RG12 2SZ GTS2F400.9497
C GTS2F400.9498
C If no contract has been raised with this copy of the code, the use, GTS2F400.9499
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9500
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9501
C Modelling at the above address. GTS2F400.9502
C ******************************COPYRIGHT****************************** GTS2F400.9503
C GTS2F400.9504
CLL Routine: STACCUM ------------------------------------------------- STACUM1A.3
CLL STACUM1A.4
CLL Purpose: Accumulates fields within STASH (temporal service routine) STACUM1A.5
CLL STACUM1A.6
CLL Tested under compiler: cft77 STACUM1A.7
CLL Tested under OS version: UNICOS 5.1 STACUM1A.8
CLL STACUM1A.9
CLL Author: S.Tett/T.Johns STACUM1A.10
CLL STACUM1A.11
CLL Model Modification history from model version 3.0: STACUM1A.12
CLL version date STACUM1A.13
CLL STACUM1A.14
CLL STACUM1A.15
CLL Programming standard: UM Doc Paper 3, version 2 (7/9/90) STACUM1A.16
CLL STACUM1A.17
CLL Logical components covered: D721 STACUM1A.18
CLL STACUM1A.19
CLL Project task: D7 STACUM1A.20
CLL STACUM1A.21
CLL External documentation: STACUM1A.22
CLL Unified Model Doc Paper C4 - Storage handling and diagnostic STACUM1A.23
CLL system (STASH) STACUM1A.24
CLL STACUM1A.25
C*L Interface and arguments: ------------------------------------------ STACUM1A.26
SUBROUTINE STACCUM(fieldin,result,size,masking,amdi) 1STACUM1A.27
C STACUM1A.28
IMPLICIT NONE STACUM1A.29
C STACUM1A.30
INTEGER size ! IN size of fieldin and result. STACUM1A.31
REAL fieldin(size) ! IN input field to be processed STACUM1A.32
REAL result(size) ! OUT where accum is done. STACUM1A.33
LOGICAL masking ! IN true if masked (ie. MDI possible) STACUM1A.34
REAL amdi ! IN missing data indicator STACUM1A.35
C* --------------------------------------------------------------------- STACUM1A.36
C STACUM1A.37
C Local variables STACUM1A.38
C STACUM1A.39
INTEGER i ! loop count STACUM1A.40
CL---------------------------------------------------------------------- STACUM1A.41
CL 1.1 loop over array size, if either result or fieldin is amdi, set STACUM1A.42
CL result to amdi else accumulate it in result. STACUM1A.43
CL STACUM1A.44
IF (masking) THEN STACUM1A.45
DO i=1,size STACUM1A.46
IF ((result(i).ne.amdi).and.(fieldin(i).ne.amdi)) THEN STACUM1A.47
result(i)=result(i)+fieldin(i) STACUM1A.48
ELSE STACUM1A.49
result(i)=amdi STACUM1A.50
ENDIF STACUM1A.51
ENDDO STACUM1A.52
ELSE STACUM1A.53
CL STACUM1A.54
CL 1.2 loop over array size, accumulate result without checking for STACUM1A.55
CL missing data STACUM1A.56
CL STACUM1A.57
DO i=1,size STACUM1A.58
result(i)=result(i)+fieldin(i) STACUM1A.59
ENDDO STACUM1A.60
ENDIF STACUM1A.61
C STACUM1A.62
RETURN STACUM1A.63
END STACUM1A.64
*ENDIF STACUM1A.65