pkg/diagnostics/diagnostics_init_varia.F

C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_init_varia.F,v 1.4 2005/02/21 04:41:52 edhill Exp $
C $Name:  $

#include "DIAG_OPTIONS.h"
      
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 0
C     !ROUTINE: DIAGNOSTICS_INIT_VARIA

C     !INTERFACE:
      SUBROUTINE DIAGNOSTICS_INIT_VARIA(
     I     myThid )

C     !DESCRIPTION:
C     Initialize the qdiag array which accumulates during integration
      
C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DIAGNOSTICS_SIZE.h"
#include "DIAGNOSTICS.h"

C     !INPUT PARAMETERS:
      INTEGER myThid
CEOP

C     !LOCAL VARIABLES:
      INTEGER i,j,n,bi,bj
      CHARACTER*(80) fn

#ifdef ALLOW_MDSIO
      LOGICAL glf
      INTEGER dUnit
#endif /* ALLOW_MDSIO */

#ifdef ALLOW_MNC
      INTEGER ii
      CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
      INTEGER CW_DIMS, NLEN
      PARAMETER ( CW_DIMS = 10 )
      PARAMETER ( NLEN    = 80 )
      INTEGER dim(CW_DIMS), ib(CW_DIMS), ie(CW_DIMS)
      CHARACTER*(NLEN) dn(CW_DIMS)
      CHARACTER*(NLEN) d_cw_name
      CHARACTER*(NLEN) dn_blnk
#endif /*  ALLOW_MNC  */

C     Zero out the qdiag array which accumulates during integration
      DO bj = myByLo(myThid), myByHi(myThid)
        DO bi = myBxLo(myThid), myBxHi(myThid)
          DO n = 1,numdiags
            DO j = 1-Oly,sNy+Oly
              DO i = 1-Olx,sNx+Olx
                qdiag(i,j,n,bi,bj) = 0. _d 0
              ENDDO
            ENDDO
          ENDDO
        ENDDO
      ENDDO


#ifdef DIAGNOSTICS_HAS_PICKUP

C     Add pickup capability
      IF (diag_pickup_read) THEN

#ifdef ALLOW_MNC
        IF (diag_pickup_read_mnc) THEN
          DO i = 1,NLEN
            dn_blnk(i:i) = ' '
          ENDDO
          DO i = 1,MAX_LEN_FNAM
            diag_mnc_bn(i:i) = ' '
          ENDDO
          WRITE(diag_mnc_bn,'(A)') 'pickup_diagnostics'

C         Update the record dimension by writing the iteration number
          CALL MNC_FILE_CLOSE_ALL_MATCHING(diag_mnc_bn, myThid)
          CALL MNC_CW_SET_UDIM(diag_mnc_bn, 1, myThid)
          
C         Read the qdiag() array
          d_cw_name(1:NLEN) = dn_blnk(1:NLEN)
          DO ii = 1,CW_DIMS
            dn(ii)(1:NLEN) = dn_blnk(1:NLEN)
          ENDDO
          d_cw_name(1:10) = 'diag_state'
          dn(1)(1:3) = 'Xp1'
          dim(1)     = sNx + 2*OLx
          ib(1)      = OLx + 1
          ie(1)      = OLx + sNx + 1
          dn(2)(1:3) = 'Yp1'
          dim(2)     = sNy + 2*OLy
          ib(2)      = OLy + 1
          ie(2)      = OLy + sNy + 1
          dn(3)(1:2) = 'Zd'
          dim(3)     = numdiags
          ib(3)      = 1
          ie(3)      = numdiags
          dn(4)(1:1) = 'T'
          dim(4)     = -1
          ib(4)      = 1
          ie(4)      = 1
          CALL MNC_CW_ADD_GNAME(d_cw_name, 4, 
     &         dim, dn, ib, ie, myThid)
          CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name, 
     &         4,5, myThid)
          CALL MNC_CW_RL_R('D',diag_mnc_bn,0,0,
     &         d_cw_name, qdiag, myThid)
          CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)
          CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
          
C         Read the ndiag() array
          d_cw_name(1:NLEN) = dn_blnk(1:NLEN)
          DO ii = 1,CW_DIMS
            dn(ii)(1:NLEN) = dn_blnk(1:NLEN)
          ENDDO
          d_cw_name(1:10) = 'diag_count'
          dn(1)(1:2) = 'Nd'
          dim(1)     = numdiags
          ib(1)      = 1
          ie(1)      = numdiags
          dn(2)(1:1) = 'T'
          dim(2)     = -1
          ib(2)      = 1
          ie(2)      = 1
          CALL MNC_CW_ADD_GNAME(d_cw_name, 2, 
     &         dim, dn, ib, ie, myThid)
          CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name, 
     &         4,5, myThid)
          CALL MNC_CW_ADD_VATTR_TEXT(d_cw_name,'description',
     &         'diagnostics state',myThid)
          CALL MNC_CW_RL_R('I',diag_mnc_bn,0,0,
     &         d_cw_name, ndiag, myThid)
          CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)
          CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)

        ENDIF
#endif /* ALLOW_MNC */
           
#ifdef ALLOW_MDSIO
        IF (diag_pickup_read_mdsio) THEN
          _BEGIN_MASTER(myThid)

C         Read qdiag()
          DO i = 1,80
            fn(i:i) = ' '
          ENDDO
          write(fn,'(A,I10.10)') 'pickup_qdiag', nIter0
          glf = globalFiles
          CALL MDSREADFIELD(fn,readBinaryPrec,glf,'RL',
     &         numdiags,qdiag,1,myThid)

C         Read ndiag()
          DO i = 1,80
            fn(i:i) = ' '
          ENDDO
          WRITE(fn,'(A,I10.10)') 'pickup_ndiag.', nIter0
          CALL MDSFINDUNIT( dUnit, mythid )
          OPEN( dUnit, file=fn )
          DO i = 1,numdiags
            READ(dUnit,'(I10)') ndiag(i)
          ENDDO
          CLOSE( dUnit )
          _END_MASTER(myThid)
        ENDIF
#endif /* ALLOW_MDSIO */

      ENDIF

#endif /* DIAGNOSTICS_HAS_PICKUP */

      RETURN 
      END
1	edhill	1.5	C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_init_varia.F,v 1.4 2005/02/21 04:41:52 edhill Exp $
2	jmc	1.1	C $Name: $
3
4			#include "DIAG_OPTIONS.h"
5
6			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7			CBOP 0
8			C !ROUTINE: DIAGNOSTICS_INIT_VARIA
9
10			C !INTERFACE:
11	edhill	1.2	SUBROUTINE DIAGNOSTICS_INIT_VARIA(
12			I myThid )
13	jmc	1.1
14			C !DESCRIPTION:
15			C Initialize the qdiag array which accumulates during integration
16
17			C !USES:
18			IMPLICIT NONE
19	edhill	1.2	#include "SIZE.h"
20	jmc	1.1	#include "EEPARAMS.h"
21	edhill	1.2	#include "PARAMS.h"
22	jmc	1.1	#include "DIAGNOSTICS_SIZE.h"
23			#include "DIAGNOSTICS.h"
24
25			C !INPUT PARAMETERS:
26			INTEGER myThid
27			CEOP
28
29			C !LOCAL VARIABLES:
30			INTEGER i,j,n,bi,bj
31	edhill	1.2	CHARACTER*(80) fn
32	edhill	1.4
33			#ifdef ALLOW_MDSIO
34	edhill	1.2	LOGICAL glf
35	edhill	1.4	INTEGER dUnit
36			#endif /* ALLOW_MDSIO */
37	jmc	1.1
38	edhill	1.3	#ifdef ALLOW_MNC
39			INTEGER ii
40			CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
41			INTEGER CW_DIMS, NLEN
42			PARAMETER ( CW_DIMS = 10 )
43			PARAMETER ( NLEN = 80 )
44			INTEGER dim(CW_DIMS), ib(CW_DIMS), ie(CW_DIMS)
45			CHARACTER*(NLEN) dn(CW_DIMS)
46			CHARACTER*(NLEN) d_cw_name
47			CHARACTER*(NLEN) dn_blnk
48			#endif /* ALLOW_MNC */
49
50	jmc	1.1	C Zero out the qdiag array which accumulates during integration
51			DO bj = myByLo(myThid), myByHi(myThid)
52			DO bi = myBxLo(myThid), myBxHi(myThid)
53			DO n = 1,numdiags
54			DO j = 1-Oly,sNy+Oly
55			DO i = 1-Olx,sNx+Olx
56			qdiag(i,j,n,bi,bj) = 0. _d 0
57			ENDDO
58			ENDDO
59			ENDDO
60			ENDDO
61			ENDDO
62
63	edhill	1.2
64	edhill	1.5	#ifdef DIAGNOSTICS_HAS_PICKUP
65
66	edhill	1.2	C Add pickup capability
67			IF (diag_pickup_read) THEN
68
69			#ifdef ALLOW_MNC
70	edhill	1.3	IF (diag_pickup_read_mnc) THEN
71			DO i = 1,NLEN
72			dn_blnk(i:i) = ' '
73			ENDDO
74			DO i = 1,MAX_LEN_FNAM
75			diag_mnc_bn(i:i) = ' '
76			ENDDO
77			WRITE(diag_mnc_bn,'(A)') 'pickup_diagnostics'
78
79			C Update the record dimension by writing the iteration number
80			CALL MNC_FILE_CLOSE_ALL_MATCHING(diag_mnc_bn, myThid)
81			CALL MNC_CW_SET_UDIM(diag_mnc_bn, 1, myThid)
82
83	edhill	1.4	C Read the qdiag() array
84	edhill	1.3	d_cw_name(1:NLEN) = dn_blnk(1:NLEN)
85			DO ii = 1,CW_DIMS
86			dn(ii)(1:NLEN) = dn_blnk(1:NLEN)
87			ENDDO
88			d_cw_name(1:10) = 'diag_state'
89			dn(1)(1:3) = 'Xp1'
90			dim(1) = sNx + 2*OLx
91			ib(1) = OLx + 1
92			ie(1) = OLx + sNx + 1
93			dn(2)(1:3) = 'Yp1'
94			dim(2) = sNy + 2*OLy
95			ib(2) = OLy + 1
96			ie(2) = OLy + sNy + 1
97			dn(3)(1:2) = 'Zd'
98			dim(3) = numdiags
99			ib(3) = 1
100			ie(3) = numdiags
101			dn(4)(1:1) = 'T'
102			dim(4) = -1
103			ib(4) = 1
104			ie(4) = 1
105			CALL MNC_CW_ADD_GNAME(d_cw_name, 4,
106			& dim, dn, ib, ie, myThid)
107			CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name,
108			& 4,5, myThid)
109			CALL MNC_CW_RL_R('D',diag_mnc_bn,0,0,
110			& d_cw_name, qdiag, myThid)
111	edhill	1.4	CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)
112			CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
113	edhill	1.3
114	edhill	1.4	C Read the ndiag() array
115			d_cw_name(1:NLEN) = dn_blnk(1:NLEN)
116			DO ii = 1,CW_DIMS
117			dn(ii)(1:NLEN) = dn_blnk(1:NLEN)
118			ENDDO
119			d_cw_name(1:10) = 'diag_count'
120			dn(1)(1:2) = 'Nd'
121			dim(1) = numdiags
122			ib(1) = 1
123			ie(1) = numdiags
124			dn(2)(1:1) = 'T'
125			dim(2) = -1
126			ib(2) = 1
127			ie(2) = 1
128			CALL MNC_CW_ADD_GNAME(d_cw_name, 2,
129			& dim, dn, ib, ie, myThid)
130			CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name,
131			& 4,5, myThid)
132			CALL MNC_CW_ADD_VATTR_TEXT(d_cw_name,'description',
133			& 'diagnostics state',myThid)
134			CALL MNC_CW_RL_R('I',diag_mnc_bn,0,0,
135			& d_cw_name, ndiag, myThid)
136	edhill	1.3	CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)
137			CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
138	edhill	1.4
139	edhill	1.3	ENDIF
140			#endif /* ALLOW_MNC */
141
142	edhill	1.4	#ifdef ALLOW_MDSIO
143	edhill	1.2	IF (diag_pickup_read_mdsio) THEN
144	edhill	1.4	_BEGIN_MASTER(myThid)
145
146			C Read qdiag()
147	edhill	1.2	DO i = 1,80
148			fn(i:i) = ' '
149			ENDDO
150	edhill	1.4	write(fn,'(A,I10.10)') 'pickup_qdiag', nIter0
151	edhill	1.2	glf = globalFiles
152			CALL MDSREADFIELD(fn,readBinaryPrec,glf,'RL',
153			& numdiags,qdiag,1,myThid)
154	edhill	1.4
155			C Read ndiag()
156			DO i = 1,80
157			fn(i:i) = ' '
158			ENDDO
159			WRITE(fn,'(A,I10.10)') 'pickup_ndiag.', nIter0
160			CALL MDSFINDUNIT( dUnit, mythid )
161			OPEN( dUnit, file=fn )
162			DO i = 1,numdiags
163			READ(dUnit,'(I10)') ndiag(i)
164			ENDDO
165			CLOSE( dUnit )
166			_END_MASTER(myThid)
167	edhill	1.2	ENDIF
168	edhill	1.4	#endif /* ALLOW_MDSIO */
169	edhill	1.2
170			ENDIF
171
172	edhill	1.5	#endif /* DIAGNOSTICS_HAS_PICKUP */
173
174	jmc	1.1	RETURN
175			END