pkg/diagnostics/diagstats_ascii_out.F

3e5de6a370 Jean*0001 #include "DIAG_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP 0
                0005 C     !ROUTINE: DIAGSTATS_ASCII_OUT
                0006
                0007 C     !INTERFACE:
                0008       SUBROUTINE DIAGSTATS_ASCII_OUT(
                0009      I                    statGlob, nLev, ndId,
                0010      I                    mId, listId, myIter, myThid )
                0011
                0012 C     !DESCRIPTION:
                0013 C     Write Global statistic to ASCII file
                0014
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017 #include "SIZE.h"
                0018 #include "EEPARAMS.h"
                0019 #include "DIAGNOSTICS_SIZE.h"
                0020 #include "DIAGNOSTICS.h"
                0021
                0022 C     !INPUT PARAMETERS:
                0023 C     statGlob ..... AVERAGED DIAGNOSTIC QUANTITY
                0024 C     nLev   ....  2nd Dimension (max Nb of levels) of statGlob array
                0025 C     ndId     ... diagnostic Id number (in diagnostics long list)
                0026 C     mId    ..... field rank in list "listId"
                0027 C     listId ..... current output Stream list
                0028 C     myIter ..... current Iteration Number
                0029 C     myThid ..... my thread Id number
                0030       INTEGER nLev
                0031       _RL statGlob(0:nStats,0:nLev,0:nRegions)
                0032       INTEGER ndId, mId, listId
                0033       INTEGER myIter, myThid
                0034 CEOP
                0035
                0036 C     !LOCAL VARIABLES:
                0037       INTEGER im, ix, iv
                0038       PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )
af7069187d Jean*0039       INTEGER i, j, k, kLev, nUnit
3e5de6a370 Jean*0040
                0041 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0042
                0043       _BEGIN_MASTER( myThid)
                0044
40a14a021a Jean*0045       IF ( diagSt_Ascii .AND. myProcId.EQ.0 ) THEN
3e5de6a370 Jean*0046
                0047        nUnit = diagSt_ioUnit(listId)
af7069187d Jean*0048        kLev = kdiag(ndId)
3e5de6a370 Jean*0049 C-     single level field: Vertical Integral (k=0) & 1rst level are identical
                0050 C      => write only 1 of the 2:
af7069187d Jean*0051        IF ( kLev.EQ.1 ) kLev = 0
                0052        kLev = MIN( kLev, nLev )
3e5de6a370 Jean*0053 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0054        DO j=0,nRegions
                0055         IF ( diagSt_region(j,listId).GE.1 ) THEN
                0056          WRITE(nUnit,'(3A,I10,2(A,I4))') ' field : ', cdiag(ndId),
577d55f22e Jean*0057      &    ' ; Iter =',myIter,' ; region #',j, ' ; nb.Lev =',kdiag(ndId)
3e5de6a370 Jean*0058 c        WRITE(nUnit,'(5A)')       ' k |',
                0059 c    &             ' --   Average  --  |', ' --   Std.Dev   -- |',
e129400813 Jean*0060 c    &             ' --      min   --  |', ' --      max    -- |'
1106e46d18 Jean*0061 c        WRITE(nUnit,'(6A)')     ' k |',
                0062 c    &             ' --  Average  -- |', ' --  Std.Dev  -- |',
                0063 c    &             ' --    min    -- |', ' --    max    -- |',' --  Vol'
                0064          WRITE(nUnit,'(6A)') ' k |',
                0065      &     ' --   Average    -- |', ' --   Std.Dev    -- |',
                0066      &     ' --     min      -- |', ' --     max      -- |',' --    Vol'
af7069187d Jean*0067          DO k=0,kLev
3e5de6a370 Jean*0068 C     full precision, do not write the volume:
                0069 c         WRITE(nUnit,'(I3,1P4E20.12)') k,(statGlob(i,k,j),i=1,nStats)
                0070 C     reduced precision + write the volume (usefull for testing):
1106e46d18 Jean*0071 c         WRITE(nUnit,'(I3,1P5E18.10)')
                0072 c    &       k, (statGlob(i,k,j),i=1,nStats), statGlob(0,k,j)
                0073 C     full precision + write the volume:
                0074           WRITE(nUnit,'(I3,1P5E21.13)')
3e5de6a370 Jean*0075      &       k, (statGlob(i,k,j),i=1,nStats), statGlob(0,k,j)
                0076          ENDDO
                0077         ENDIF
                0078        ENDDO
                0079        WRITE(nUnit,'(A)') ' '
                0080 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0081       ENDIF
                0082
                0083       _END_MASTER( myThid )
                0084
                0085       RETURN
                0086       END