/[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.52 by jmc, Sun Jun 12 19:16:09 2011 UTC revision 1.60 by jmc, Sun Jan 13 22:46:38 2013 UTC
# Line 52  C     bi,bj :: tile indices Line 52  C     bi,bj :: tile indices
52  C     lm    :: loop index (averageCycle)  C     lm    :: loop index (averageCycle)
53  C     md    :: field number in the list "listId".  C     md    :: field number in the list "listId".
54  C     ndId  :: diagnostics  Id number (in available diagnostics list)  C     ndId  :: diagnostics  Id number (in available diagnostics list)
 C     mate  :: counter mate Id number (in available diagnostics list)  
55  C     ip    :: diagnostics  pointer to storage array  C     ip    :: diagnostics  pointer to storage array
56  C     im    :: counter-mate pointer to storage array  C     im    :: counter-mate pointer to storage array
57    C     mate  :: counter mate Id number (in available diagnostics list)
58    C     mDbl  :: processing mate Id number (in case processing requires 2 diags)
59    C     mVec  :: vector mate Id number
60    C     ppFld :: post-processed diag or not (=0): =1 stored in qtmp1 ; =2 in qtmp2
61    C   isComputed :: previous post-processed diag (still available in qtmp)
62  C     nLevOutp :: number of levels to write in output file  C     nLevOutp :: number of levels to write in output file
63  C  C
64  C--   COMMON /LOCAL_DIAGNOSTICS_OUT/ local common block (for multi-threaded)  C--   COMMON /LOCAL_DIAGNOSTICS_OUT/ local common block (for multi-threaded)
# Line 67  c     COMMON /LOCAL_DIAGNOSTICS_OUT/ qtm Line 71  c     COMMON /LOCAL_DIAGNOSTICS_OUT/ qtm
71    
72        INTEGER i, j, k, lm        INTEGER i, j, k, lm
73        INTEGER bi, bj        INTEGER bi, bj
74        INTEGER md, ndId, ip, im        INTEGER md, ndId, nn, ip, im
75        INTEGER mate, mVec        INTEGER mate, mDbl, mVec
76          INTEGER ppFld, isComputed
77        CHARACTER*10 gcode        CHARACTER*10 gcode
78        _RL undefRL        _RL undefRL
79        INTEGER nLevOutp, kLev        INTEGER nLevOutp, kLev
# Line 85  c     COMMON /LOCAL_DIAGNOSTICS_OUT/ qtm Line 90  c     COMMON /LOCAL_DIAGNOSTICS_OUT/ qtm
90        LOGICAL glf        LOGICAL glf
91  #endif  #endif
92  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
       INTEGER ll, llMx, jj, jjMx  
93        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
       LOGICAL useMissingValue  
       REAL*8 misValLoc  
94  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
95    
96  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 99  C---  set file properties Line 101  C---  set file properties
101  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
102        IF ( useFIZHI ) undefRL = getcon('UNDEF')        IF ( useFIZHI ) undefRL = getcon('UNDEF')
103  #endif  #endif
104          IF ( misvalFlt(listId).NE.UNSET_RL ) undefRL = misvalFlt(listId)
105    
106        WRITE(suff,'(I10.10)') myIter        WRITE(suff,'(I10.10)') myIter
107        iLen = ILNBLNK(fnames(listId))        iLen = ILNBLNK(fnames(listId))
108        WRITE( fn, '(A,A,A)' ) fnames(listId)(1:iLen),'.',suff(1:10)        WRITE( fn, '(A,A,A)' ) fnames(listId)(1:iLen),'.',suff(1:10)
# Line 148  c     DO i=1,nTimRec Line 152  c     DO i=1,nTimRec
152  c       timeRec(i) = timeRec(i)/deltaTClock  c       timeRec(i) = timeRec(i)/deltaTClock
153  c     ENDDO  c     ENDDO
154    
155  #ifdef ALLOW_MNC  C--   Place the loop on lm (= averagePeriod) outside the loop on md (= field):
156  C-- this is a trick to reverse the order of the loops on md (= field)        DO lm=1,averageCycle(listId)
 C   and lm (= averagePeriod): binary output: lm loop inside md loop ;  
 C                                 mnc ouput: md loop inside lm loop.  
       IF (useMNC .AND. diag_mnc) THEN  
         jjMx = averageCycle(listId)  
         llMx = 1  
       ELSE  
         jjMx = 1  
         llMx = averageCycle(listId)  
       ENDIF  
       DO jj=1,jjMx  
157    
158    #ifdef ALLOW_MNC
159         IF (useMNC .AND. diag_mnc) THEN         IF (useMNC .AND. diag_mnc) THEN
          misValLoc = undefRL  
          IF ( misvalFlt(listId).NE.UNSET_RL )  
      &        misValLoc = misvalFlt(listId)  
160           CALL DIAGNOSTICS_MNC_SET(           CALL DIAGNOSTICS_MNC_SET(
161       I                    nLevOutp, listId, jj,       I                    nLevOutp, listId, lm,
162       O                    diag_mnc_bn, useMissingValue,       O                    diag_mnc_bn,
163       I                    misValLoc, myTime, myIter, myThid )       I                    undefRL, myTime, myIter, myThid )
164         ENDIF         ENDIF
165  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
166    
167  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
168    
169           isComputed = 0
170         DO md = 1,nfields(listId)         DO md = 1,nfields(listId)
171          ndId = jdiag(md,listId)          ndId = jdiag(md,listId)
172          gcode = gdiag(ndId)(1:10)          gcode = gdiag(ndId)(1:10)
173          mate = 0          mate = 0
174          mVec = 0          mVec = 0
175            mDbl = 0
176            ppFld = 0
177          IF ( gcode(5:5).EQ.'C' ) THEN          IF ( gcode(5:5).EQ.'C' ) THEN
178  C-      Check for Mate of a Counter Diagnostic  C-      Check for Mate of a Counter Diagnostic
179             mate = hdiag(ndId)             mate = hdiag(ndId)
180            ELSEIF ( gcode(5:5).EQ.'P' ) THEN
181               ppFld = 1
182               IF ( gdiag(hdiag(ndId))(5:5).EQ.'P' ) ppFld = 2
183    C-      Also load the mate (if stored) for Post-Processing
184               nn = ndId
185               DO WHILE ( gdiag(nn)(5:5).EQ.'P' )
186                 nn = hdiag(nn)
187               ENDDO
188               IF ( mdiag(md,listId).NE.0 ) mDbl = hdiag(nn)
189    c          write(0,*) ppFld,' ndId=', ndId, nn, mDbl, isComputed
190          ELSEIF ( gcode(1:1).EQ.'U' .OR. gcode(1:1).EQ.'V' ) THEN          ELSEIF ( gcode(1:1).EQ.'U' .OR. gcode(1:1).EQ.'V' ) THEN
191  C-      Check for Mate of a Vector Diagnostic  C-      Check for Mate of a Vector Diagnostic
192             mVec = hdiag(ndId)             mVec = hdiag(ndId)
193          ENDIF          ENDIF
194          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
195  C--     Start processing 1 Fld :  C--     Start processing 1 Fld :
 #ifdef ALLOW_MNC  
          DO ll=1,llMx  
           lm = jj+ll-1  
 #else  
          DO lm=1,averageCycle(listId)  
 #endif  
196    
197            ip = ABS(idiag(md,listId)) + kdiag(ndId)*(lm-1)            ip = ABS(idiag(md,listId)) + kdiag(ndId)*(lm-1)
198            im = mdiag(md,listId)            im = mdiag(md,listId)
199            IF (mate.GT.0) im = im + kdiag(mate)*(lm-1)            IF (mate.GT.0) im = im + kdiag(mate)*(lm-1)
200              IF (mDbl.GT.0) im = im + kdiag(mDbl)*(lm-1)
201            IF (mVec.GT.0) im = im + kdiag(mVec)*(lm-1)            IF (mVec.GT.0) im = im + kdiag(mVec)*(lm-1)
202    
203            IF ( ndiag(ip,1,1).EQ.0 ) THEN            IF ( ppFld.EQ.2 .AND. isComputed.EQ.hdiag(ndId) ) THEN
204    C-        Post-Processed diag from an other Post-Processed diag -and-
205    C         both of them have just been calculated and are still stored in qtmp:
206    C         => skip computation and just write qtmp2
207                IF ( debugLevel.GE.debLevB .AND. myThid.EQ.1 ) THEN
208                   WRITE(ioUnit,'(A,I6,3A,I6)')
209         &         '  get Post-Proc. Diag # ', ndId, '  ', cdiag(ndId),
210         &         ' from previous computation of Diag # ', isComputed
211                ENDIF
212                isComputed = 0
213              ELSEIF ( ndiag(ip,1,1).EQ.0 ) THEN
214  C-        Empty diagnostics case :  C-        Empty diagnostics case :
215                isComputed = 0
216    
217              _BEGIN_MASTER( myThid )              _BEGIN_MASTER( myThid )
218              WRITE(msgBuf,'(A,I10)')              WRITE(msgBuf,'(A,I10)')
# Line 243  C-        Empty diagnostics case : Line 254  C-        Empty diagnostics case :
254    
255            ELSE            ELSE
256  C-        diagnostics is not empty :  C-        diagnostics is not empty :
257                isComputed = 0
258    
259              IF ( debugLevel.GE.debLevB .AND. myThid.EQ.1 ) THEN              IF ( debugLevel.GE.debLevB .AND. myThid.EQ.1 ) THEN
260                WRITE(ioUnit,'(A,I6,3A,I8,2A)')                IF ( ppFld.GE.1 ) THEN
261                   WRITE(ioUnit,'(A,I6,7A,I8,2A)')
262         &         ' Post-Processing Diag # ', ndId, '  ', cdiag(ndId),
263         &         '   Parms: ',gdiag(ndId)
264                   IF ( mDbl.EQ.0 ) THEN
265                    WRITE(ioUnit,'(2(3A,I6,A,I8))') '   from diag: ',
266         &            cdiag(nn), ' (#', nn, ') Cnt=', ndiag(ip,1,1)
267                   ELSE
268                    WRITE(ioUnit,'(2(3A,I6,A,I8))') '   from diag: ',
269         &            cdiag(nn), ' (#', nn, ') Cnt=', ndiag(ip,1,1),
270         &          ' and diag: ',
271         &            cdiag(mDbl),' (#',mDbl,') Cnt=',ndiag(im,1,1)
272                   ENDIF
273                  ELSE
274                   WRITE(ioUnit,'(A,I6,3A,I8,2A)')
275       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),
276       &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)       &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)
277                  ENDIF
278                IF ( mate.GT.0 ) THEN                IF ( mate.GT.0 ) THEN
279                 WRITE(ioUnit,'(3A,I6,2A)')                 WRITE(ioUnit,'(3A,I6,2A)')
280       &         '       use Counter Mate for  ', cdiag(ndId),       &         '       use Counter Mate for  ', cdiag(ndId),
# Line 276  C-       get only selected levels: Line 303  C-       get only selected levels:
303                    CALL DIAGNOSTICS_GET_DIAG(                    CALL DIAGNOSTICS_GET_DIAG(
304       I                         kLev, undefRL,       I                         kLev, undefRL,
305       O                         qtmp1(1-OLx,1-OLy,k,bi,bj),       O                         qtmp1(1-OLx,1-OLy,k,bi,bj),
306       I                         ndId,mate,ip,im,bi,bj,myThid)       I                         ndId, mate, ip, im, bi, bj, myThid )
307                  ENDDO                  ENDDO
308                 ENDDO                 ENDDO
309                ENDDO                ENDDO
310                  IF ( mDbl.GT.0 ) THEN
311                   DO bj = myByLo(myThid), myByHi(myThid)
312                    DO bi = myBxLo(myThid), myBxHi(myThid)
313                     DO k = 1,nlevels(listId)
314                      kLev = NINT(levs(k,listId))
315                      CALL DIAGNOSTICS_GET_DIAG(
316         I                         kLev, undefRL,
317         O                         qtmp2(1-OLx,1-OLy,k,bi,bj),
318         I                         mDbl, 0, im, 0, bi, bj, myThid )
319                     ENDDO
320                    ENDDO
321                   ENDDO
322                  ENDIF
323              ELSE              ELSE
324  C-       get all the levels (for vertical post-processing)  C-       get all the levels (for vertical post-processing)
325                DO bj = myByLo(myThid), myByHi(myThid)                DO bj = myByLo(myThid), myByHi(myThid)
# Line 287  C-       get all the levels (for vertica Line 327  C-       get all the levels (for vertica
327                    CALL DIAGNOSTICS_GET_DIAG(                    CALL DIAGNOSTICS_GET_DIAG(
328       I                         0, undefRL,       I                         0, undefRL,
329       O                         qtmp1(1-OLx,1-OLy,1,bi,bj),       O                         qtmp1(1-OLx,1-OLy,1,bi,bj),
330       I                         ndId,mate,ip,im,bi,bj,myThid)       I                         ndId, mate, ip, im, bi, bj, myThid )
331                 ENDDO                 ENDDO
332                ENDDO                ENDDO
333                  IF ( mDbl.GT.0 ) THEN
334                   DO bj = myByLo(myThid), myByHi(myThid)
335                    DO bi = myBxLo(myThid), myBxHi(myThid)
336                      CALL DIAGNOSTICS_GET_DIAG(
337         I                         0, undefRL,
338         O                         qtmp2(1-OLx,1-OLy,1,bi,bj),
339         I                         mDbl, 0, im, 0, bi, bj, myThid )
340                    ENDDO
341                   ENDDO
342                  ENDIF
343              ENDIF              ENDIF
344    
345  C-----------------------------------------------------------------------  C-----------------------------------------------------------------------
# Line 317  C-          Integrate vertically: for no Line 367  C-          Integrate vertically: for no
367       U                         qtmp1,       U                         qtmp1,
368       I                         undefRL, myTime, myIter, myThid )       I                         undefRL, myTime, myIter, myThid )
369              ENDIF              ENDIF
370                IF ( ppFld.GE.1 ) THEN
371    C-          Do Post-Processing:
372                 IF ( flds(md,listId).EQ.'PhiVEL  '
373         &       .OR. flds(md,listId).EQ.'PsiVEL  '
374         &          ) THEN
375                  CALL DIAGNOSTICS_CALC_PHIVEL(
376         I                         listId, md, ndId, ip, im, lm,
377         I                         NrMax,
378         U                         qtmp1, qtmp2,
379         I                         myTime, myIter, myThid )
380                  isComputed = ndId
381                 ELSE
382                   WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
383         &           'unknown Processing method for diag="',cdiag(ndId),'"'
384                   CALL PRINT_ERROR( msgBuf , myThid )
385                   STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'
386                 ENDIF
387                ENDIF
388    
389  C--     End of empty diag / not-empty diag block  C--     End of empty diag / not-empty diag block
390            ENDIF            ENDIF
# Line 325  C--     Ready to write field "md", eleme Line 393  C--     Ready to write field "md", eleme
393    
394  C-        write to binary file, using MDSIO pkg:  C-        write to binary file, using MDSIO pkg:
395            IF ( diag_mdsio ) THEN            IF ( diag_mdsio ) THEN
396              nRec = lm + (md-1)*averageCycle(listId)  c          nRec = lm + (md-1)*averageCycle(listId)
397  C           default precision for output files             nRec = md + (lm-1)*nfields(listId)
398              prec = writeBinaryPrec  C         default precision for output files
399  C           fFlag(1)=R(or D): force it to be 32-bit(or 64) precision             prec = writeBinaryPrec
400              IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32  C         fFlag(1)=R(or D): force it to be 32-bit(or 64) precision
401              IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64             IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32
402               IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64
403  C         a hack not to write meta files now: pass -nRec < 0 to MDS_WRITE S/R  C         a hack not to write meta files now: pass -nRec < 0 to MDS_WRITE S/R
404               IF ( ppFld.LE.1 ) THEN
405              CALL WRITE_REC_LEV_RL(              CALL WRITE_REC_LEV_RL(
406       I                            fn, prec,       I                            fn, prec,
407       I                            NrMax, 1, nLevOutp,       I                            NrMax, 1, nLevOutp,
408       I                            qtmp1, -nRec, myIter, myThid )       I                            qtmp1, -nRec, myIter, myThid )
409               ELSE
410                CALL WRITE_REC_LEV_RL(
411         I                            fn, prec,
412         I                            NrMax, 1, nLevOutp,
413         I                            qtmp2, -nRec, myIter, myThid )
414               ENDIF
415            ENDIF            ENDIF
416    
417  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
418            IF (useMNC .AND. diag_mnc) THEN            IF (useMNC .AND. diag_mnc) THEN
419               IF ( ppFld.LE.1 ) THEN
420                CALL DIAGNOSTICS_MNC_OUT(
421         I                       NrMax, nLevOutp, listId, ndId, mate,
422         I                       diag_mnc_bn, qtmp1,
423         I                       undefRL, myTime, myIter, myThid )
424               ELSE
425              CALL DIAGNOSTICS_MNC_OUT(              CALL DIAGNOSTICS_MNC_OUT(
426       I                       NrMax, nLevOutp, listId, ndId,       I                       NrMax, nLevOutp, listId, ndId, mate,
427       I                       diag_mnc_bn,       I                       diag_mnc_bn, qtmp2,
428       I                       useMissingValue, misValLoc,       I                       undefRL, myTime, myIter, myThid )
429       I                       qtmp1,             ENDIF
      I                       myTime, myIter, myThid )  
430            ENDIF            ENDIF
431  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
432    
 C--      end loop on lm (or ll if ALLOW_MNC) counter  
          ENDDO  
433  C--     end of Processing Fld # md  C--     end of Processing Fld # md
434          ENDIF          ENDIF
435         ENDDO         ENDDO
436    
437  #ifdef ALLOW_MNC  C--   end loop on lm counter (= averagePeriod)
 C--   end loop on jj counter  
438        ENDDO        ENDDO
 #endif  
439    
440  #ifdef ALLOW_MDSIO  #ifdef ALLOW_MDSIO
441        IF (diag_mdsio) THEN        IF (diag_mdsio) THEN
# Line 366  C-    Note: temporary: since it is a pai Line 443  C-    Note: temporary: since it is a pai
443  C     all MDSIO S/R, uses instead this specific S/R to write only  C     all MDSIO S/R, uses instead this specific S/R to write only
444  C     meta files but with more informations in it.  C     meta files but with more informations in it.
445              glf = globalFiles              glf = globalFiles
446              nRec = nfields(listId)*averageCycle(listId)              nRec = averageCycle(listId)*nfields(listId)
447              CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE.,              CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE.,
448       &              0, 0, nLevOutp, ' ',       &              0, 0, nLevOutp, ' ',
449       &              nfields(listId), flds(1,listId), nTimRec, timeRec,       &              nfields(listId), flds(1,listId),
450         &              nTimRec, timeRec, undefRL,
451       &              nRec, myIter, myThid)       &              nRec, myIter, myThid)
452        ENDIF        ENDIF
453  #endif /*  ALLOW_MDSIO  */  #endif /*  ALLOW_MDSIO  */
Legend:
Removed from v.1.52  
changed lines
  Added in v.1.60
  ViewVC Help
Powered by ViewVC 1.1.22