/[MITgcm]/MITgcm/pkg/diagnostics/diagnostics_readparms.F
ViewVC logotype

Annotation of /MITgcm/pkg/diagnostics/diagnostics_readparms.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.1 - (hide annotations) (download)
Mon Dec 13 21:43:54 2004 UTC (19 years, 5 months ago) by jmc
Branch: MAIN 
re-arrange diagnostics pkg initialization:
 allow each package to extend the available diagnostics list
 add some checking and fix small problems (multi-threaded, ...)
1 jmc 1.1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diag_readparms.F,v 1.18 2004/10/20 20:04:11 molod Exp $
2     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_READPARMS
9    
10     C !INTERFACE:
11     SUBROUTINE DIAGNOSTICS_READPARMS(myThid)
12    
13     C !DESCRIPTION:
14     C Read Diagnostics Namelists to specify output sequence.
15    
16     C !USES:
17     IMPLICIT NONE
18     #include "SIZE.h"
19     #include "EEPARAMS.h"
20     #include "PARAMS.h"
21     #include "DIAGNOSTICS_SIZE.h"
22     #include "DIAGNOSTICS.h"
23    
24     C !INPUT PARAMETERS:
25     INTEGER myThid
26     CEOP
27    
28     C !LOCAL VARIABLES:
29     C ldimLoc :: Max Number of Lists
30     C kdimLoc :: Max Number of Levels
31     C fdimLoc :: Max Number of Fields
32     C frequency :: Frequency of Output (ouput every "frequency" iteration)
33     C levels :: List Output Levels
34     C fields :: List Output Fields
35     C filename :: List Output Filename
36     INTEGER ldimLoc, kdimLoc, fdimLoc
37     PARAMETER ( ldimLoc = 2*numlists )
38     PARAMETER ( kdimLoc = 2*numLevels )
39     PARAMETER ( fdimLoc = 2*numperlist )
40     INTEGER frequency(ldimLoc)
41     _RL levels(kdimLoc,ldimLoc)
42     CHARACTER*8 fields(fdimLoc,ldimLoc)
43     CHARACTER*8 filename(ldimLoc)
44     CHARACTER*8 blk8c
45     CHARACTER*(MAX_LEN_MBUF) msgBuf
46     INTEGER ku, stdUnit
47     INTEGER k,l,n,m
48     _RL undef, getcon
49    
50     NAMELIST / diagnostics_list /
51     & frequency, levels, fields, filename,
52     & diag_mnc
53    
54     C Initialize and Read Diagnostics Namelist
55     _BEGIN_MASTER(myThid)
56    
57     undef = getcon('UNDEF')
58     blk8c = ' '
59    
60     DO l = 1,ldimLoc
61     frequency(l) = 0
62     DO k = 1,kdimLoc
63     levels (k,l) = undef
64     ENDDO
65     DO m = 1,fdimLoc
66     fields (m,l) = blk8c
67     ENDDO
68     ENDDO
69     diag_mnc = .FALSE.
70    
71     WRITE(msgBuf,'(A)')
72     & ' DIAGNOSTICS_READPARMS: opening data.diagnostics'
73     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)
74    
75     CALL OPEN_COPY_DATA_FILE('data.diagnostics',
76     & 'DIAGNOSTICS_READPARMS', ku, myThid )
77     READ (ku,NML=diagnostics_list)
78     CLOSE (ku)
79    
80     C Initialise diag_choices common block
81     nlists = 0
82     DO n = 1,numlists
83     freq(n) = 0
84     nlevels(n) = 0
85     nfields(n) = 0
86     fnames(n) = blk8c
87     DO k = 1,numLevels
88     levs(k,n) = 0
89     ENDDO
90     DO m = 1,numperlist
91     flds(m,n) = ' '
92     jdiag(m,n) = 0
93     ENDDO
94     ENDDO
95     diag_mdsio = .TRUE.
96    
97     C Fill Diagnostics Common Block with Namelist Info
98     IF ( useMNC .AND. diag_mnc
99     & .AND. (.NOT. outputTypesInclusive)) THEN
100     diag_mdsio = .FALSE.
101     ENDIF
102    
103     DO l = 1,ldimLoc
104     IF ( frequency(l).NE.0 .AND. nlists.LT.numlists ) THEN
105     n = nlists + 1
106     freq(n) = frequency(l)
107     fnames(n) = filename (l)
108     nlevels(n) = 0
109     IF ( levels(1,l).NE.undef ) THEN
110     DO k=1,kdimLoc
111     IF ( levels(k,l).NE.undef .AND.
112     & nlevels(n).LT.numLevels ) THEN
113     nlevels(n) = nlevels(n) + 1
114     levs(nlevels(n),n) = levels(k,l)
115     ELSEIF ( levels(k,l).NE.undef ) THEN
116     WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
117     & 'Exceed Max.Num. of Levels numLevels=', numLevels
118     CALL PRINT_ERROR( msgBuf , myThid )
119     WRITE(msgBuf,'(2A,I3,A,F3.0)') 'DIAGNOSTICS_READPARMS: ',
120     & 'when trying to add level(k=', k, ' )=', levels(k,l)
121     CALL PRINT_ERROR( msgBuf , myThid )
122     WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
123     & ' for list l=', l, ', filename: ', filename(l)
124     CALL PRINT_ERROR( msgBuf , myThid )
125     STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
126     ENDIF
127     ENDDO
128     ELSE
129     nlevels(n) = Nr
130     DO k=1,nlevels(n)
131     levs(k,n) = k
132     ENDDO
133     ENDIF
134     nfields(n) = 0
135     DO m=1,fdimLoc
136     IF ( fields(m,l).NE.blk8c .AND.
137     & nfields(n).LT.numperlist ) THEN
138     nfields(n) = nfields(n) + 1
139     flds(nfields(n),n) = fields(m,l)
140     ELSEIF ( fields(m,n).NE.blk8c ) THEN
141     WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
142     & 'Exceed Max.Num. of Fields/list numperlist=', numperlist
143     CALL PRINT_ERROR( msgBuf , myThid )
144     WRITE(msgBuf,'(2A,I3,3A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
145     & 'when trying to add field (m=', m, ' ): ',fields(m,l)
146     CALL PRINT_ERROR( msgBuf , myThid )
147     WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
148     & ' in list l=', l, ', filename: ', filename(l)
149     CALL PRINT_ERROR( msgBuf , myThid )
150     STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
151     ENDIF
152     ENDDO
153     nlists = nlists + 1
154     ELSEIF ( frequency(l).NE.0 ) THEN
155     WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
156     & 'Exceed Max.Num. of list numlists=', numlists
157     CALL PRINT_ERROR( msgBuf , myThid )
158     WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
159     & 'when trying to add list l=', l
160     CALL PRINT_ERROR( msgBuf , myThid )
161     WRITE(msgBuf,'(2A,I6,2A)') 'DIAGNOSTICS_READPARMS: ',
162     & ' Frq=', frequency(l), ', filename: ', filename(l)
163     CALL PRINT_ERROR( msgBuf , myThid )
164     STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
165     ENDIF
166     ENDDO
167    
168     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
169     C Echo History List Data Structure
170     stdUnit = standardMessageUnit
171     WRITE(msgBuf,'(A)')
172     & '-----------------------------------------------------'
173     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
174     WRITE(msgBuf,'(A)')
175     & ' DIAGNOSTICS_READPARMS: active diagnostics summary:'
176     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
177     WRITE(msgBuf,'(A)')
178     & '-----------------------------------------------------'
179     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
180     DO n = 1,nlists
181     WRITE(msgBuf,'(2a)') 'Creating Output Stream: ',fnames(n)
182     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
183     WRITE(msgBuf,*) 'Frequency: ',freq(n)
184     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
185     DO l=1,nlevels(n),20
186     m = MIN(nlevels(n),l+19)
187     WRITE(msgBuf,'(A,20F5.0)') ' Levels: ', (levs(k,n),k=l,m)
188     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
189     ENDDO
190     WRITE(msgBuf,*) 'Fields: ',(' ',flds(l,n),l=1,nfields(n))
191     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
192     ENDDO
193     WRITE(msgBuf,'(A)')
194     & '-----------------------------------------------------'
195     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
196     WRITE(msgBuf,'(A)')
197     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
198    
199     _END_MASTER(myThid)
200    
201     RETURN
202     END
  ViewVC Help
Powered by ViewVC 1.1.22