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

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

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

revision 1.2 by jmc, Tue Dec 14 03:48:23 2004 UTC revision 1.7 by edhill, Mon May 2 21:24:12 2005 UTC
# Line 12  C     !INTERFACE: Line 12  C     !INTERFACE:
12    
13  C     !DESCRIPTION:  C     !DESCRIPTION:
14  C     Read Diagnostics Namelists to specify output sequence.  C     Read Diagnostics Namelists to specify output sequence.
15          
16  C     !USES:  C     !USES:
17        IMPLICIT NONE        IMPLICIT NONE
18  #include "SIZE.h"  #include "SIZE.h"
# Line 40  C     filename  :: List Output Filename Line 40  C     filename  :: List Output Filename
40        INTEGER     frequency(ldimLoc)        INTEGER     frequency(ldimLoc)
41        _RL         levels(kdimLoc,ldimLoc)        _RL         levels(kdimLoc,ldimLoc)
42        CHARACTER*8 fields(fdimLoc,ldimLoc)        CHARACTER*8 fields(fdimLoc,ldimLoc)
43        CHARACTER*8 filename(ldimLoc)        CHARACTER*80 filename(ldimLoc), blkFilName
44          CHARACTER*8 fileflags(ldimLoc)
45        CHARACTER*8 blk8c        CHARACTER*8 blk8c
46        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
47        INTEGER ku, stdUnit        INTEGER ku, stdUnit
48        INTEGER k,l,n,m        INTEGER k,l,n,m,iL
49        _RL undef, getcon        _RL undef, getcon
50          INTEGER  ILNBLNK
51          EXTERNAL ILNBLNK
52    
53        NAMELIST / diagnostics_list /        NAMELIST / diagnostics_list /
54       &     frequency, levels, fields, filename,       &     frequency, levels, fields, filename, fileflags,
55       &     diag_mnc       &     diag_mnc,
56         &     diag_pickup_read,     diag_pickup_write,
57         &     diag_pickup_read_mnc, diag_pickup_write_mnc
58    
59  C     Initialize and Read Diagnostics Namelist  C     Initialize and Read Diagnostics Namelist
60        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
61    
62        undef = getcon('UNDEF')        undef = getcon('UNDEF')
63        blk8c  = '        '        blk8c  = '        '
64          DO k=1,LEN(blkFilName)
65            blkFilName(k:k) = ' '
66          ENDDO
67    
68        DO l = 1,ldimLoc        DO l = 1,ldimLoc
69          frequency(l) = 0          frequency(l) = 0
70            filename (l) = blkFilName
71    C       eight spaces:        12345678
72            fileflags(l)(1:8) = '        '
73          DO k = 1,kdimLoc          DO k = 1,kdimLoc
74            levels (k,l) = undef            levels (k,l) = undef
75          ENDDO          ENDDO
# Line 66  C     Initialize and Read Diagnostics Na Line 77  C     Initialize and Read Diagnostics Na
77            fields (m,l) = blk8c            fields (m,l) = blk8c
78          ENDDO          ENDDO
79        ENDDO        ENDDO
80        diag_mnc   = .FALSE.        diag_mnc = useMNC
81          diag_pickup_read      = .FALSE.
82          diag_pickup_write     = .FALSE.
83          diag_pickup_read_mnc  = .FALSE.
84          diag_pickup_write_mnc = .FALSE.
85    
86        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
87       &     ' DIAGNOSTICS_READPARMS: opening data.diagnostics'       &     ' DIAGNOSTICS_READPARMS: opening data.diagnostics'
88        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)
89          
90        CALL OPEN_COPY_DATA_FILE('data.diagnostics',        CALL OPEN_COPY_DATA_FILE('data.diagnostics',
91       &     'DIAGNOSTICS_READPARMS', ku, myThid )       &     'DIAGNOSTICS_READPARMS', ku, myThid )
92        READ  (ku,NML=diagnostics_list)        READ  (ku,NML=diagnostics_list)
93        CLOSE (ku)        CLOSE (ku)
# Line 83  C     Initialise diag_choices common blo Line 98  C     Initialise diag_choices common blo
98          freq(n) = 0          freq(n) = 0
99          nlevels(n) = 0          nlevels(n) = 0
100          nfields(n) = 0          nfields(n) = 0
101          fnames(n) = blk8c          fnames(n) = blkFilName
102          DO k = 1,numLevels          DO k = 1,numLevels
103            levs(k,n) = 0            levs(k,n) = 0
104          ENDDO          ENDDO
105          DO m = 1,numperlist          DO m = 1,numperlist
106            flds(m,n) = '        '            flds(m,n) = blk8c
107            jdiag(m,n) = 0            jdiag(m,n) = 0
108          ENDDO          ENDDO
109        ENDDO        ENDDO
       diag_mdsio = .TRUE.  
110    
111  C     Fill Diagnostics Common Block with Namelist Info  C     Fill Diagnostics Common Block with Namelist Info
112        IF ( useMNC .AND. diag_mnc        diag_mnc = diag_mnc .AND. useMNC
113       &            .AND. (.NOT. outputTypesInclusive)) THEN        diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive
114          diag_mdsio = .FALSE.        diag_pickup_read_mnc  = diag_pickup_read_mnc .AND. diag_mnc
115        ENDIF        diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc
116                diag_pickup_read_mdsio  =
117         &     diag_pickup_read .AND. (.NOT. diag_pickup_read_mnc)
118          diag_pickup_write_mdsio = diag_pickup_write .AND.
119         &     ((.NOT. diag_pickup_write_mnc) .OR. outputTypesInclusive)
120    
121        DO l = 1,ldimLoc        DO l = 1,ldimLoc
122           iL = ILNBLNK(filename(l))
123           IF ( frequency(l).NE.0 .AND. iL.EQ.0 ) THEN
124             WRITE(msgBuf,'(2A,I3,A,I6)') 'DIAGNOSTICS_READPARMS: ',
125         &    'Empty File-name ! (list l=', l, ' ), freq:',frequency(l)
126             CALL PRINT_ERROR( msgBuf , myThid )
127             STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
128           ENDIF
129         IF ( frequency(l).NE.0 .AND. nlists.LT.numlists ) THEN         IF ( frequency(l).NE.0 .AND. nlists.LT.numlists ) THEN
130           n = nlists + 1           n = nlists + 1
131           freq(n)    = frequency(l)           freq(n)    = frequency(l)
132           fnames(n)  = filename (l)           fnames(n)  = filename (l)
133             fflags(n)  = fileflags(l)
134           nlevels(n) = 0           nlevels(n) = 0
135           IF ( levels(1,l).NE.undef ) THEN           IF ( levels(1,l).NE.undef ) THEN
136             DO k=1,kdimLoc             DO k=1,kdimLoc
137               IF ( levels(k,l).NE.undef .AND.               IF ( levels(k,l).NE.undef .AND.
138       &            nlevels(n).LT.numLevels ) THEN       &            nlevels(n).LT.numLevels ) THEN
139                 nlevels(n) = nlevels(n) + 1                 nlevels(n) = nlevels(n) + 1
140                 levs(nlevels(n),n) = levels(k,l)                 levs(nlevels(n),n) = levels(k,l)
# Line 117  C     Fill Diagnostics Common Block with Line 143  C     Fill Diagnostics Common Block with
143       &         'Exceed Max.Num. of Levels numLevels=', numLevels       &         'Exceed Max.Num. of Levels numLevels=', numLevels
144                CALL PRINT_ERROR( msgBuf , myThid )                CALL PRINT_ERROR( msgBuf , myThid )
145                WRITE(msgBuf,'(2A,I3,A,F3.0)') 'DIAGNOSTICS_READPARMS: ',                WRITE(msgBuf,'(2A,I3,A,F3.0)') 'DIAGNOSTICS_READPARMS: ',
146       &         'when trying to add level(k=', k, ' )=', levels(k,l)       &         'when trying to add level(k=', k, ' )=', levels(k,l)
147                CALL PRINT_ERROR( msgBuf , myThid )                CALL PRINT_ERROR( msgBuf , myThid )
148                WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',                WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
149       &         ' for list l=', l, ', filename: ', filename(l)       &         ' for list l=', l, ', filename: ', filename(l)
# Line 126  C     Fill Diagnostics Common Block with Line 152  C     Fill Diagnostics Common Block with
152               ENDIF               ENDIF
153             ENDDO             ENDDO
154           ELSE           ELSE
155             nlevels(n) = Nr  C-       will set levels later, once the Nb of levels of each diag is known
156             DO k=1,nlevels(n)             nlevels(n) = -1
              levs(k,n) = k  
            ENDDO  
157           ENDIF           ENDIF
158           nfields(n) = 0           nfields(n) = 0
159           DO m=1,fdimLoc           DO m=1,fdimLoc
160             IF ( fields(m,l).NE.blk8c .AND.             IF ( fields(m,l).NE.blk8c .AND.
161       &          nfields(n).LT.numperlist ) THEN       &          nfields(n).LT.numperlist ) THEN
162               nfields(n) = nfields(n) + 1               nfields(n) = nfields(n) + 1
163               flds(nfields(n),n) = fields(m,l)               flds(nfields(n),n) = fields(m,l)
# Line 183  C     Echo History List Data Structure Line 207  C     Echo History List Data Structure
207          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
208          WRITE(msgBuf,*) 'Frequency: ',freq(n)          WRITE(msgBuf,*) 'Frequency: ',freq(n)
209          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
210          DO l=1,nlevels(n),20          IF ( nlevels(n).EQ.-1 ) THEN
211              WRITE(msgBuf,'(A,A)') ' Levels:    ','will be set later'
212              CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
213            ELSE
214             DO l=1,nlevels(n),20
215            m = MIN(nlevels(n),l+19)            m = MIN(nlevels(n),l+19)
216            WRITE(msgBuf,'(A,20F5.0)') ' Levels:    ', (levs(k,n),k=l,m)            WRITE(msgBuf,'(A,20F5.0)') ' Levels:    ', (levs(k,n),k=l,m)
217            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
218          ENDDO           ENDDO
219            ENDIF
220          WRITE(msgBuf,*) 'Fields:   ',(' ',flds(l,n),l=1,nfields(n))          WRITE(msgBuf,*) 'Fields:   ',(' ',flds(l,n),l=1,nfields(n))
221          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
222        ENDDO        ENDDO
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22