/[MITgcm]/MITgcm/pkg/diagnostics/diagstats_ini_io.F
ViewVC logotype

Diff of /MITgcm/pkg/diagnostics/diagstats_ini_io.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.3 by jmc, Tue Feb 21 01:23:57 2006 UTC revision 1.5 by jmc, Fri Mar 24 23:34:13 2017 UTC
# Line 21  C     !USES: Line 21  C     !USES:
21  C     == Global variables ===  C     == Global variables ===
22  #include "SIZE.h"  #include "SIZE.h"
23  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
24  #include "PARAMS.h"  #include "PARAMS.h"
25  #include "DIAGNOSTICS_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
26  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
27    
28  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
29  C     == Routine arguments ==  C     myThid   :: my Thread Id number
 C     myThid - Thread number for this instance of the routine.  
30        INTEGER myThid        INTEGER myThid
31  CEOP  
32    C     !FUNCTIONS:
33          INTEGER  ILNBLNK
34          EXTERNAL ILNBLNK
35    
36  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
 C     == Local variables ==  
37        INTEGER m, n, j, iL, nUnit        INTEGER m, n, j, iL, nUnit
38          CHARACTER*(10) suff
39        CHARACTER*(MAX_LEN_FNAM) dataFName        CHARACTER*(MAX_LEN_FNAM) dataFName
40        CHARACTER*(MAX_LEN_MBUF) msgBuf, tmpBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf, tmpBuf
41        INTEGER  ILNBLNK  CEOP
       EXTERNAL ILNBLNK  
42    
43        _BEGIN_MASTER( myThid)        _BEGIN_MASTER( myThid)
44    
45  #ifdef ALLOW_USE_MPI        IF ( diagSt_Ascii .AND. myProcId.EQ.0 ) THEN
       IF ( diagSt_Ascii .AND. mpiMyId.EQ.0 ) THEN  
 #else  
       IF ( diagSt_Ascii ) THEN  
 #endif  
46    
47          DO n=1,diagSt_nbLists          DO n=1,diagSt_nbLists
48    
# Line 54  C-      get a free unit number as the I/ Line 50  C-      get a free unit number as the I/
50            CALL MDSFINDUNIT( nUnit, myThid )            CALL MDSFINDUNIT( nUnit, myThid )
51            diagSt_ioUnit(n) = nUnit            diagSt_ioUnit(n) = nUnit
52    
53    C-      set file name
54              IF ( rwSuffixType.EQ.0 ) THEN
55                WRITE(suff,'(I10.10)') nIter0
56              ELSE
57                CALL RW_GET_SUFFIX( suff, startTime, nIter0, myThid )
58              ENDIF
59            iL = ILNBLNK(diagSt_Fname(n))            iL = ILNBLNK(diagSt_Fname(n))
60            WRITE(dataFName,'(2A,I10.10,A)')            WRITE(dataFName,'(4A)')
61       &          diagSt_Fname(n)(1:iL), '.', nIter0, '.txt'       &          diagSt_Fname(n)(1:iL), '.', suff, '.txt'
62    
63    C-      open file with corresponding file unit
64            OPEN( nUnit, FILE=dataFName, STATUS='unknown' )            OPEN( nUnit, FILE=dataFName, STATUS='unknown' )
65    
66            WRITE(msgBuf,'(4A,I6)') 'DIAGSTATS_INI_IO: ',            WRITE(msgBuf,'(4A,I6)') 'DIAGSTATS_INI_IO: ',
67       &         'open file: ',dataFName(1:iL+15), ' , unit=', nUnit       &         'open file: ',dataFName(1:iL+15), ' , unit=', nUnit
68            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
69       &                        SQUEEZE_RIGHT , myThid)       &                        SQUEEZE_RIGHT, myThid )
70    
71  C-      write a kind of header:  C-      write a kind of header:
72            WRITE(nUnit,'(2A)')      '# header of file: ',            WRITE(nUnit,'(2A)')      '# header of file: ',
# Line 74  C-      write a kind of header: Line 78  C-      write a kind of header:
78            DO j=0,nRegions            DO j=0,nRegions
79              IF (diagSt_region(j,n).GE.1 .AND.iL+3.LE.MAX_LEN_MBUF) THEN              IF (diagSt_region(j,n).GE.1 .AND.iL+3.LE.MAX_LEN_MBUF) THEN
80                tmpBuf(1:iL) = msgBuf(1:iL)                tmpBuf(1:iL) = msgBuf(1:iL)
81                WRITE(msgBuf,'(A,I3)') tmpBuf(1:iL),j                            WRITE(msgBuf,'(A,I3)') tmpBuf(1:iL),j
82                iL = iL+3                iL = iL+3
83              ENDIF              ENDIF
84            ENDDO            ENDDO
85            WRITE(nUnit,'(A)') msgBuf(1:iL)            WRITE(nUnit,'(A)') msgBuf(1:iL)
86            DO j=1,diagSt_nbFlds(n),10            DO j=1,diagSt_nbFlds(n),10
87              WRITE(nUnit,'(A,20A)')      '# Fields       :',              WRITE(nUnit,'(A,20A)')      '# Fields       :',
88       &        (' ', diagSt_Flds(m,n), m=j,MIN(diagSt_nbFlds(n),j+9) )       &        (' ', diagSt_Flds(m,n), m=j,MIN(diagSt_nbFlds(n),j+9) )
89            ENDDO            ENDDO
90            DO j=1,diagSt_nbFlds(n),50            DO j=1,diagSt_nbFlds(n),50
91              WRITE(nUnit,'(A,50I4)')   '# Nb of levels : ',              WRITE(nUnit,'(A,50I4)')   '# Nb of levels : ',
92       &         ( kdiag(jSdiag(m,n)), m=j,MIN(diagSt_nbFlds(n),j+49) )       &         ( kdiag(jSdiag(m,n)), m=j,MIN(diagSt_nbFlds(n),j+49) )
93            ENDDO            ENDDO
94            WRITE(nUnit,'(2A)') '# end of header ----------------------',            WRITE(nUnit,'(2A)') '# end of header ----------------------',
# Line 92  C-      write a kind of header: Line 96  C-      write a kind of header:
96            WRITE(nUnit,'(A)') ' '            WRITE(nUnit,'(A)') ' '
97    
98          ENDDO          ENDDO
99          
100        ENDIF        ENDIF
101    
102        _END_MASTER( myThid )        _END_MASTER( myThid )
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22