108 |
CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid) |
CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid) |
109 |
CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',myTime,myThid) |
CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',myTime,myThid) |
110 |
CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid) |
CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid) |
111 |
|
CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',myIter,myThid) |
112 |
|
|
113 |
|
C NOTE: at some point it would be a good idea to add a time_bounds |
114 |
|
C variable that has dimension (2,T) and clearly denotes the |
115 |
|
C beginning and ending times for each diagnostics period |
116 |
|
|
117 |
dn(1)(1:NLEN) = dn_blnk(1:NLEN) |
dn(1)(1:NLEN) = dn_blnk(1:NLEN) |
118 |
WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId) |
WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId) |
141 |
C levels, land levels, etc. the different vertical coordinate |
C levels, land levels, etc. the different vertical coordinate |
142 |
C dimensions will have to be taken into account. |
C dimensions will have to be taken into account. |
143 |
|
|
144 |
|
C 20051021 JMC & EH3 : We need to extend this so that a few |
145 |
|
C variables each defined on different grids do not have the same |
146 |
|
C vertical dimension names so we should be using a pattern such |
147 |
|
C as: Z[uml]td000000 where the 't' is the type as specified by |
148 |
|
C gdiag(10) |
149 |
|
|
150 |
C Now define: Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx |
C Now define: Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx |
151 |
ctmp(1:5) = 'mul ' |
ctmp(1:5) = 'mul ' |
152 |
DO i = 1,3 |
DO i = 1,3 |
307 |
#ifdef ALLOW_MDSIO |
#ifdef ALLOW_MDSIO |
308 |
C Prepare for mdsio optionality |
C Prepare for mdsio optionality |
309 |
IF (diag_mdsio) THEN |
IF (diag_mdsio) THEN |
310 |
IF (fflags(listId)(1:1) .EQ. ' ') THEN |
IF (fflags(listId)(1:1) .EQ. 'R') THEN |
|
C This is the old default behavior |
|
|
CALL MDSWRITEFIELD_NEW(fn,writeBinaryPrec,glf,'RL', |
|
|
& Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid) |
|
|
ELSEIF (fflags(listId)(1:1) .EQ. 'R') THEN |
|
311 |
C Force it to be 32-bit precision |
C Force it to be 32-bit precision |
312 |
CALL MDSWRITEFIELD_NEW(fn,precFloat32,glf,'RL', |
CALL MDSWRITEFIELD_NEW(fn,precFloat32,glf,.FALSE., |
313 |
& Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid) |
& 'RL',Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid) |
314 |
ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN |
ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN |
315 |
C Force it to be 64-bit precision |
C Force it to be 64-bit precision |
316 |
CALL MDSWRITEFIELD_NEW(fn,precFloat64,glf,'RL', |
CALL MDSWRITEFIELD_NEW(fn,precFloat64,glf,.FALSE., |
317 |
& Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid) |
& 'RL',Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid) |
318 |
|
ELSE |
319 |
|
C This is the old default behavior |
320 |
|
CALL MDSWRITEFIELD_NEW(fn,writeBinaryPrec,glf,.FALSE., |
321 |
|
& 'RL',Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid) |
322 |
ENDIF |
ENDIF |
323 |
ENDIF |
ENDIF |
324 |
#endif /* ALLOW_MDSIO */ |
#endif /* ALLOW_MDSIO */ |
370 |
ENDIF |
ENDIF |
371 |
|
|
372 |
C Z is special since it varies |
C Z is special since it varies |
373 |
WRITE(dn(3),'(a,i6.6)') 'Zd', nlevels(listId) |
WRITE(dn(3),'(a,i6.6)') 'Zd', nlevsout |
374 |
IF ( (gdiag(ndId)(10:10) .EQ. 'R') |
IF ( (gdiag(ndId)(10:10) .EQ. 'R') |
375 |
& .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN |
& .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN |
376 |
WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevels(listId) |
WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevsout |
377 |
ENDIF |
ENDIF |
378 |
IF ( (gdiag(ndId)(10:10) .EQ. 'R') |
IF ( (gdiag(ndId)(10:10) .EQ. 'R') |
379 |
& .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN |
& .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN |
380 |
WRITE(dn(3),'(a,i6.6)') 'Zld', nlevels(listId) |
WRITE(dn(3),'(a,i6.6)') 'Zld', nlevsout |
381 |
ENDIF |
ENDIF |
382 |
IF ( (gdiag(ndId)(10:10) .EQ. 'R') |
IF ( (gdiag(ndId)(10:10) .EQ. 'R') |
383 |
& .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN |
& .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN |
384 |
WRITE(dn(3),'(a,i6.6)') 'Zud', nlevels(listId) |
WRITE(dn(3),'(a,i6.6)') 'Zud', nlevsout |
385 |
ENDIF |
ENDIF |
386 |
dim(3) = Nr+Nrphys |
dim(3) = Nr+Nrphys |
387 |
ib(3) = 1 |
ib(3) = 1 |
388 |
ie(3) = nlevels(listId) |
ie(3) = nlevsout |
389 |
|
|
390 |
C Time dimension |
C Time dimension |
391 |
dn(4)(1:1) = 'T' |
dn(4)(1:1) = 'T' |
401 |
& tdiag(ndId),myThid) |
& tdiag(ndId),myThid) |
402 |
CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units', |
CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units', |
403 |
& udiag(ndId),myThid) |
& udiag(ndId),myThid) |
404 |
|
CALL MNC_CW_ADD_VATTR_DBL(cdiag(ndId),'missing_value', |
405 |
|
& 0.0 _d 0,myThid) |
406 |
|
|
407 |
IF ((fflags(listId)(1:1) .EQ. ' ') |
IF ( ( (writeBinaryPrec .EQ. precFloat32) |
408 |
|
& .AND. (fflags(listId)(1:1) .NE. 'D') |
409 |
|
& .AND. (fflags(listId)(1:1) .NE. 'R') ) |
410 |
& .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN |
& .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN |
411 |
CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0, |
CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0, |
412 |
& cdiag(ndId), qtmp1, myThid) |
& cdiag(ndId), qtmp1, myThid) |
413 |
ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN |
ELSEIF ( (writeBinaryPrec .EQ. precFloat64) |
414 |
|
& .OR. (fflags(listId)(1:1) .EQ. 'D') ) THEN |
415 |
CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0, |
CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0, |
416 |
& cdiag(ndId), qtmp1, myThid) |
& cdiag(ndId), qtmp1, myThid) |
417 |
ENDIF |
ENDIF |