53 |
INTEGER ilen |
INTEGER ilen |
54 |
|
|
55 |
INTEGER ioUnit |
INTEGER ioUnit |
56 |
CHARACTER*(MAX_LEN_FNAM) pref |
CHARACTER*(MAX_LEN_FNAM) fn |
57 |
CHARACTER*(MAX_LEN_MBUF) suff |
CHARACTER*(MAX_LEN_MBUF) suff |
58 |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
|
CHARACTER*(80) fn |
|
59 |
LOGICAL glf |
LOGICAL glf |
60 |
#ifdef ALLOW_MNC |
#ifdef ALLOW_MNC |
61 |
INTEGER ii |
INTEGER ii |
77 |
undef = getcon('UNDEF') |
undef = getcon('UNDEF') |
78 |
glf = globalFiles |
glf = globalFiles |
79 |
WRITE(suff,'(I10.10)') myIter |
WRITE(suff,'(I10.10)') myIter |
80 |
pref = fnames(listnum) |
ilen = ILNBLNK(fnames(listnum)) |
81 |
ilen=ILNBLNK( pref ) |
WRITE( fn, '(A,A,A)' ) fnames(listnum)(1:ilen),'.',suff(1:10) |
|
WRITE( fn, '(A,A,A)' ) pref(1:ilen),'.',suff(1:10) |
|
82 |
|
|
83 |
#ifdef ALLOW_MNC |
#ifdef ALLOW_MNC |
84 |
IF (useMNC .AND. diag_mnc) THEN |
IF (useMNC .AND. diag_mnc) THEN |
88 |
DO i = 1,NLEN |
DO i = 1,NLEN |
89 |
dn_blnk(i:i) = ' ' |
dn_blnk(i:i) = ' ' |
90 |
ENDDO |
ENDDO |
91 |
c WRITE( diag_mnc_bn, '(A,A)' ) 'diag.', pref(1:ilen) |
WRITE( diag_mnc_bn, '(A)' ) fnames(listnum)(1:ilen) |
|
WRITE( diag_mnc_bn, '(A)' ) pref(1:ilen) |
|
92 |
|
|
93 |
C Update the record dimension by writing the iteration number |
C Update the record dimension by writing the iteration number |
94 |
CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid) |
CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid) |
109 |
& 'Idicies of vertical levels within the source arrays', |
& 'Idicies of vertical levels within the source arrays', |
110 |
& myThid) |
& myThid) |
111 |
|
|
112 |
CALL MNC_CW_RL_W('I',diag_mnc_bn,0,0, |
CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0, |
113 |
& 'diag_levels', levs(1,listnum), myThid) |
& 'diag_levels', levs(1,listnum), myThid) |
114 |
|
|
115 |
CALL MNC_CW_DEL_VNAME('diag_levels', myThid) |
CALL MNC_CW_DEL_VNAME('diag_levels', myThid) |
122 |
WRITE(dn(1),'(3a,i6.6)') 'Z',ctmp(i:i),'d',nlevels(listnum) |
WRITE(dn(1),'(3a,i6.6)') 'Z',ctmp(i:i),'d',nlevels(listnum) |
123 |
CALL MNC_CW_ADD_GNAME(dn(1), 1, dim, dn, ib, ie, myThid) |
CALL MNC_CW_ADD_GNAME(dn(1), 1, dim, dn, ib, ie, myThid) |
124 |
CALL MNC_CW_ADD_VNAME(dn(1), dn(1), 0,0, myThid) |
CALL MNC_CW_ADD_VNAME(dn(1), dn(1), 0,0, myThid) |
125 |
DO j = 1,nlevels(listnum) |
|
126 |
IF (i .EQ. 1) THEN |
C The following three ztmp() loops should eventually be modified |
127 |
ztmp(j) = rC(levs(j,listnum)) |
C to reflect the fractional nature of levs(j,l) -- they should |
128 |
CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description', |
C do something like: |
129 |
& 'Dimensional coordinate value at the mid point', |
C ztmp(j) = rC(INT(FLOOR(levs(j,l)))) |
130 |
& myThid) |
C + ( rC(INT(FLOOR(levs(j,l)))) |
131 |
ELSEIF (i .EQ. 2) THEN |
C + rC(INT(CEIL(levs(j,l)))) ) |
132 |
ztmp(j) = rF(levs(j,listnum)) |
C / ( levs(j,l) - FLOOR(levs(j,l)) ) |
133 |
CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description', |
C for averaged levels. |
134 |
& 'Dimensional coordinate value at the upper point', |
IF (i .EQ. 1) THEN |
135 |
& myThid) |
DO j = 1,nlevels(listnum) |
136 |
ELSEIF (i .EQ. 3) THEN |
ztmp(j) = rC(NINT(levs(j,listnum))) |
137 |
ztmp(j) = rF(levs(j,listnum) + 1) |
ENDDO |
138 |
CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description', |
CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description', |
139 |
& 'Dimensional coordinate value at the lower point', |
& 'Dimensional coordinate value at the mid point', |
140 |
& myThid) |
& myThid) |
141 |
ENDIF |
ELSEIF (i .EQ. 2) THEN |
142 |
ENDDO |
DO j = 1,nlevels(listnum) |
143 |
|
ztmp(j) = rF(NINT(levs(j,listnum)) + 1) |
144 |
|
ENDDO |
145 |
|
CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description', |
146 |
|
& 'Dimensional coordinate value at the upper point', |
147 |
|
& myThid) |
148 |
|
ELSEIF (i .EQ. 3) THEN |
149 |
|
DO j = 1,nlevels(listnum) |
150 |
|
ztmp(j) = rF(NINT(levs(j,listnum))) |
151 |
|
ENDDO |
152 |
|
CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description', |
153 |
|
& 'Dimensional coordinate value at the lower point', |
154 |
|
& myThid) |
155 |
|
ENDIF |
156 |
CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid) |
CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid) |
157 |
CALL MNC_CW_DEL_VNAME(dn(1), myThid) |
CALL MNC_CW_DEL_VNAME(dn(1), myThid) |
158 |
CALL MNC_CW_DEL_GNAME(dn(1), myThid) |
CALL MNC_CW_DEL_GNAME(dn(1), myThid) |
348 |
ENDIF |
ENDIF |
349 |
ENDDO |
ENDDO |
350 |
|
|
351 |
2000 format(1x,'Computing Diagnostic # ',i3,2x,a8,5x,'Counter: ', |
2000 format(1x,'Computing Diagnostic # ',i3,2x,a8,5x, |
352 |
& i4,6x,'Parms: ',a16) |
& 'Counter:',i8,3x,'Parms: ',a16) |
353 |
2001 format(1x,' Vector Mate for ',a8,5x, |
2001 format(1x,' Vector Mate for ',a8,5x, |
354 |
& 'Diagnostic # ',i3,2x,a8,' exists ') |
& 'Diagnostic # ',i3,2x,a8,' exists ') |
355 |
2002 format(1x,' Vector Mate for ',a8,5x, |
2002 format(1x,' Vector Mate for ',a8,5x, |
356 |
& 'Diagnostic # ',i3,2x,a8,' not enabled') |
& 'Diagnostic # ',i3,2x,a8,' not enabled') |
357 |
2003 format(1x,' use Counter Mate for ',a8,5x, |
2003 format(1x,' use Counter Mate for ',a8,5x, |
358 |
& 'Diagnostic # ',i3,2x,a8) |
& 'Diagnostic # ',i3,2x,a8) |