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

Diff of /MITgcm/pkg/diagnostics/diagnostics_out.F

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

revision 1.40 by jmc, Tue Nov 18 21:41:06 2008 UTC revision 1.41 by jmc, Sun Jan 25 20:22:57 2009 UTC
# Line 80  C              diagnostic storage qdiag Line 80  C              diagnostic storage qdiag
80        LOGICAL glf        LOGICAL glf
81  #endif  #endif
82  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
83          INTEGER ll, llMx, jj, jjMx
84        INTEGER ii        INTEGER ii
85        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
86        INTEGER CW_DIMS, NLEN        INTEGER CW_DIMS, NLEN
# Line 113  c     IF ( useFIZHI ) undef = getcon('UN Line 114  c     IF ( useFIZHI ) undef = getcon('UN
114        WRITE( fn, '(A,A,A)' ) fnames(listId)(1:ilen),'.',suff(1:10)        WRITE( fn, '(A,A,A)' ) fnames(listId)(1:ilen),'.',suff(1:10)
115    
116  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
117    C-- this is a trick to reverse the order of the loops on md (= field)
118    C   and lm (= averagePeriod): binary output: lm loop inside md loop ;
119    C                                 mnc ouput: md loop inside lm loop.
120        IF (useMNC .AND. diag_mnc) THEN        IF (useMNC .AND. diag_mnc) THEN
121            jjMx = averageCycle(listId)
122            llMx = 1
123          ELSE
124            jjMx = 1
125            llMx = averageCycle(listId)
126          ENDIF
127          DO jj=1,jjMx
128    
129           IF (useMNC .AND. diag_mnc) THEN
130  C     Handle missing value attribute (land points)  C     Handle missing value attribute (land points)
131         useMissingValue = .FALSE.           useMissingValue = .FALSE.
132  #ifdef DIAGNOSTICS_MISSING_VALUE  #ifdef DIAGNOSTICS_MISSING_VALUE
133         useMissingValue = .TRUE.           useMissingValue = .TRUE.
134  #endif /* DIAGNOSTICS_MISSING_VALUE */  #endif /* DIAGNOSTICS_MISSING_VALUE */
135         IF ( misvalFlt(listId) .NE. UNSET_RL ) THEN           IF ( misvalFlt(listId) .NE. UNSET_RL ) THEN
136          misvalLoc = misvalFlt(listId)            misvalLoc = misvalFlt(listId)
137         ELSE           ELSE
138          misvalLoc = undef            misvalLoc = undef
139         ENDIF           ENDIF
140  C     Defaults to UNSET_I  C     Defaults to UNSET_I
141         misvalIntLoc = misvalInt(listId)           misvalIntLoc = misvalInt(listId)
142         DO ii=1,2           DO ii=1,2
143  C       misval_r4(ii)  = UNSET_FLOAT4  C         misval_r4(ii)  = UNSET_FLOAT4
144  C       misval_r8(ii)  = UNSET_FLOAT8  C         misval_r8(ii)  = UNSET_FLOAT8
145          misval_r4(ii)  = misvalLoc            misval_r4(ii)  = misvalLoc
146          misval_r8(ii)  = misvalLoc            misval_r8(ii)  = misvalLoc
147          misval_int(ii) = UNSET_I            misval_int(ii) = UNSET_I
148         ENDDO           ENDDO
149          DO i = 1,MAX_LEN_FNAM           DO i = 1,MAX_LEN_FNAM
150            diag_mnc_bn(i:i) = ' '             diag_mnc_bn(i:i) = ' '
151          ENDDO           ENDDO
152          DO i = 1,NLEN           DO i = 1,NLEN
153            dn_blnk(i:i) = ' '             dn_blnk(i:i) = ' '
154          ENDDO           ENDDO
155          WRITE( diag_mnc_bn, '(A)' ) fnames(listId)(1:ilen)           WRITE( diag_mnc_bn, '(A)' ) fnames(listId)(1:ilen)
156    
157  C       Update the record dimension by writing the iteration number  C       Update the record dimension by writing the iteration number
158          CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)           klev = myIter + jj - jjMx
159          CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',myTime,myThid)           tmpLev = myTime + deltaTClock*(jj -jjMx)
160          CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)           CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)
161          CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',myIter,myThid)           CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',tmpLev,myThid)
162             CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)
163             CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',klev,myThid)
164    
165  C       NOTE: at some point it would be a good idea to add a time_bounds  C       NOTE: at some point it would be a good idea to add a time_bounds
166  C       variable that has dimension (2,T) and clearly denotes the  C       variable that has dimension (2,T) and clearly denotes the
167  C       beginning and ending times for each diagnostics period  C       beginning and ending times for each diagnostics period
168    
169          dn(1)(1:NLEN) = dn_blnk(1:NLEN)           dn(1)(1:NLEN) = dn_blnk(1:NLEN)
170          WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId)           WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId)
171          dim(1) = nlevels(listId)           dim(1) = nlevels(listId)
172          ib(1)  = 1           ib(1)  = 1
173          ie(1)  = nlevels(listId)           ie(1)  = nlevels(listId)
174    
175          CALL MNC_CW_ADD_GNAME('diag_levels', 1,           CALL MNC_CW_ADD_GNAME('diag_levels', 1,
176       &       dim, dn, ib, ie, myThid)       &        dim, dn, ib, ie, myThid)
177          CALL MNC_CW_ADD_VNAME('diag_levels', 'diag_levels',           CALL MNC_CW_ADD_VNAME('diag_levels', 'diag_levels',
178       &       0,0, myThid)       &        0,0, myThid)
179          CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',           CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',
180       &       'Idicies of vertical levels within the source arrays',       &        'Idicies of vertical levels within the source arrays',
181       &       myThid)       &        myThid)
182  C     suppress the missing value attribute (iflag = 0)  C     suppress the missing value attribute (iflag = 0)
183          IF (useMissingValue)           IF (useMissingValue)
184       &       CALL MNC_CW_VATTR_MISSING('diag_levels', 0,       &       CALL MNC_CW_VATTR_MISSING('diag_levels', 0,
185       I       misval_r8, misval_r4, misval_int,       I       misval_r8, misval_r4, misval_int,
186       I       myThid )       I       myThid )
187    
188          CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,           CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
189       &       'diag_levels', levs(1,listId), myThid)       &        'diag_levels', levs(1,listId), myThid)
190    
191          CALL MNC_CW_DEL_VNAME('diag_levels', myThid)           CALL MNC_CW_DEL_VNAME('diag_levels', myThid)
192          CALL MNC_CW_DEL_GNAME('diag_levels', myThid)           CALL MNC_CW_DEL_GNAME('diag_levels', myThid)
193    
194  #ifdef DIAG_MNC_COORD_NEEDSWORK  #ifdef DIAG_MNC_COORD_NEEDSWORK
195  C       This part has been placed in an #ifdef because, as its currently  C       This part has been placed in an #ifdef because, as its currently
# Line 190  C       as: Z[uml]td000000 where the 't' Line 205  C       as: Z[uml]td000000 where the 't'
205  C       gdiag(10)  C       gdiag(10)
206    
207  C       Now define:  Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx  C       Now define:  Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx
208          ctmp(1:5) = 'mul  '           ctmp(1:5) = 'mul  '
209          DO i = 1,3           DO i = 1,3
210            dn(1)(1:NLEN) = dn_blnk(1:NLEN)             dn(1)(1:NLEN) = dn_blnk(1:NLEN)
211            WRITE(dn(1),'(3a,i6.6)') 'Z',ctmp(i:i),'d',nlevels(listId)             WRITE(dn(1),'(3a,i6.6)') 'Z',ctmp(i:i),'d',nlevels(listId)
212            CALL MNC_CW_ADD_GNAME(dn(1), 1, dim, dn, ib, ie, myThid)             CALL MNC_CW_ADD_GNAME(dn(1), 1, dim, dn, ib, ie, myThid)
213            CALL MNC_CW_ADD_VNAME(dn(1), dn(1), 0,0, myThid)             CALL MNC_CW_ADD_VNAME(dn(1), dn(1), 0,0, myThid)
214    
215  C         The following three ztmp() loops should eventually be modified  C         The following three ztmp() loops should eventually be modified
216  C         to reflect the fractional nature of levs(j,l) -- they should  C         to reflect the fractional nature of levs(j,l) -- they should
# Line 205  C                      + ( rC(INT(FLOOR( Line 220  C                      + ( rC(INT(FLOOR(
220  C                          + rC(INT(CEIL(levs(j,l)))) )  C                          + rC(INT(CEIL(levs(j,l)))) )
221  C                        / ( levs(j,l) - FLOOR(levs(j,l)) )  C                        / ( levs(j,l) - FLOOR(levs(j,l)) )
222  C         for averaged levels.  C         for averaged levels.
223            IF (i .EQ. 1) THEN             IF (i .EQ. 1) THEN
224              DO j = 1,nlevels(listId)               DO j = 1,nlevels(listId)
225                ztmp(j) = rC(NINT(levs(j,listId)))                 ztmp(j) = rC(NINT(levs(j,listId)))
226              ENDDO               ENDDO
227              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',               CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
228       &           'Dimensional coordinate value at the mid point',       &            'Dimensional coordinate value at the mid point',
229       &           myThid)       &            myThid)
230            ELSEIF (i .EQ. 2) THEN             ELSEIF (i .EQ. 2) THEN
231              DO j = 1,nlevels(listId)               DO j = 1,nlevels(listId)
232                ztmp(j) = rF(NINT(levs(j,listId)) + 1)                 ztmp(j) = rF(NINT(levs(j,listId)) + 1)
233              ENDDO               ENDDO
234              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',               CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
235       &           'Dimensional coordinate value at the upper point',       &            'Dimensional coordinate value at the upper point',
236       &           myThid)       &            myThid)
237            ELSEIF (i .EQ. 3) THEN             ELSEIF (i .EQ. 3) THEN
238              DO j = 1,nlevels(listId)               DO j = 1,nlevels(listId)
239                ztmp(j) = rF(NINT(levs(j,listId)))                 ztmp(j) = rF(NINT(levs(j,listId)))
240              ENDDO               ENDDO
241              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',               CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
242       &           'Dimensional coordinate value at the lower point',       &            'Dimensional coordinate value at the lower point',
243       &           myThid)       &            myThid)
244            ENDIF             ENDIF
245  C     suppress the missing value attribute (iflag = 0)  C     suppress the missing value attribute (iflag = 0)
246            IF (useMissingValue)             IF (useMissingValue)
247       &         CALL MNC_CW_VATTR_MISSING(dn(1), 0,       &          CALL MNC_CW_VATTR_MISSING(dn(1), 0,
248       I         misval_r8, misval_r4, misval_int,       I          misval_r8, misval_r4, misval_int,
249       I         myThid )       I          myThid )
250            CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid)             CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid)
251            CALL MNC_CW_DEL_VNAME(dn(1), myThid)             CALL MNC_CW_DEL_VNAME(dn(1), myThid)
252            CALL MNC_CW_DEL_GNAME(dn(1), myThid)             CALL MNC_CW_DEL_GNAME(dn(1), myThid)
253          ENDDO           ENDDO
254  #endif /*  DIAG_MNC_COORD_NEEDSWORK  */  #endif /*  DIAG_MNC_COORD_NEEDSWORK  */
255    
256        ENDIF         ENDIF
257  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
258    
259  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
260    
261        DO md = 1,nfields(listId)         DO md = 1,nfields(listId)
262          ndId = jdiag(md,listId)          ndId = jdiag(md,listId)
263          gcode = gdiag(ndId)(1:10)          gcode = gdiag(ndId)(1:10)
264          mate = 0          mate = 0
# Line 257  C-      Check for Mate of a Vector Diagn Line 272  C-      Check for Mate of a Vector Diagn
272          ENDIF          ENDIF
273          IF ( idiag(md,listId).NE.0 .AND. gcode(5:5).NE.'D' ) THEN          IF ( idiag(md,listId).NE.0 .AND. gcode(5:5).NE.'D' ) THEN
274  C--     Start processing 1 Fld :  C--     Start processing 1 Fld :
275    #ifdef ALLOW_MNC
276             DO ll=1,llMx
277              lm = jj+ll-1
278    #else
279           DO lm=1,averageCycle(listId)           DO lm=1,averageCycle(listId)
280    #endif
281    
282            ip = ABS(idiag(md,listId)) + kdiag(ndId)*(lm-1)            ip = ABS(idiag(md,listId)) + kdiag(ndId)*(lm-1)
283            im = mdiag(md,listId)            im = mdiag(md,listId)
# Line 510  C     each of these variables Line 530  C     each of these variables
530       I            myThid )       I            myThid )
531              ENDIF              ENDIF
532    
533              IF ( ( (writeBinaryPrec .EQ. precFloat32)              IF (  ((writeBinaryPrec .EQ. precFloat32)
534       &           .AND. (fflags(listId)(1:1) .NE. 'D')       &            .AND. (fflags(listId)(1:1) .NE. 'D'))
535       &           .AND. (fflags(listId)(1:1) .NE. 'R') )       &             .OR. (fflags(listId)(1:1) .EQ. 'R') ) THEN
      &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN  
536                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,
537       &             cdiag(ndId), qtmp1, myThid)       &             cdiag(ndId), qtmp1, myThid)
538              ELSEIF ( (writeBinaryPrec .EQ. precFloat64)              ELSEIF ( (writeBinaryPrec .EQ. precFloat64)
# Line 530  C     each of these variables Line 549  C     each of these variables
549            ENDIF            ENDIF
550  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
551    
552    C--      end loop on lm (or ll if ALLOW_MNC) counter
553           ENDDO           ENDDO
554  C--     end of Processing Fld # md  C--     end of Processing Fld # md
555          ENDIF          ENDIF
556           ENDDO
557    
558    #ifdef ALLOW_MNC
559    C--   end loop on jj counter
560        ENDDO        ENDDO
561    #endif
562    
563  #ifdef ALLOW_MDSIO  #ifdef ALLOW_MDSIO
564        IF (diag_mdsio) THEN        IF (diag_mdsio) THEN
Legend:
Removed from v.1.40  
changed lines
  Added in v.1.41
  ViewVC Help
Powered by ViewVC 1.1.22