pkg/diagnostics/diagstats_set_regions.F

C $Header:  $
C $Name:  $

#include "DIAG_OPTIONS.h"

CBOP
C     !ROUTINE: DIAGSTATS_SET_REGIONS
C     !INTERFACE:
      SUBROUTINE DIAGSTATS_SET_REGIONS( myThid )

C     !DESCRIPTION: \bv
C     *==================================================================
C     | S/R DIAGSTATS_SET_REGIONS
C     | o set region-mask for regional statistics diagnostics
C     *==================================================================
C     \ev

C     !USES:
      IMPLICIT NONE

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

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     myThid - Thread number for this instance of the routine.
      INTEGER myThid
CEOP

C     !LOCAL VARIABLES:
C     == Local variables ==
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      INTEGER iLen
      INTEGER i, j
      INTEGER bi, bj
#ifdef DIAGSTATS_REGION_MASK
      CHARACTER*(MAX_LEN_MBUF) tmpBuf
      INTEGER ioUnit
      INTEGER k, nbReg
      _RS     tmpVar(1-OLx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)
#else
      LOGICAL flag
#endif
      INTEGER  ILNBLNK
      EXTERNAL ILNBLNK

#ifdef DIAGSTATS_REGION_MASK

C--   Initialize region-mask array to zero:
      DO bj = myByLo(myThid), myByHi(myThid)
       DO bi = myBxLo(myThid), myBxHi(myThid)
        DO k=1,sizRegMsk
         DO j=1-Oly,sNy+Oly
          DO i=1-Olx,sNx+Olx
           diagSt_regMask(i,j,k,bi,bj) = 0.
          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ENDDO

      _BEGIN_MASTER( myThid )
C--   Check size & parameter first:
      IF ( (diagSt_regMaskFile.NE.' ' .AND. nLevRegMskFile.EQ.0)
     & .OR.(diagSt_regMaskFile.EQ.' ' .AND. nLevRegMskFile.GT.0) ) THEN
        WRITE(msgBuf,'(2A)') 'DIAGSTATS_SET_REGIONS:',
     &   ' regMaskFile and nLevRegMskFile Not consistent'
        CALL PRINT_ERROR( msgBuf , myThid )
        STOP 'ABNORMAL END: S/R DIAGSTATS_SET_REGIONS'
      ENDIF
      IF ( nLevRegMskFile.GT.sizRegMsk ) THEN
        WRITE(msgBuf,'(2A,I4,A,I4)') 'DIAGSTATS_SET_REGIONS:',
     &   ' regMaskFile level number=', nLevRegMskFile,
     &   ' exceeds sizRegMsk=', sizRegMsk
        CALL PRINT_ERROR( msgBuf , myThid )
        STOP 'ABNORMAL END: S/R DIAGSTATS_SET_REGIONS'
      ENDIF
      _END_MASTER( myThid )

C--   Read region-mask from file
      IF ( diagSt_regMaskFile .NE. ' ' ) THEN
       iLen = ILNBLNK(diagSt_regMaskFile)
       ioUnit = standardMessageUnit
       IF (debugLevel.GE.debLevB) WRITE(ioUnit,'(2A)')
     &   ' DIAGSTATS_SET_REGIONS: start reading region-mask file: ',
     &   diagSt_regMaskFile(1:iLen)
       DO k=1,nLevRegMskFile
C       _BEGIN_MASTER( myThid )
         IF (debugLevel.GE.debLevB) WRITE(ioUnit,'(A,I3)')
     &   ' DIAGSTATS_SET_REGIONS:  reading lev k=',k
         CALL READ_REC_XY_RS( diagSt_regMaskFile, tmpVar, k,
     &                        nIter0, myThid )
         IF (debugLevel.GE.debLevB) WRITE(ioUnit,'(A,I3,A)')
     &   ' DIAGSTATS_SET_REGIONS:          lev k=',k,' <= done'
C       _END_MASTER( myThid )
        _EXCH_XY_RS( tmpVar, myThid )
        DO bj = myByLo(myThid), myByHi(myThid)
         DO bi = myBxLo(myThid), myBxHi(myThid)
          DO j=1-Oly,sNy+Oly
           DO i=1-Olx,sNx+Olx
            diagSt_regMask(i,j,k,bi,bj) = tmpVar(i,j,bi,bj)
           ENDDO
          ENDDO
         ENDDO
        ENDDO
C-     end of k loop
       ENDDO
      ENDIF
      nLevRegMask = nLevRegMskFile

C--   Other way to define regions (e.g., latitude bands):
C      set corresponding levels of the region-mask array,
C      starting from nLevRegMskFile+1 up to nLevRegMask
C note: for now, empty !

C--   Region Identificator arrays
C       for now, directly filled when reading data.diagnostics

      _BEGIN_MASTER( myThid )
C--   Check defined regions
      nbReg = 0
      DO j=1,nRegions
C-      check for valid region-mask index:
        IF ( diagSt_kRegMsk(j).LT.0  .OR.
     &       diagSt_kRegMsk(j).GT.sizRegMsk ) THEN
          WRITE(msgBuf,'(2A,I3,A,I4)') 'DIAGSTATS_SET_REGIONS: ',
     &     '(region',j,') invalid region-mask index :',diagSt_kRegMsk(j)
          CALL PRINT_ERROR( msgBuf , myThid )
          STOP 'ABNORMAL END: S/R DIAGSTATS_SET_REGIONS'
C-      check for unset region-mask:
        ELSEIF ( diagSt_kRegMsk(j).GT.nLevRegMask ) THEN
          WRITE(msgBuf,'(2A,I3,A,I3,A)') 'DIAGSTATS_SET_REGIONS: ',
     &     'region',j,' , kRegMsk=', diagSt_kRegMsk(j),
     &     ' <- has not been set !'
          CALL PRINT_ERROR( msgBuf , myThid )
          STOP 'ABNORMAL END: S/R DIAGSTATS_SET_REGIONS'
        ELSEIF ( diagSt_kRegMsk(j).NE.0 ) THEN
          nbReg = nbReg + 1
C-      check for empty region: build temp mask 0 / 1 :
c         k = diagSt_kRegMsk(j)
c         IF ( diagSt_regMask(i,j,k,bi,bj).EQ.diagSt_vRegMsk(j) ) THEN
c           tmpVar(i,j,bi,bj) = 1.
c         ELSE
c           tmpVar(i,j,bi,bj) = 0.
c         ELSE
C-      print region mask:
c         IF ( debugLevel.GE.debLevA ) THEN
c           WRITE(msgBuf,'(A,I3,A)') 'DIAGSTAT Region',j,' mask:'
c           iLen = ILNBLNK(msgBuf)
c           CALL PLOT_FIELD_XYRS( tmpVar, msgBuf(1:iLen), -1, myThid )
c         ENDIF
        ENDIF
      ENDDO

C-    Global statistics (region # 0) <- done in diagnostics_readparams
c     diagSt_kRegMsk(0) = 1
c     diagSt_vRegMsk(0) = 0.


      WRITE(msgBuf,'(A,I4,A)') 'DIAGSTATS_SET_REGIONS: define',
     &                         nbReg,' regions:'
      iLen = ILNBLNK(msgBuf)
      DO j=1,nRegions
        IF ( diagSt_kRegMsk(j).NE.0 ) THEN
          iLen = MIN( iLen, MAX_LEN_MBUF -3 )
          tmpBuf(1:iLen) = msgBuf(1:iLen)
          WRITE(msgBuf,'(A,I3)') tmpBuf(1:iLen),j
          iLen = iLen+3
        ENDIF
      ENDDO
      CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                      SQUEEZE_RIGHT , myThid)
      WRITE(msgBuf,'(2A)')
     &   '------------------------------------------------------------'
      CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                      SQUEEZE_RIGHT , myThid)

      _END_MASTER( myThid )

#else /* DIAGSTATS_REGION_MASK */

C--   Initialize region-mask array to zero:
      DO bj = myByLo(myThid), myByHi(myThid)
       DO bi = myBxLo(myThid), myBxHi(myThid)
c        DO j=1-Oly,sNy+Oly
c         DO i=1-Olx,sNx+Olx
         DO j=1-Oly,1-Oly
          DO i=1-Olx,1-Olx
           diagSt_regMask(i,j,1,bi,bj) = 0.
          ENDDO
         ENDDO
       ENDDO
      ENDDO

      _BEGIN_MASTER( myThid )
C--   Check parameter consitency:
      flag = .FALSE.
      DO j=1,nRegions
        flag = flag .OR. diagSt_kRegMsk(j).NE.0
     &              .OR. diagSt_vRegMsk(j).NE.0.
      ENDDO
      iLen = ILNBLNK(diagSt_regMaskFile)
      IF ( flag .OR. iLen.GE.1 .OR. nLevRegMskFile.NE.0 ) THEN
        WRITE(msgBuf,'(2A)') 'DIAGSTATS_SET_REGIONS:',
     &   ' #define DIAGSTATS_REGION_MASK missing in DIAG_OPTIONS.h'
        CALL PRINT_ERROR( msgBuf , myThid )
        STOP 'ABNORMAL END: S/R DIAGSTATS_SET_REGIONS'
      ENDIF

      WRITE(msgBuf,'(A)') 'DIAGSTATS_SET_REGIONS: define no region'
      CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                      SQUEEZE_RIGHT , myThid)
      WRITE(msgBuf,'(2A)')
     &   '------------------------------------------------------------'
      CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                      SQUEEZE_RIGHT , myThid)

      _END_MASTER( myThid )

#endif /* DIAGSTATS_REGION_MASK */

      RETURN
      END
1	C $Header: $
2	C $Name: $
3
4	#include "DIAG_OPTIONS.h"
5
6	CBOP
7	C !ROUTINE: DIAGSTATS_SET_REGIONS
8	C !INTERFACE:
9	SUBROUTINE DIAGSTATS_SET_REGIONS( myThid )
10
11	C !DESCRIPTION: \bv
12	C *==================================================================
13	C \| S/R DIAGSTATS_SET_REGIONS
14	C \| o set region-mask for regional statistics diagnostics
15	C *==================================================================
16	C \ev
17
18	C !USES:
19	IMPLICIT NONE
20
21	C == Global variables ===
22	#include "EEPARAMS.h"
23	#include "SIZE.h"
24	#include "PARAMS.h"
25	#include "DIAGNOSTICS_SIZE.h"
26	#include "DIAGSTATS_REGIONS.h"
27
28	C !INPUT/OUTPUT PARAMETERS:
29	C == Routine arguments ==
30	C myThid - Thread number for this instance of the routine.
31	INTEGER myThid
32	CEOP
33
34	C !LOCAL VARIABLES:
35	C == Local variables ==
36	CHARACTER*(MAX_LEN_MBUF) msgBuf
37	INTEGER iLen
38	INTEGER i, j
39	INTEGER bi, bj
40	#ifdef DIAGSTATS_REGION_MASK
41	CHARACTER*(MAX_LEN_MBUF) tmpBuf
42	INTEGER ioUnit
43	INTEGER k, nbReg
44	_RS tmpVar(1-OLx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)
45	#else
46	LOGICAL flag
47	#endif
48	INTEGER ILNBLNK
49	EXTERNAL ILNBLNK
50
51	#ifdef DIAGSTATS_REGION_MASK
52
53	C-- Initialize region-mask array to zero:
54	DO bj = myByLo(myThid), myByHi(myThid)
55	DO bi = myBxLo(myThid), myBxHi(myThid)
56	DO k=1,sizRegMsk
57	DO j=1-Oly,sNy+Oly
58	DO i=1-Olx,sNx+Olx
59	diagSt_regMask(i,j,k,bi,bj) = 0.
60	ENDDO
61	ENDDO
62	ENDDO
63	ENDDO
64	ENDDO
65
66	_BEGIN_MASTER( myThid )
67	C-- Check size & parameter first:
68	IF ( (diagSt_regMaskFile.NE.' ' .AND. nLevRegMskFile.EQ.0)
69	& .OR.(diagSt_regMaskFile.EQ.' ' .AND. nLevRegMskFile.GT.0) ) THEN
70	WRITE(msgBuf,'(2A)') 'DIAGSTATS_SET_REGIONS:',
71	& ' regMaskFile and nLevRegMskFile Not consistent'
72	CALL PRINT_ERROR( msgBuf , myThid )
73	STOP 'ABNORMAL END: S/R DIAGSTATS_SET_REGIONS'
74	ENDIF
75	IF ( nLevRegMskFile.GT.sizRegMsk ) THEN
76	WRITE(msgBuf,'(2A,I4,A,I4)') 'DIAGSTATS_SET_REGIONS:',
77	& ' regMaskFile level number=', nLevRegMskFile,
78	& ' exceeds sizRegMsk=', sizRegMsk
79	CALL PRINT_ERROR( msgBuf , myThid )
80	STOP 'ABNORMAL END: S/R DIAGSTATS_SET_REGIONS'
81	ENDIF
82	_END_MASTER( myThid )
83
84	C-- Read region-mask from file
85	IF ( diagSt_regMaskFile .NE. ' ' ) THEN
86	iLen = ILNBLNK(diagSt_regMaskFile)
87	ioUnit = standardMessageUnit
88	IF (debugLevel.GE.debLevB) WRITE(ioUnit,'(2A)')
89	& ' DIAGSTATS_SET_REGIONS: start reading region-mask file: ',
90	& diagSt_regMaskFile(1:iLen)
91	DO k=1,nLevRegMskFile
92	C _BEGIN_MASTER( myThid )
93	IF (debugLevel.GE.debLevB) WRITE(ioUnit,'(A,I3)')
94	& ' DIAGSTATS_SET_REGIONS: reading lev k=',k
95	CALL READ_REC_XY_RS( diagSt_regMaskFile, tmpVar, k,
96	& nIter0, myThid )
97	IF (debugLevel.GE.debLevB) WRITE(ioUnit,'(A,I3,A)')
98	& ' DIAGSTATS_SET_REGIONS: lev k=',k,' <= done'
99	C _END_MASTER( myThid )
100	_EXCH_XY_RS( tmpVar, myThid )
101	DO bj = myByLo(myThid), myByHi(myThid)
102	DO bi = myBxLo(myThid), myBxHi(myThid)
103	DO j=1-Oly,sNy+Oly
104	DO i=1-Olx,sNx+Olx
105	diagSt_regMask(i,j,k,bi,bj) = tmpVar(i,j,bi,bj)
106	ENDDO
107	ENDDO
108	ENDDO
109	ENDDO
110	C- end of k loop
111	ENDDO
112	ENDIF
113	nLevRegMask = nLevRegMskFile
114
115	C-- Other way to define regions (e.g., latitude bands):
116	C set corresponding levels of the region-mask array,
117	C starting from nLevRegMskFile+1 up to nLevRegMask
118	C note: for now, empty !
119
120	C-- Region Identificator arrays
121	C for now, directly filled when reading data.diagnostics
122
123	_BEGIN_MASTER( myThid )
124	C-- Check defined regions
125	nbReg = 0
126	DO j=1,nRegions
127	C- check for valid region-mask index:
128	IF ( diagSt_kRegMsk(j).LT.0 .OR.
129	& diagSt_kRegMsk(j).GT.sizRegMsk ) THEN
130	WRITE(msgBuf,'(2A,I3,A,I4)') 'DIAGSTATS_SET_REGIONS: ',
131	& '(region',j,') invalid region-mask index :',diagSt_kRegMsk(j)
132	CALL PRINT_ERROR( msgBuf , myThid )
133	STOP 'ABNORMAL END: S/R DIAGSTATS_SET_REGIONS'
134	C- check for unset region-mask:
135	ELSEIF ( diagSt_kRegMsk(j).GT.nLevRegMask ) THEN
136	WRITE(msgBuf,'(2A,I3,A,I3,A)') 'DIAGSTATS_SET_REGIONS: ',
137	& 'region',j,' , kRegMsk=', diagSt_kRegMsk(j),
138	& ' <- has not been set !'
139	CALL PRINT_ERROR( msgBuf , myThid )
140	STOP 'ABNORMAL END: S/R DIAGSTATS_SET_REGIONS'
141	ELSEIF ( diagSt_kRegMsk(j).NE.0 ) THEN
142	nbReg = nbReg + 1
143	C- check for empty region: build temp mask 0 / 1 :
144	c k = diagSt_kRegMsk(j)
145	c IF ( diagSt_regMask(i,j,k,bi,bj).EQ.diagSt_vRegMsk(j) ) THEN
146	c tmpVar(i,j,bi,bj) = 1.
147	c ELSE
148	c tmpVar(i,j,bi,bj) = 0.
149	c ELSE
150	C- print region mask:
151	c IF ( debugLevel.GE.debLevA ) THEN
152	c WRITE(msgBuf,'(A,I3,A)') 'DIAGSTAT Region',j,' mask:'
153	c iLen = ILNBLNK(msgBuf)
154	c CALL PLOT_FIELD_XYRS( tmpVar, msgBuf(1:iLen), -1, myThid )
155	c ENDIF
156	ENDIF
157	ENDDO
158
159	C- Global statistics (region # 0) <- done in diagnostics_readparams
160	c diagSt_kRegMsk(0) = 1
161	c diagSt_vRegMsk(0) = 0.
162
163
164	WRITE(msgBuf,'(A,I4,A)') 'DIAGSTATS_SET_REGIONS: define',
165	& nbReg,' regions:'
166	iLen = ILNBLNK(msgBuf)
167	DO j=1,nRegions
168	IF ( diagSt_kRegMsk(j).NE.0 ) THEN
169	iLen = MIN( iLen, MAX_LEN_MBUF -3 )
170	tmpBuf(1:iLen) = msgBuf(1:iLen)
171	WRITE(msgBuf,'(A,I3)') tmpBuf(1:iLen),j
172	iLen = iLen+3
173	ENDIF
174	ENDDO
175	CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
176	& SQUEEZE_RIGHT , myThid)
177	WRITE(msgBuf,'(2A)')
178	& '------------------------------------------------------------'
179	CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
180	& SQUEEZE_RIGHT , myThid)
181
182	_END_MASTER( myThid )
183
184	#else /* DIAGSTATS_REGION_MASK */
185
186	C-- Initialize region-mask array to zero:
187	DO bj = myByLo(myThid), myByHi(myThid)
188	DO bi = myBxLo(myThid), myBxHi(myThid)
189	c DO j=1-Oly,sNy+Oly
190	c DO i=1-Olx,sNx+Olx
191	DO j=1-Oly,1-Oly
192	DO i=1-Olx,1-Olx
193	diagSt_regMask(i,j,1,bi,bj) = 0.
194	ENDDO
195	ENDDO
196	ENDDO
197	ENDDO
198
199	_BEGIN_MASTER( myThid )
200	C-- Check parameter consitency:
201	flag = .FALSE.
202	DO j=1,nRegions
203	flag = flag .OR. diagSt_kRegMsk(j).NE.0
204	& .OR. diagSt_vRegMsk(j).NE.0.
205	ENDDO
206	iLen = ILNBLNK(diagSt_regMaskFile)
207	IF ( flag .OR. iLen.GE.1 .OR. nLevRegMskFile.NE.0 ) THEN
208	WRITE(msgBuf,'(2A)') 'DIAGSTATS_SET_REGIONS:',
209	& ' #define DIAGSTATS_REGION_MASK missing in DIAG_OPTIONS.h'
210	CALL PRINT_ERROR( msgBuf , myThid )
211	STOP 'ABNORMAL END: S/R DIAGSTATS_SET_REGIONS'
212	ENDIF
213
214	WRITE(msgBuf,'(A)') 'DIAGSTATS_SET_REGIONS: define no region'
215	CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
216	& SQUEEZE_RIGHT , myThid)
217	WRITE(msgBuf,'(2A)')
218	& '------------------------------------------------------------'
219	CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
220	& SQUEEZE_RIGHT , myThid)
221
222	_END_MASTER( myThid )
223
224	#endif /* DIAGSTATS_REGION_MASK */
225
226	RETURN
227	END