/[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.29 by jmc, Mon Jun 5 18:17:23 2006 UTC revision 1.30 by jmc, Sun Dec 24 20:15:42 2006 UTC
# Line 26  C     !USES: Line 26  C     !USES:
26  #include "DIAGNOSTICS_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
27  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
28    
29          INTEGER NrMax
30  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
31  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
32          PARAMETER( NrMax = Nr+Nrphys )
33  #else  #else
34        INTEGER Nrphys        PARAMETER( NrMax = Nr )
       PARAMETER (Nrphys=0)  
35  #endif  #endif
36    
37    
# Line 56  C     im    :: counter-mate pointer to s Line 57  C     im    :: counter-mate pointer to s
57        INTEGER md, ndId, ip, im        INTEGER md, ndId, ip, im
58        INTEGER mate, mVec        INTEGER mate, mVec
59        CHARACTER*8 parms1        CHARACTER*8 parms1
60        _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)        _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
61        _RL undef, getcon        _RL undef, getcon
62          _RL tmpLev
63        EXTERNAL getcon        EXTERNAL getcon
64        INTEGER ILNBLNK        INTEGER ILNBLNK
65        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
66        INTEGER ilen        INTEGER ilen
       INTEGER nlevsout  
67    
68        INTEGER ioUnit        INTEGER ioUnit
69        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
# Line 71  C     im    :: counter-mate pointer to s Line 72  C     im    :: counter-mate pointer to s
72  #ifdef ALLOW_MDSIO  #ifdef ALLOW_MDSIO
73        LOGICAL glf        LOGICAL glf
74        INTEGER nRec        INTEGER nRec
75          INTEGER prec
76  #endif  #endif
77  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
78        INTEGER ii        INTEGER ii
# Line 84  C     im    :: counter-mate pointer to s Line 86  C     im    :: counter-mate pointer to s
86        CHARACTER*(NLEN) dn_blnk        CHARACTER*(NLEN) dn_blnk
87  #ifdef DIAG_MNC_COORD_NEEDSWORK  #ifdef DIAG_MNC_COORD_NEEDSWORK
88        CHARACTER*(5) ctmp        CHARACTER*(5) ctmp
89        _RS ztmp(Nr+Nrphys)        _RS ztmp(NrMax)
90  #endif  #endif
91  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
92    
# Line 286  C-        diagnostics is not empty : Line 288  C-        diagnostics is not empty :
288                ENDIF                ENDIF
289              ENDIF              ENDIF
290    
291              DO bj = myByLo(myThid), myByHi(myThid)              IF ( fflags(listId)(2:2).EQ.'P' ) THEN
292               DO bi = myBxLo(myThid), myBxHi(myThid)  C-       get all the levels (for vertical interpolation)
293                DO k = 1,nlevels(listId)                DO bj = myByLo(myThid), myByHi(myThid)
294                  CALL GETDIAG(                 DO bi = myBxLo(myThid), myBxHi(myThid)
295       I                       levs(k,listId),undef,                  DO k = 1,kdiag(ndId)
296       O                       qtmp1(1-OLx,1-OLy,k,bi,bj),                    tmpLev = k
297       I                       ndId,mate,ip,im,bi,bj,myThid)                    CALL GETDIAG(
298         I                         tmpLev,undef,
299         O                         qtmp1(1-OLx,1-OLy,k,bi,bj),
300         I                         ndId,mate,ip,im,bi,bj,myThid)
301                    ENDDO
302                   ENDDO
303                ENDDO                ENDDO
304               ENDDO              ELSE
305              ENDDO  C-       get only selected levels:
306                  DO bj = myByLo(myThid), myByHi(myThid)
307                   DO bi = myBxLo(myThid), myBxHi(myThid)
308                    DO k = 1,nlevels(listId)
309                      CALL GETDIAG(
310         I                         levs(k,listId),undef,
311         O                         qtmp1(1-OLx,1-OLy,k,bi,bj),
312         I                         ndId,mate,ip,im,bi,bj,myThid)
313                    ENDDO
314                   ENDDO
315                  ENDDO
316                ENDIF
317    
318  C-        end of empty diag / not empty block  C-        end of empty diag / not empty block
319            ENDIF            ENDIF
320    
           nlevsout = nlevels(listId)  
   
321  C-----------------------------------------------------------------------  C-----------------------------------------------------------------------
322  C         Check to see if we need to interpolate before output  C         Check to see if we need to interpolate before output
323  C-----------------------------------------------------------------------  C-----------------------------------------------------------------------
324            IF ( fflags(listId)(2:2).EQ.'P' ) THEN            IF ( fflags(listId)(2:2).EQ.'P' ) THEN
325  C-        Do vertical interpolation:  C-        Do vertical interpolation:
326  c          IF ( fluidIsAir ) THEN             IF ( fluidIsAir ) THEN
327  C jmc: for now, this can only work in an atmospheric set-up (fluidIsAir);  C jmc: for now, this can only work in an atmospheric set-up (fluidIsAir);
 C      find some problems with 5-levels AIM => use it only with FIZHI  
            IF ( useFIZHI ) THEN  
328              CALL DIAGNOSTICS_INTERP_VERT(              CALL DIAGNOSTICS_INTERP_VERT(
329       I                     listId, md, ndId, ip, im,       I                     listId, md, ndId, ip, im, lm,
      U                     nlevsout,  
330       U                     qtmp1,       U                     qtmp1,
331       I                     undef,       I                     undef, myTime, myIter, myThid )
      I                     myTime, myIter, myThid )  
332             ELSE             ELSE
333               WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',               WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
334       &         'INTERP_VERT not safe in this config'       &         'INTERP_VERT not allowed in this config'
              CALL PRINT_ERROR( msgBuf , myThid )  
              WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_OUT: ',  
      &         ' for list l=', listId, ', filename: ', fnames(listId)  
335               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
336               STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'               STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'
337             ENDIF             ENDIF
# Line 333  C         Prepare for mdsio optionality Line 342  C         Prepare for mdsio optionality
342            IF (diag_mdsio) THEN            IF (diag_mdsio) THEN
343              glf = globalFiles              glf = globalFiles
344              nRec = lm + (md-1)*averageCycle(listId)              nRec = lm + (md-1)*averageCycle(listId)
345              IF (fflags(listId)(1:1) .EQ. 'R') THEN  C           default precision for output files
346  C             Force it to be 32-bit precision              prec = writeBinaryPrec
347                CALL MDSWRITEFIELD_NEW(fn,precFloat32,glf,.FALSE.,  C           fFlag(1)=R(or D): force it to be 32-bit(or 64) precision
348       &             'RL',Nr+Nrphys,nlevsout,qtmp1,nRec,myIter,myThid)              IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32
349              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN              IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64
350  C             Force it to be 64-bit precision              CALL MDSWRITEFIELD_NEW(fn,prec,glf,.FALSE.,'RL',
351                CALL MDSWRITEFIELD_NEW(fn,precFloat64,glf,.FALSE.,       &              NrMax,nlevels(listId),qtmp1,nRec,myIter,myThid)
      &             'RL',Nr+Nrphys,nlevsout,qtmp1,nRec,myIter,myThid)  
             ELSE  
 C             This is the old default behavior  
               CALL MDSWRITEFIELD_NEW(fn,writeBinaryPrec,glf,.FALSE.,  
      &             'RL',Nr+Nrphys,nlevsout,qtmp1,nRec,myIter,myThid)  
             ENDIF  
352            ENDIF            ENDIF
353  #endif /*  ALLOW_MDSIO  */  #endif /*  ALLOW_MDSIO  */
354    
# Line 396  C           XY dimensions Line 399  C           XY dimensions
399              ENDIF              ENDIF
400    
401  C           Z is special since it varies  C           Z is special since it varies
402              WRITE(dn(3),'(a,i6.6)') 'Zd', nlevsout              WRITE(dn(3),'(a,i6.6)') 'Zd', nlevels(listId)
403              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
404       &           .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN
405                WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevsout                WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevels(listId)
406              ENDIF              ENDIF
407              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
408       &           .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN
409                WRITE(dn(3),'(a,i6.6)') 'Zld', nlevsout                WRITE(dn(3),'(a,i6.6)') 'Zld', nlevels(listId)
410              ENDIF              ENDIF
411              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
412       &           .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN
413                WRITE(dn(3),'(a,i6.6)') 'Zud', nlevsout                WRITE(dn(3),'(a,i6.6)') 'Zud', nlevels(listId)
414              ENDIF              ENDIF
415              dim(3) = Nr+Nrphys              dim(3) = NrMax
416              ib(3)  = 1              ib(3)  = 1
417              ie(3)  = nlevsout              ie(3)  = nlevels(listId)
418    
419  C           Time dimension  C           Time dimension
420              dn(4)(1:1) = 'T'              dn(4)(1:1) = 'T'
Legend:
Removed from v.1.29  
changed lines
  Added in v.1.30
  ViewVC Help
Powered by ViewVC 1.1.22