pkg/diagnostics/diagstats_ini_io.F

3e5de6a370 Jean*0001 #include "DIAG_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: DIAGSTATS_INI_IO
                0005 C     !INTERFACE:
                0006       SUBROUTINE DIAGSTATS_INI_IO( myThid )
                0007
                0008 C     !DESCRIPTION: \bv
                0009 C     *==================================================================
                0010 C     | S/R DIAGSTATS_INI_IO
                0011 C     | o set I/O unit for ASCII output file
                0012 C     *==================================================================
                0013 C     \ev
                0014
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017
                0018 C     == Global variables ===
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "DIAGNOSTICS_SIZE.h"
                0023 #include "DIAGNOSTICS.h"
                0024
                0025 C     !INPUT/OUTPUT PARAMETERS:
df5a9764ba Jean*0026 C     myThid   :: my Thread Id number
3e5de6a370 Jean*0027       INTEGER myThid
df5a9764ba Jean*0028
                0029 C     !FUNCTIONS:
                0030       INTEGER  ILNBLNK
                0031       EXTERNAL ILNBLNK
3e5de6a370 Jean*0032
                0033 C     !LOCAL VARIABLES:
                0034       INTEGER m, n, j, iL, nUnit
df5a9764ba Jean*0035       CHARACTER*(10) suff
3e5de6a370 Jean*0036       CHARACTER*(MAX_LEN_FNAM) dataFName
f8852da817 Jean*0037       CHARACTER*(MAX_LEN_MBUF) msgBuf, tmpBuf
df5a9764ba Jean*0038 CEOP
3e5de6a370 Jean*0039
                0040       _BEGIN_MASTER( myThid)
                0041
df5a9764ba Jean*0042       IF ( diagSt_Ascii .AND. myProcId.EQ.0 ) THEN
3e5de6a370 Jean*0043
                0044         DO n=1,diagSt_nbLists
                0045
                0046 C-      get a free unit number as the I/O channel for this routine
                0047           CALL MDSFINDUNIT( nUnit, myThid )
                0048           diagSt_ioUnit(n) = nUnit
                0049
df5a9764ba Jean*0050 C-      set file name
                0051           IF ( rwSuffixType.EQ.0 ) THEN
                0052             WRITE(suff,'(I10.10)') nIter0
                0053           ELSE
                0054             CALL RW_GET_SUFFIX( suff, startTime, nIter0, myThid )
                0055           ENDIF
3e5de6a370 Jean*0056           iL = ILNBLNK(diagSt_Fname(n))
df5a9764ba Jean*0057           WRITE(dataFName,'(4A)')
                0058      &          diagSt_Fname(n)(1:iL), '.', suff, '.txt'
                0059
                0060 C-      open file with corresponding file unit
3e5de6a370 Jean*0061           OPEN( nUnit, FILE=dataFName, STATUS='unknown' )
                0062
e129400813 Jean*0063           WRITE(msgBuf,'(4A,I6)') 'DIAGSTATS_INI_IO: ',
3e5de6a370 Jean*0064      &         'open file: ',dataFName(1:iL+15), ' , unit=', nUnit
                0065           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
df5a9764ba Jean*0066      &                        SQUEEZE_RIGHT, myThid )
3e5de6a370 Jean*0067
                0068 C-      write a kind of header:
                0069           WRITE(nUnit,'(2A)')      '# header of file: ',
                0070      &                               diagSt_Fname(n)(1:iL)
                0071           WRITE(nUnit,'(A,F17.6)') '# frequency (s): ', diagSt_freq(n)
                0072           WRITE(nUnit,'(A,F17.6)') '# phase (s)    : ', diagSt_phase(n)
                0073           WRITE(msgBuf,'(A)')      '# Regions      : '
                0074           iL = 17
                0075           DO j=0,nRegions
                0076             IF (diagSt_region(j,n).GE.1 .AND.iL+3.LE.MAX_LEN_MBUF) THEN
f8852da817 Jean*0077               tmpBuf(1:iL) = msgBuf(1:iL)
e129400813 Jean*0078               WRITE(msgBuf,'(A,I3)') tmpBuf(1:iL),j
3e5de6a370 Jean*0079               iL = iL+3
                0080             ENDIF
                0081           ENDDO
4f0cc344de Jean*0082           WRITE(nUnit,'(A)') msgBuf(1:iL)
3e5de6a370 Jean*0083           DO j=1,diagSt_nbFlds(n),10
e129400813 Jean*0084             WRITE(nUnit,'(A,20A)')      '# Fields       :',
3e5de6a370 Jean*0085      &        (' ', diagSt_Flds(m,n), m=j,MIN(diagSt_nbFlds(n),j+9) )
                0086           ENDDO
4f0cc344de Jean*0087           DO j=1,diagSt_nbFlds(n),50
e129400813 Jean*0088             WRITE(nUnit,'(A,50I4)')   '# Nb of levels : ',
4f0cc344de Jean*0089      &         ( kdiag(jSdiag(m,n)), m=j,MIN(diagSt_nbFlds(n),j+49) )
                0090           ENDDO
3e5de6a370 Jean*0091           WRITE(nUnit,'(2A)') '# end of header ----------------------',
                0092      &                        '--------------------------------------'
                0093           WRITE(nUnit,'(A)') ' '
                0094
                0095         ENDDO
e129400813 Jean*0096
3e5de6a370 Jean*0097       ENDIF
                0098
                0099       _END_MASTER( myThid )
                0100
                0101       RETURN
                0102       END