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) |
249 |
#ifdef ALLOW_MDSIO |
#ifdef ALLOW_MDSIO |
250 |
C Prepare for mdsio optionality |
C Prepare for mdsio optionality |
251 |
IF (diag_mdsio) THEN |
IF (diag_mdsio) THEN |
252 |
CALL mdswritefield_new(fn,writeBinaryPrec,glf,'RL', |
IF (fflags(listnum)(1:1) .EQ. ' ') THEN |
253 |
& Nr+Nrphys,nlevels(listnum),qtmp1,n,myIter,myThid) |
C This is the old default behavior |
254 |
|
CALL mdswritefield_new(fn,writeBinaryPrec,glf,'RL', |
255 |
|
& Nr+Nrphys,nlevels(listnum),qtmp1,n,myIter,myThid) |
256 |
|
ELSEIF (fflags(listnum)(1:1) .EQ. 'R') THEN |
257 |
|
C Force it to be 32-bit precision |
258 |
|
CALL mdswritefield_new(fn,precFloat32,glf,'RL', |
259 |
|
& Nr+Nrphys,nlevels(listnum),qtmp1,n,myIter,myThid) |
260 |
|
ELSEIF (fflags(listnum)(1:1) .EQ. 'D') THEN |
261 |
|
C Force it to be 64-bit precision |
262 |
|
CALL mdswritefield_new(fn,precFloat64,glf,'RL', |
263 |
|
& Nr+Nrphys,nlevels(listnum),qtmp1,n,myIter,myThid) |
264 |
|
ENDIF |
265 |
ENDIF |
ENDIF |
266 |
#endif /* ALLOW_MDSIO */ |
#endif /* ALLOW_MDSIO */ |
267 |
|
|
344 |
CALL MNC_CW_ADD_VATTR_TEXT(cdiag(m),'units', |
CALL MNC_CW_ADD_VATTR_TEXT(cdiag(m),'units', |
345 |
& udiag(m),myThid) |
& udiag(m),myThid) |
346 |
|
|
347 |
CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0, |
IF ((fflags(listnum)(1:1) .EQ. ' ') |
348 |
|
& .OR. (fflags(listnum)(1:1) .EQ. 'R')) THEN |
349 |
|
CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0, |
350 |
& cdiag(m), qtmp1, myThid) |
& cdiag(m), qtmp1, myThid) |
351 |
|
ELSEIF (fflags(listnum)(1:1) .EQ. 'D') THEN |
352 |
|
CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0, |
353 |
|
& cdiag(m), qtmp1, myThid) |
354 |
|
ENDIF |
355 |
|
|
356 |
CALL MNC_CW_DEL_VNAME(cdiag(m), myThid) |
CALL MNC_CW_DEL_VNAME(cdiag(m), myThid) |
357 |
CALL MNC_CW_DEL_GNAME(d_cw_name, myThid) |
CALL MNC_CW_DEL_GNAME(d_cw_name, myThid) |
358 |
|
|
365 |
ENDIF |
ENDIF |
366 |
ENDDO |
ENDDO |
367 |
|
|
368 |
2000 format(1x,'Computing Diagnostic # ',i3,2x,a8,5x,'Counter: ', |
2000 format(1x,'Computing Diagnostic # ',i3,2x,a8,5x, |
369 |
& i4,6x,'Parms: ',a16) |
& 'Counter:',i8,3x,'Parms: ',a16) |
370 |
2001 format(1x,' Vector Mate for ',a8,5x, |
2001 format(1x,' Vector Mate for ',a8,5x, |
371 |
& 'Diagnostic # ',i3,2x,a8,' exists ') |
& 'Diagnostic # ',i3,2x,a8,' exists ') |
372 |
2002 format(1x,' Vector Mate for ',a8,5x, |
2002 format(1x,' Vector Mate for ',a8,5x, |
373 |
& 'Diagnostic # ',i3,2x,a8,' not enabled') |
& 'Diagnostic # ',i3,2x,a8,' not enabled') |
374 |
2003 format(1x,' use Counter Mate for ',a8,5x, |
2003 format(1x,' use Counter Mate for ',a8,5x, |
375 |
& 'Diagnostic # ',i3,2x,a8) |
& 'Diagnostic # ',i3,2x,a8) |