/[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.51 by jmc, Sun Jun 12 13:58:33 2011 UTC revision 1.52 by jmc, Sun Jun 12 19:16:09 2011 UTC
# Line 58  C     im    :: counter-mate pointer to s Line 58  C     im    :: counter-mate pointer to s
58  C     nLevOutp :: number of levels to write in output file  C     nLevOutp :: number of levels to write in output file
59  C  C
60  C--   COMMON /LOCAL_DIAGNOSTICS_OUT/ local common block (for multi-threaded)  C--   COMMON /LOCAL_DIAGNOSTICS_OUT/ local common block (for multi-threaded)
61  C     qtmp1 :: thread-shared temporary array (needs to be in common block):  C     qtmp1 :: temporary array; used to store a copy of diag. output field.
62  C              to write a diagnostic field to file, copy it first from (big)  C     qtmp2 :: temporary array; used to store a copy of a 2nd diag. field.
63  C              diagnostic storage qdiag into it.  C-  Note: local common block no longer needed.
64        COMMON /LOCAL_DIAGNOSTICS_OUT/ qtmp1  c     COMMON /LOCAL_DIAGNOSTICS_OUT/ qtmp1
65        _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)        _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
66          _RL qtmp2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
67    
68        INTEGER i, j, k, lm        INTEGER i, j, k, lm
69        INTEGER bi, bj        INTEGER bi, bj
70        INTEGER md, ndId, ip, im        INTEGER md, ndId, ip, im
71        INTEGER mate, mVec        INTEGER mate, mVec
72        CHARACTER*10 gcode        CHARACTER*10 gcode
73        _RL undef        _RL undefRL
74        _RL tmpLev        INTEGER nLevOutp, kLev
       INTEGER iLen  
       INTEGER nLevOutp  
75    
76          INTEGER iLen
77        INTEGER ioUnit        INTEGER ioUnit
78        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
79        CHARACTER*(MAX_LEN_MBUF) suff        CHARACTER*(MAX_LEN_MBUF) suff
80        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
81        INTEGER prec, nRec, nTimRec        INTEGER prec, nRec, nTimRec
82        _RL     timeRec(2)        _RL     timeRec(2)
83          _RL     tmpLoc
84  #ifdef ALLOW_MDSIO  #ifdef ALLOW_MDSIO
85        LOGICAL glf        LOGICAL glf
86  #endif  #endif
# Line 94  C---+----1----+----2----+----3----+----4 Line 95  C---+----1----+----2----+----3----+----4
95    
96  C---  set file properties  C---  set file properties
97        ioUnit= standardMessageUnit        ioUnit= standardMessageUnit
98        undef = UNSET_RL        undefRL = UNSET_RL
99  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
100        IF ( useFIZHI ) undef = getcon('UNDEF')        IF ( useFIZHI ) undefRL = getcon('UNDEF')
101  #endif  #endif
102        WRITE(suff,'(I10.10)') myIter        WRITE(suff,'(I10.10)') myIter
103        iLen = ILNBLNK(fnames(listId))        iLen = ILNBLNK(fnames(listId))
# Line 126  C     a) find the time of the previous m Line 127  C     a) find the time of the previous m
127          timeRec(1) = (timeRec(1)-phase(listId))/freq(listId)          timeRec(1) = (timeRec(1)-phase(listId))/freq(listId)
128          i = INT( timeRec(1) )          i = INT( timeRec(1) )
129          IF ( timeRec(1).LT.0. ) THEN          IF ( timeRec(1).LT.0. ) THEN
130            tmpLev = FLOAT(i)            tmpLoc = FLOAT(i)
131            IF ( timeRec(1).NE.tmpLev ) i = i - 1            IF ( timeRec(1).NE.tmpLoc ) i = i - 1
132          ENDIF          ENDIF
133          timeRec(1) = phase(listId) + freq(listId)*FLOAT(i)          timeRec(1) = phase(listId) + freq(listId)*FLOAT(i)
134  c       if ( listId.eq.2 ) write(0,*) 'f',i,timeRec(1)/deltaTClock  c       if ( listId.eq.2 ) write(0,*) 'f',i,timeRec(1)/deltaTClock
# Line 137  C     b) round off to nearest multiple o Line 138  C     b) round off to nearest multiple o
138          timeRec(1) = (timeRec(1)-baseTime)/deltaTClock          timeRec(1) = (timeRec(1)-baseTime)/deltaTClock
139          i = NINT( timeRec(1) )          i = NINT( timeRec(1) )
140  C     if just half way, NINT will return the next time-step: correct this  C     if just half way, NINT will return the next time-step: correct this
141          tmpLev = FLOAT(i) - 0.5 _d 0          tmpLoc = FLOAT(i) - 0.5 _d 0
142          IF ( timeRec(1).EQ.tmpLev ) i = i - 1          IF ( timeRec(1).EQ.tmpLoc ) i = i - 1
143          timeRec(1) = baseTime + deltaTClock*FLOAT(i)          timeRec(1) = baseTime + deltaTClock*FLOAT(i)
144  c       if ( listId.eq.2 ) write(0,*) i,timeRec(1)/deltaTClock  c       if ( listId.eq.2 ) write(0,*) i,timeRec(1)/deltaTClock
145        ENDIF        ENDIF
# Line 161  C                                 mnc ou Line 162  C                                 mnc ou
162        DO jj=1,jjMx        DO jj=1,jjMx
163    
164         IF (useMNC .AND. diag_mnc) THEN         IF (useMNC .AND. diag_mnc) THEN
165           misValLoc = undef           misValLoc = undefRL
166           IF ( misvalFlt(listId).NE.UNSET_RL )           IF ( misvalFlt(listId).NE.UNSET_RL )
167       &        misValLoc = misvalFlt(listId)       &        misValLoc = misvalFlt(listId)
168           CALL DIAGNOSTICS_MNC_SET(           CALL DIAGNOSTICS_MNC_SET(
# Line 266  C-        diagnostics is not empty : Line 267  C-        diagnostics is not empty :
267                ENDIF                ENDIF
268              ENDIF              ENDIF
269    
270              IF ( fflags(listId)(2:2).NE.' ' ) THEN              IF ( fflags(listId)(2:2).EQ.' ' ) THEN
271  C-       get all the levels (for vertical post-processing)  C-       get only selected levels:
272                DO bj = myByLo(myThid), myByHi(myThid)                DO bj = myByLo(myThid), myByHi(myThid)
273                 DO bi = myBxLo(myThid), myBxHi(myThid)                 DO bi = myBxLo(myThid), myBxHi(myThid)
274                  DO k = 1,kdiag(ndId)                  DO k = 1,nlevels(listId)
275                    tmpLev = k                    kLev = NINT(levs(k,listId))
276                    CALL GETDIAG(                    CALL DIAGNOSTICS_GET_DIAG(
277       I                         tmpLev,undef,       I                         kLev, undefRL,
278       O                         qtmp1(1-OLx,1-OLy,k,bi,bj),       O                         qtmp1(1-OLx,1-OLy,k,bi,bj),
279       I                         ndId,mate,ip,im,bi,bj,myThid)       I                         ndId,mate,ip,im,bi,bj,myThid)
280                  ENDDO                  ENDDO
281                 ENDDO                 ENDDO
282                ENDDO                ENDDO
283              ELSE              ELSE
284  C-       get only selected levels:  C-       get all the levels (for vertical post-processing)
285                DO bj = myByLo(myThid), myByHi(myThid)                DO bj = myByLo(myThid), myByHi(myThid)
286                 DO bi = myBxLo(myThid), myBxHi(myThid)                 DO bi = myBxLo(myThid), myBxHi(myThid)
287                  DO k = 1,nlevels(listId)                    CALL DIAGNOSTICS_GET_DIAG(
288                    CALL GETDIAG(       I                         0, undefRL,
289       I                         levs(k,listId),undef,       O                         qtmp1(1-OLx,1-OLy,1,bi,bj),
      O                         qtmp1(1-OLx,1-OLy,k,bi,bj),  
290       I                         ndId,mate,ip,im,bi,bj,myThid)       I                         ndId,mate,ip,im,bi,bj,myThid)
                 ENDDO  
291                 ENDDO                 ENDDO
292                ENDDO                ENDDO
293              ENDIF              ENDIF
# Line 302  C-          Do vertical interpolation: Line 301  C-          Do vertical interpolation:
301  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);
302                CALL DIAGNOSTICS_INTERP_VERT(                CALL DIAGNOSTICS_INTERP_VERT(
303       I                         listId, md, ndId, ip, im, lm,       I                         listId, md, ndId, ip, im, lm,
304       U                         qtmp1,       U                         qtmp1, qtmp2,
305       I                         undef, myTime, myIter, myThid )       I                         undefRL, myTime, myIter, myThid )
306               ELSE               ELSE
307                 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',                 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
308       &           'INTERP_VERT not allowed in this config'       &           'INTERP_VERT not allowed in this config'
# Line 316  C-          Integrate vertically: for no Line 315  C-          Integrate vertically: for no
315                CALL DIAGNOSTICS_SUM_LEVELS(                CALL DIAGNOSTICS_SUM_LEVELS(
316       I                         listId, md, ndId, ip, im, lm,       I                         listId, md, ndId, ip, im, lm,
317       U                         qtmp1,       U                         qtmp1,
318       I                         undef, myTime, myIter, myThid )       I                         undefRL, myTime, myIter, myThid )
319              ENDIF              ENDIF
320    
321  C--     End of empty diag / not-empty diag block  C--     End of empty diag / not-empty diag block
Legend:
Removed from v.1.51  
changed lines
  Added in v.1.52
  ViewVC Help
Powered by ViewVC 1.1.22