*IF DEF,FLUXPROC FPOUTDBG.2 C ******************************COPYRIGHT****************************** FPOUTDBG.3 C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. FPOUTDBG.4 C FPOUTDBG.5 C Use, duplication or disclosure of this code is subject to the FPOUTDBG.6 C restrictions as set forth in the contract. FPOUTDBG.7 C FPOUTDBG.8 C Meteorological Office FPOUTDBG.9 C London Road FPOUTDBG.10 C BRACKNELL FPOUTDBG.11 C Berkshire UK FPOUTDBG.12 C RG12 2SZ FPOUTDBG.13 C FPOUTDBG.14 C If no contract has been raised with this copy of the code, the use, FPOUTDBG.15 C duplication or disclosure of it is strictly prohibited. Permission FPOUTDBG.16 C to do so must first be obtained in writing from the Head of Numerical FPOUTDBG.17 C Modelling at the above address. FPOUTDBG.18 C ******************************COPYRIGHT****************************** FPOUTDBG.19 C FPOUTDBG.20 C Programming standard: Unified Model Documentation Paper No 3 FPOUTDBG.21 C Version No 1 15/1/90 FPOUTDBG.22 C History: FPOUTDBG.23 C version date change FPOUTDBG.24 C 4.5 03/09/98 New code FPOUTDBG.25 C FPOUTDBG.26 ! Author: M. J. Bell FPOUTDBG.27 !---------------------------------------------------------------------- FPOUTDBG.28 ! contains routines: output_debug FPOUTDBG.29 ! FPOUTDBG.30 ! Purpose: Flux processing routine. FPOUTDBG.31 ! Writes out field values at selected grid points FPOUTDBG.32 !---------------------------------------------------------------------- FPOUTDBG.33subroutine output_debug(CMessage, nrows, ncols, Field) 2FPOUTDBG.34 FPOUTDBG.35 implicit none FPOUTDBG.36 FPOUTDBG.37 ! argument list: all intent IN FPOUTDBG.38 character*(*) CMessage ! message to output FPOUTDBG.39 integer nrows ! input dimension; number of rows FPOUTDBG.40 integer ncols ! input dimension; number of columns FPOUTDBG.41 real Field(ncols,nrows) ! field to output FPOUTDBG.42 FPOUTDBG.43 ! globals FPOUTDBG.44 *CALL CMESS
FPOUTDBG.45 *CALL CDEBUG
FPOUTDBG.46 FPOUTDBG.47 ! local scalars FPOUTDBG.48 integer IDbg ! loop index over selected points to debug FPOUTDBG.49 FPOUTDBG.50 !---------------------------------------------------------------------- FPOUTDBG.51 ! 0. Preliminaries FPOUTDBG.52 CSub = 'output_debug' ! subroutine name for error messages FPOUTDBG.53 FPOUTDBG.54 FPOUTDBG.55 ! 1. write out field descriptor FPOUTDBG.56 if ( CMessage .NE. ' ') then FPOUTDBG.57 write(OutUnitDbg, *) CMessage FPOUTDBG.58 end if FPOUTDBG.59 FPOUTDBG.60 ! 2. convert values to output FPOUTDBG.61 do IDbg = 1, NoDbgPts FPOUTDBG.62 FPOUTDBG.63 if ( IColDbg(IDbg) .le. ncols .and. FPOUTDBG.64 # JRowDbg(IDbg) .le. nrows ) then FPOUTDBG.65 write(CValues(IDbg), '(G11.4)' ) FPOUTDBG.66 # Field( IColDbg(IDbg), JRowDbg(IDbg) ) FPOUTDBG.67 else FPOUTDBG.68 CValues(IDbg) = ' OOB ' FPOUTDBG.69 end if FPOUTDBG.70 FPOUTDBG.71 end do ! IDbg FPOUTDBG.72 FPOUTDBG.73 ! 3. output values FPOUTDBG.74 write(OutUnitDbg, '(11A11)' ) (CValues(IDbg), IDbg=1,NoDbgPts) FPOUTDBG.75 FPOUTDBG.76 return FPOUTDBG.77 end FPOUTDBG.78 !---------------------------------------------------------------------- FPOUTDBG.79 *ENDIF FPOUTDBG.80