pkg/diagnostics/diagnostics_fill.F

C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_fill.F,v 1.6 2005/05/19 01:23:39 jmc Exp $
C $Name:  $

#include "DIAG_OPTIONS.h"

CBOP
C     !ROUTINE: DIAGNOSTICS_FILL
C     !INTERFACE:
      SUBROUTINE DIAGNOSTICS_FILL (inpfld, chardiag, 
     I                kLev, nLevs, bibjflg, biArg, bjArg, myThid) 

C     !DESCRIPTION:
C***********************************************************************
C   Wrapper routine to increment the diagnostics arrays with a field
C***********************************************************************
C     !USES:
      IMPLICIT NONE

C     == Global variables ===
#include "EEPARAMS.h"
#include "SIZE.h"
#include "DIAGNOSTICS_SIZE.h"
#include "DIAGNOSTICS.h"

C     !INPUT PARAMETERS:
C***********************************************************************
C  Arguments Description
C  ----------------------
C     inpfld ..... Field to increment diagnostics array
C     chardiag ... Character expression for diag to fill
C     kLev   ..... Integer flag for vertical levels:
C                  > 0 (any integer): WHICH single level to increment in qdiag.
C                  0,-1 to increment "nLevs" levels in qdiag,
C                  0 : fill-in in the same order as the input array 
C                  -1: fill-in in reverse order.
C     nLevs ...... indicates Number of levels of the input field array
C                  (whether to fill-in all the levels (kLev<1) or just one (kLev>0))
C     bibjflg .... Integer flag to indicate instructions for bi bj loop
C                  0 indicates that the bi-bj loop must be done here
C                  1 indicates that the bi-bj loop is done OUTSIDE
C                  2 indicates that the bi-bj loop is done OUTSIDE
C                     AND that we have been sent a local array (with overlap regions)
C                  3 indicates that the bi-bj loop is done OUTSIDE
C                     AND that we have been sent a local array
C                     AND that the array has no overlap region (interior only)
C                  NOTE - bibjflg can be NEGATIVE to indicate not to increment counter
C     biArg ...... X-direction tile number - used for bibjflg=1-3
C     bjArg ...... Y-direction tile number - used for bibjflg=1-3
C     myThid     ::  my thread Id number
C***********************************************************************
C                  NOTE: User beware! If a local (1 tile only) array
C                        is sent here, bibjflg MUST NOT be set to 0
C                        or there will be out of bounds problems!
C***********************************************************************
      _RL inpfld(*)
      CHARACTER*8 chardiag
      INTEGER kLev, nLevs, bibjflg, biArg, bjArg
      INTEGER myThid
CEOP

C     !LOCAL VARIABLES:
C ===============
      INTEGER m, n, j
      INTEGER ndiagnum, ipointer, iSp, jSd
c     INTEGER region2fill(0:nRegions)

C--   2D/3D Diagnostics :
C Run through list of active diagnostics to make sure
C we are trying to fill a valid diagnostic

      ndiagnum = 0
      ipointer = 0
      DO n=1,nlists
       DO m=1,nActive(n)
        IF ( chardiag.EQ.flds(m,n) ) THEN
         ndiagnum = jdiag(m,n)
         IF (ndiag(ndiagnum).GE.0) ipointer = idiag(ndiagnum)
        ENDIF
       ENDDO
      ENDDO

C if we are a valid and an active diagnostic, do the filling:
      IF ( ipointer.NE.0 ) THEN
        CALL DIAGNOSTICS_FILL_FIELD( inpfld, ndiagnum, ipointer,
     I                kLev, nLevs, bibjflg, biArg, bjArg, myThid ) 
      ENDIF

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      RETURN 
      END
1	jmc	1.7	C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_fill.F,v 1.6 2005/05/19 01:23:39 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "DIAG_OPTIONS.h"
5
6	jmc	1.2	CBOP
7			C !ROUTINE: DIAGNOSTICS_FILL
8			C !INTERFACE:
9	molod	1.5	SUBROUTINE DIAGNOSTICS_FILL (inpfld, chardiag,
10			I kLev, nLevs, bibjflg, biArg, bjArg, myThid)
11	jmc	1.2
12			C !DESCRIPTION:
13	jmc	1.1	C***********************************************************************
14	jmc	1.6	C Wrapper routine to increment the diagnostics arrays with a field
15	jmc	1.2	C***********************************************************************
16			C !USES:
17			IMPLICIT NONE
18
19			C == Global variables ===
20			#include "EEPARAMS.h"
21			#include "SIZE.h"
22			#include "DIAGNOSTICS_SIZE.h"
23			#include "DIAGNOSTICS.h"
24
25			C !INPUT PARAMETERS:
26			C***********************************************************************
27	jmc	1.1	C Arguments Description
28			C ----------------------
29	molod	1.5	C inpfld ..... Field to increment diagnostics array
30	jmc	1.1	C chardiag ... Character expression for diag to fill
31	jmc	1.2	C kLev ..... Integer flag for vertical levels:
32	jmc	1.3	C > 0 (any integer): WHICH single level to increment in qdiag.
33			C 0,-1 to increment "nLevs" levels in qdiag,
34			C 0 : fill-in in the same order as the input array
35			C -1: fill-in in reverse order.
36			C nLevs ...... indicates Number of levels of the input field array
37			C (whether to fill-in all the levels (kLev<1) or just one (kLev>0))
38	molod	1.5	C bibjflg .... Integer flag to indicate instructions for bi bj loop
39	jmc	1.1	C 0 indicates that the bi-bj loop must be done here
40			C 1 indicates that the bi-bj loop is done OUTSIDE
41			C 2 indicates that the bi-bj loop is done OUTSIDE
42			C AND that we have been sent a local array (with overlap regions)
43			C 3 indicates that the bi-bj loop is done OUTSIDE
44			C AND that we have been sent a local array
45			C AND that the array has no overlap region (interior only)
46	molod	1.5	C NOTE - bibjflg can be NEGATIVE to indicate not to increment counter
47			C biArg ...... X-direction tile number - used for bibjflg=1-3
48			C bjArg ...... Y-direction tile number - used for bibjflg=1-3
49	jmc	1.1	C myThid :: my thread Id number
50			C***********************************************************************
51			C NOTE: User beware! If a local (1 tile only) array
52	molod	1.5	C is sent here, bibjflg MUST NOT be set to 0
53	jmc	1.1	C or there will be out of bounds problems!
54			C***********************************************************************
55	molod	1.5	_RL inpfld(*)
56	jmc	1.2	CHARACTER*8 chardiag
57	molod	1.5	INTEGER kLev, nLevs, bibjflg, biArg, bjArg
58	jmc	1.2	INTEGER myThid
59			CEOP
60
61			C !LOCAL VARIABLES:
62			C ===============
63	jmc	1.6	INTEGER m, n, j
64			INTEGER ndiagnum, ipointer, iSp, jSd
65	jmc	1.7	c INTEGER region2fill(0:nRegions)
66	jmc	1.1
67	jmc	1.6	C-- 2D/3D Diagnostics :
68	jmc	1.1	C Run through list of active diagnostics to make sure
69			C we are trying to fill a valid diagnostic
70
71			ndiagnum = 0
72			ipointer = 0
73			DO n=1,nlists
74			DO m=1,nActive(n)
75			IF ( chardiag.EQ.flds(m,n) ) THEN
76			ndiagnum = jdiag(m,n)
77	jmc	1.2	IF (ndiag(ndiagnum).GE.0) ipointer = idiag(ndiagnum)
78	jmc	1.1	ENDIF
79			ENDDO
80			ENDDO
81
82	jmc	1.6	C if we are a valid and an active diagnostic, do the filling:
83			IF ( ipointer.NE.0 ) THEN
84			CALL DIAGNOSTICS_FILL_FIELD( inpfld, ndiagnum, ipointer,
85			I kLev, nLevs, bibjflg, biArg, bjArg, myThid )
86	jmc	1.1	ENDIF
87
88			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
89
90	jmc	1.2	RETURN
91			END