/[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.6 by jmc, Thu Mar 17 01:22:43 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 blk8c        CHARACTER*8 blk8c
45        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
46        INTEGER ku, stdUnit        INTEGER ku, stdUnit
47        INTEGER k,l,n,m        INTEGER k,l,n,m,iL
48        _RL undef, getcon        _RL undef, getcon
49          INTEGER  ILNBLNK
50          EXTERNAL ILNBLNK
51    
52        NAMELIST / diagnostics_list /        NAMELIST / diagnostics_list /
53       &     frequency, levels, fields, filename,       &     frequency, levels, fields, filename,
54       &     diag_mnc       &     diag_mnc,
55         &     diag_pickup_read,     diag_pickup_write,
56         &     diag_pickup_read_mnc, diag_pickup_write_mnc
57    
58  C     Initialize and Read Diagnostics Namelist  C     Initialize and Read Diagnostics Namelist
59        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
60    
61        undef = getcon('UNDEF')        undef = getcon('UNDEF')
62        blk8c  = '        '        blk8c  = '        '
63          DO k=1,LEN(blkFilName)
64            blkFilName(k:k) = ' '
65          ENDDO
66    
67        DO l = 1,ldimLoc        DO l = 1,ldimLoc
68          frequency(l) = 0          frequency(l) = 0
69            filename (l) = blkFilName
70          DO k = 1,kdimLoc          DO k = 1,kdimLoc
71            levels (k,l) = undef            levels (k,l) = undef
72          ENDDO          ENDDO
# Line 66  C     Initialize and Read Diagnostics Na Line 74  C     Initialize and Read Diagnostics Na
74            fields (m,l) = blk8c            fields (m,l) = blk8c
75          ENDDO          ENDDO
76        ENDDO        ENDDO
77        diag_mnc   = .FALSE.        diag_mnc = useMNC
78          diag_pickup_read      = .FALSE.
79          diag_pickup_write     = .FALSE.
80          diag_pickup_read_mnc  = .FALSE.
81          diag_pickup_write_mnc = .FALSE.
82    
83        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
84       &     ' DIAGNOSTICS_READPARMS: opening data.diagnostics'       &     ' DIAGNOSTICS_READPARMS: opening data.diagnostics'
85        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)
86          
87        CALL OPEN_COPY_DATA_FILE('data.diagnostics',        CALL OPEN_COPY_DATA_FILE('data.diagnostics',
88       &     'DIAGNOSTICS_READPARMS', ku, myThid )       &     'DIAGNOSTICS_READPARMS', ku, myThid )
89        READ  (ku,NML=diagnostics_list)        READ  (ku,NML=diagnostics_list)
90        CLOSE (ku)        CLOSE (ku)
# Line 83  C     Initialise diag_choices common blo Line 95  C     Initialise diag_choices common blo
95          freq(n) = 0          freq(n) = 0
96          nlevels(n) = 0          nlevels(n) = 0
97          nfields(n) = 0          nfields(n) = 0
98          fnames(n) = blk8c          fnames(n) = blkFilName
99          DO k = 1,numLevels          DO k = 1,numLevels
100            levs(k,n) = 0            levs(k,n) = 0
101          ENDDO          ENDDO
102          DO m = 1,numperlist          DO m = 1,numperlist
103            flds(m,n) = '        '            flds(m,n) = blk8c
104            jdiag(m,n) = 0            jdiag(m,n) = 0
105          ENDDO          ENDDO
106        ENDDO        ENDDO
       diag_mdsio = .TRUE.  
107    
108  C     Fill Diagnostics Common Block with Namelist Info  C     Fill Diagnostics Common Block with Namelist Info
109        IF ( useMNC .AND. diag_mnc        diag_mnc = diag_mnc .AND. useMNC
110       &            .AND. (.NOT. outputTypesInclusive)) THEN        diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive
111          diag_mdsio = .FALSE.        diag_pickup_read_mnc  = diag_pickup_read_mnc .AND. diag_mnc
112        ENDIF        diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc
113                diag_pickup_read_mdsio  =
114         &     diag_pickup_read .AND. (.NOT. diag_pickup_read_mnc)
115          diag_pickup_write_mdsio = diag_pickup_write .AND.
116         &     ((.NOT. diag_pickup_write_mnc) .OR. outputTypesInclusive)
117    
118        DO l = 1,ldimLoc        DO l = 1,ldimLoc
119           iL = ILNBLNK(filename(l))
120           IF ( frequency(l).NE.0 .AND. iL.EQ.0 ) THEN
121             WRITE(msgBuf,'(2A,I3,A,I6)') 'DIAGNOSTICS_READPARMS: ',
122         &    'Empty File-name ! (list l=', l, ' ), freq:',frequency(l)
123             CALL PRINT_ERROR( msgBuf , myThid )
124             STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
125           ENDIF
126         IF ( frequency(l).NE.0 .AND. nlists.LT.numlists ) THEN         IF ( frequency(l).NE.0 .AND. nlists.LT.numlists ) THEN
127           n = nlists + 1           n = nlists + 1
128           freq(n)    = frequency(l)           freq(n)    = frequency(l)
# Line 108  C     Fill Diagnostics Common Block with Line 130  C     Fill Diagnostics Common Block with
130           nlevels(n) = 0           nlevels(n) = 0
131           IF ( levels(1,l).NE.undef ) THEN           IF ( levels(1,l).NE.undef ) THEN
132             DO k=1,kdimLoc             DO k=1,kdimLoc
133               IF ( levels(k,l).NE.undef .AND.               IF ( levels(k,l).NE.undef .AND.
134       &            nlevels(n).LT.numLevels ) THEN       &            nlevels(n).LT.numLevels ) THEN
135                 nlevels(n) = nlevels(n) + 1                 nlevels(n) = nlevels(n) + 1
136                 levs(nlevels(n),n) = levels(k,l)                 levs(nlevels(n),n) = levels(k,l)
# Line 117  C     Fill Diagnostics Common Block with Line 139  C     Fill Diagnostics Common Block with
139       &         'Exceed Max.Num. of Levels numLevels=', numLevels       &         'Exceed Max.Num. of Levels numLevels=', numLevels
140                CALL PRINT_ERROR( msgBuf , myThid )                CALL PRINT_ERROR( msgBuf , myThid )
141                WRITE(msgBuf,'(2A,I3,A,F3.0)') 'DIAGNOSTICS_READPARMS: ',                WRITE(msgBuf,'(2A,I3,A,F3.0)') 'DIAGNOSTICS_READPARMS: ',
142       &         'when trying to add level(k=', k, ' )=', levels(k,l)       &         'when trying to add level(k=', k, ' )=', levels(k,l)
143                CALL PRINT_ERROR( msgBuf , myThid )                CALL PRINT_ERROR( msgBuf , myThid )
144                WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',                WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
145       &         ' for list l=', l, ', filename: ', filename(l)       &         ' for list l=', l, ', filename: ', filename(l)
# Line 126  C     Fill Diagnostics Common Block with Line 148  C     Fill Diagnostics Common Block with
148               ENDIF               ENDIF
149             ENDDO             ENDDO
150           ELSE           ELSE
151             nlevels(n) = Nr  C-       will set levels later, once the Nb of levels of each diag is known
152             DO k=1,nlevels(n)             nlevels(n) = -1
              levs(k,n) = k  
            ENDDO  
153           ENDIF           ENDIF
154           nfields(n) = 0           nfields(n) = 0
155           DO m=1,fdimLoc           DO m=1,fdimLoc
156             IF ( fields(m,l).NE.blk8c .AND.             IF ( fields(m,l).NE.blk8c .AND.
157       &          nfields(n).LT.numperlist ) THEN       &          nfields(n).LT.numperlist ) THEN
158               nfields(n) = nfields(n) + 1               nfields(n) = nfields(n) + 1
159               flds(nfields(n),n) = fields(m,l)               flds(nfields(n),n) = fields(m,l)
# Line 183  C     Echo History List Data Structure Line 203  C     Echo History List Data Structure
203          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
204          WRITE(msgBuf,*) 'Frequency: ',freq(n)          WRITE(msgBuf,*) 'Frequency: ',freq(n)
205          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
206          DO l=1,nlevels(n),20          IF ( nlevels(n).EQ.-1 ) THEN
207              WRITE(msgBuf,'(A,A)') ' Levels:    ','will be set later'
208              CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
209            ELSE
210             DO l=1,nlevels(n),20
211            m = MIN(nlevels(n),l+19)            m = MIN(nlevels(n),l+19)
212            WRITE(msgBuf,'(A,20F5.0)') ' Levels:    ', (levs(k,n),k=l,m)            WRITE(msgBuf,'(A,20F5.0)') ' Levels:    ', (levs(k,n),k=l,m)
213            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
214          ENDDO           ENDDO
215            ENDIF
216          WRITE(msgBuf,*) 'Fields:   ',(' ',flds(l,n),l=1,nfields(n))          WRITE(msgBuf,*) 'Fields:   ',(' ',flds(l,n),l=1,nfields(n))
217          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
218        ENDDO        ENDDO

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.6

  ViewVC Help
Powered by ViewVC 1.1.22