/[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.46 by jmc, Fri Jan 8 19:19:44 2010 UTC revision 1.47 by jmc, Mon Jan 11 19:42:32 2010 UTC
# Line 8  CBOP 0 Line 8  CBOP 0
8  C     !ROUTINE: DIAGNOSTICS_OUT  C     !ROUTINE: DIAGNOSTICS_OUT
9    
10  C     !INTERFACE:  C     !INTERFACE:
11        SUBROUTINE  DIAGNOSTICS_OUT(        SUBROUTINE DIAGNOSTICS_OUT(
12       I     listId,       I     listId,
13       I     myIter,       I     myIter,
14       I     myTime,       I     myTime,
# Line 48  C     !FUNCTIONS: Line 48  C     !FUNCTIONS:
48    
49  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
50  C     i,j,k :: loop indices  C     i,j,k :: loop indices
51    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)
55  C     mate  :: counter mate Id number (in available diagnostics list)  C     mate  :: counter mate Id number (in available diagnostics list)
56  C     ip    :: diagnostics  pointer to storage array  C     ip    :: diagnostics  pointer to storage array
57  C     im    :: counter-mate pointer to storage array  C     im    :: counter-mate pointer to storage array
58    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 :: thread-shared temporary array (needs to be in common block):
# Line 70  C              diagnostic storage qdiag Line 72  C              diagnostic storage qdiag
72        _RL undef        _RL undef
73        _RL tmpLev        _RL tmpLev
74        INTEGER ilen        INTEGER ilen
75          INTEGER nLevOutp
76    
77        INTEGER ioUnit        INTEGER ioUnit
78        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
# Line 114  c     IF ( useFIZHI ) undef = getcon('UN Line 117  c     IF ( useFIZHI ) undef = getcon('UN
117        WRITE(suff,'(I10.10)') myIter        WRITE(suff,'(I10.10)') myIter
118        ilen = ILNBLNK(fnames(listId))        ilen = ILNBLNK(fnames(listId))
119        WRITE( fn, '(A,A,A)' ) fnames(listId)(1:ilen),'.',suff(1:10)        WRITE( fn, '(A,A,A)' ) fnames(listId)(1:ilen),'.',suff(1:10)
120    C-    for now, if integrate vertically, output field has just 1 level:
121          nLevOutp = nlevels(listId)
122          IF ( fflags(listId)(2:2).EQ.'I' ) nLevOutp = 1
123    
124  C--   Set time information:  C--   Set time information:
125        IF ( freq(listId).LT.0. ) THEN        IF ( freq(listId).LT.0. ) THEN
# Line 211  C       variable that has dimension (2,T Line 217  C       variable that has dimension (2,T
217  C       beginning and ending times for each diagnostics period  C       beginning and ending times for each diagnostics period
218    
219           dn(1)(1:NLEN) = dn_blnk(1:NLEN)           dn(1)(1:NLEN) = dn_blnk(1:NLEN)
220           WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId)           WRITE(dn(1),'(a,i6.6)') 'Zmd', nLevOutp
221           dim(1) = nlevels(listId)           dim(1) = nLevOutp
222           ib(1)  = 1           ib(1)  = 1
223           ie(1)  = nlevels(listId)           ie(1)  = nLevOutp
224    
225           CALL MNC_CW_ADD_GNAME('diag_levels', 1,           CALL MNC_CW_ADD_GNAME('diag_levels', 1,
226       &        dim, dn, ib, ie, myThid)       &        dim, dn, ib, ie, myThid)
# Line 359  C-        Empty diagnostics case : Line 365  C-        Empty diagnostics case :
365              _END_MASTER( myThid )              _END_MASTER( myThid )
366              DO bj = myByLo(myThid), myByHi(myThid)              DO bj = myByLo(myThid), myByHi(myThid)
367                DO bi = myBxLo(myThid), myBxHi(myThid)                DO bi = myBxLo(myThid), myBxHi(myThid)
368                  DO k = 1,nlevels(listId)                  DO k = 1,nLevOutp
369                    DO j = 1-OLy,sNy+OLy                    DO j = 1-OLy,sNy+OLy
370                      DO i = 1-OLx,sNx+OLx                      DO i = 1-OLx,sNx+OLx
371                        qtmp1(i,j,k,bi,bj) = 0. _d 0                        qtmp1(i,j,k,bi,bj) = 0. _d 0
# Line 395  C-        diagnostics is not empty : Line 401  C-        diagnostics is not empty :
401                ENDIF                ENDIF
402              ENDIF              ENDIF
403    
404              IF ( fflags(listId)(2:2).EQ.'P' ) THEN              IF ( fflags(listId)(2:2).NE.' ' ) THEN
405  C-       get all the levels (for vertical interpolation)  C-       get all the levels (for vertical post-processing)
406                DO bj = myByLo(myThid), myByHi(myThid)                DO bj = myByLo(myThid), myByHi(myThid)
407                 DO bi = myBxLo(myThid), myBxHi(myThid)                 DO bi = myBxLo(myThid), myBxHi(myThid)
408                  DO k = 1,kdiag(ndId)                  DO k = 1,kdiag(ndId)
# Line 422  C-       get only selected levels: Line 428  C-       get only selected levels:
428                ENDDO                ENDDO
429              ENDIF              ENDIF
430    
 C-        end of empty diag / not empty block  
           ENDIF  
   
431  C-----------------------------------------------------------------------  C-----------------------------------------------------------------------
432  C         Check to see if we need to interpolate before output  C--     Apply specific post-processing (e.g., interpolate) before output
433  C-----------------------------------------------------------------------  C-----------------------------------------------------------------------
434            IF ( fflags(listId)(2:2).EQ.'P' ) THEN              IF ( fflags(listId)(2:2).EQ.'P' ) THEN
435  C-        Do vertical interpolation:  C-          Do vertical interpolation:
436             IF ( fluidIsAir ) THEN               IF ( fluidIsAir ) THEN
437  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);
438              CALL DIAGNOSTICS_INTERP_VERT(                CALL DIAGNOSTICS_INTERP_VERT(
439       I                     listId, md, ndId, ip, im, lm,       I                         listId, md, ndId, ip, im, lm,
440       U                     qtmp1,       U                         qtmp1,
441       I                     undef, myTime, myIter, myThid )       I                         undef, myTime, myIter, myThid )
442             ELSE               ELSE
443               WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',                 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
444       &         'INTERP_VERT not allowed in this config'       &           'INTERP_VERT not allowed in this config'
445               CALL PRINT_ERROR( msgBuf , myThid )                 CALL PRINT_ERROR( msgBuf , myThid )
446               STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'                 STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'
447             ENDIF               ENDIF
448                ENDIF
449                IF ( fflags(listId)(2:2).EQ.'I' ) THEN
450    C-          Integrate vertically: for now, output field has just 1 level:
451                  CALL DIAGNOSTICS_SUM_LEVELS(
452         I                         listId, md, ndId, ip, im, lm,
453         U                         qtmp1,
454         I                         undef, myTime, myIter, myThid )
455                ENDIF
456    
457    C--     End of empty diag / not-empty diag block
458            ENDIF            ENDIF
459    
460  C--    Ready to write field "md", element "lm" in averageCycle(listId)  C--     Ready to write field "md", element "lm" in averageCycle(listId)
461    
462  C-        write to binary file, using MDSIO pkg:  C-        write to binary file, using MDSIO pkg:
463            IF ( diag_mdsio ) THEN            IF ( diag_mdsio ) THEN
# Line 457  C           fFlag(1)=R(or D): force it t Line 470  C           fFlag(1)=R(or D): force it t
470  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
471              CALL WRITE_REC_LEV_RL(              CALL WRITE_REC_LEV_RL(
472       I                            fn, prec,       I                            fn, prec,
473       I                            NrMax, 1, nlevels(listId),       I                            NrMax, 1, nLevOutp,
474       I                            qtmp1, -nRec, myIter, myThid )       I                            qtmp1, -nRec, myIter, myThid )
475            ENDIF            ENDIF
476    
# Line 508  C           XY dimensions Line 521  C           XY dimensions
521              ENDIF              ENDIF
522    
523  C           Z is special since it varies  C           Z is special since it varies
524              WRITE(dn(3),'(a,i6.6)') 'Zd', nlevels(listId)              WRITE(dn(3),'(a,i6.6)') 'Zd', nLevOutp
525              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
526       &           .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN
527                WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevels(listId)                WRITE(dn(3),'(a,i6.6)') 'Zmd', nLevOutp
528              ENDIF              ENDIF
529              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
530       &           .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN
531                WRITE(dn(3),'(a,i6.6)') 'Zld', nlevels(listId)                WRITE(dn(3),'(a,i6.6)') 'Zld', nLevOutp
532              ENDIF              ENDIF
533              IF ( (gdiag(ndId)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
534       &           .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN
535                WRITE(dn(3),'(a,i6.6)') 'Zud', nlevels(listId)                WRITE(dn(3),'(a,i6.6)') 'Zud', nLevOutp
536              ENDIF              ENDIF
537              dim(3) = NrMax              dim(3) = NrMax
538              ib(3)  = 1              ib(3)  = 1
539              ie(3)  = nlevels(listId)              ie(3)  = nLevOutp
540    
541  C           Time dimension  C           Time dimension
542              dn(4)(1:1) = 'T'              dn(4)(1:1) = 'T'
# Line 549  C     assign missing values and set flag Line 562  C     assign missing values and set flag
562       I            misval_r8, misval_r4, misval_int,       I            misval_r8, misval_r4, misval_int,
563       I            myThid )       I            myThid )
564  C     and now use the missing values for masking out the land points  C     and now use the missing values for masking out the land points
565    C     note: better to use 2-D mask if kdiag <> Nr or vert.integral
566               DO bj = myByLo(myThid), myByHi(myThid)               DO bj = myByLo(myThid), myByHi(myThid)
567                DO bi = myBxLo(myThid), myBxHi(myThid)                DO bi = myBxLo(myThid), myBxHi(myThid)
568                 DO k = 1,nlevels(listId)                 DO k = 1,nLevOutp
569                  klev = NINT(levs(k,listId))                  klev = NINT(levs(k,listId))
570                    IF ( fflags(listId)(2:2).EQ.'I' ) kLev = 1
571                  DO j = 1-OLy,sNy+OLy                  DO j = 1-OLy,sNy+OLy
572                   DO i = 1-OLx,sNx+OLx                   DO i = 1-OLx,sNx+OLx
573                    IF ( maskC(i,j,klev,bi,bj) .EQ. 0. )                    IF ( maskC(i,j,klev,bi,bj) .EQ. 0. )
# Line 612  C     meta files but with more informati Line 627  C     meta files but with more informati
627              glf = globalFiles              glf = globalFiles
628              nRec = nfields(listId)*averageCycle(listId)              nRec = nfields(listId)*averageCycle(listId)
629              CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE.,              CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE.,
630       &              0, 0, nlevels(listId), ' ',       &              0, 0, nLevOutp, ' ',
631       &              nfields(listId), flds(1,listId), nTimRec, timeRec,       &              nfields(listId), flds(1,listId), nTimRec, timeRec,
632       &              nRec, myIter, myThid)       &              nRec, myIter, myThid)
633        ENDIF        ENDIF
Legend:
Removed from v.1.46  
changed lines
  Added in v.1.47
  ViewVC Help
Powered by ViewVC 1.1.22