/[MITgcm]/MITgcm/pkg/mnc/mnc_cw_readwrite.template
ViewVC logotype

Diff of /MITgcm/pkg/mnc/mnc_cw_readwrite.template

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

revision 1.30 by edhill, Fri Jun 24 19:43:52 2005 UTC revision 1.36 by edhill, Fri Mar 10 05:50:23 2006 UTC
# Line 93  C     !USES: Line 93  C     !USES:
93  #include "netcdf.inc"  #include "netcdf.inc"
94  #include "mnc_common.h"  #include "mnc_common.h"
95  #include "SIZE.h"  #include "SIZE.h"
96  #include "MNC_SIZE.h"  #include "MNC_BUFF.h"
97  #include "EEPARAMS.h"  #include "EEPARAMS.h"
98  #include "PARAMS.h"  #include "PARAMS.h"
99  #include "MNC_PARAMS.h"  #include "MNC_PARAMS.h"
# Line 107  CEOP Line 107  CEOP
107    
108  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
109        integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot, indu        integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot, indu
110        integer bis,bie, bjs,bje, uniq_tnum, nfname, iseq        integer bis,bie, bjs,bje, uniq_tnum, uniq_fnum, nfname, iseq
111        integer fid, idv, indvids, ndim, indf, err        integer fid, idv, indvids, ndim, indf, err
112        integer lbi,lbj, bidim,bjdim, unlim_sz, kr        integer lbi,lbj, bidim,bjdim, unlim_sz, kr
113        integer p(9),s(9),e(9), dimnc(9)        integer p(9),s(9),e(9), dimnc(9)
# Line 115  C     !LOCAL VARIABLES: Line 115  C     !LOCAL VARIABLES:
115        integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7        integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7
116        integer indfg, fg1,fg2, npath        integer indfg, fg1,fg2, npath
117        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
118        character*(MNC_MAX_CHAR) fname        character*(MNC_MAX_PATH) fname
119        character*(MNC_MAX_CHAR) path_fname        character*(MNC_MAX_PATH) path_fname
120          character*(MNC_MAX_PATH) tmpnm
121          character*(MNC_MAX_PATH) bpath
122          REAL*8  dval, dvm(2)
123          REAL*4  rval, rvm(2)
124          INTEGER ival, ivm(2), irv
125        REAL*8  resh_d( MNC_MAX_BUFF )        REAL*8  resh_d( MNC_MAX_BUFF )
126        REAL*4  resh_r( MNC_MAX_BUFF )        REAL*4  resh_r( MNC_MAX_BUFF )
127        INTEGER resh_i( MNC_MAX_BUFF )        INTEGER resh_i( MNC_MAX_BUFF )
128          LOGICAL write_attributes, use_missing
129  #ifdef HAVE_STAT  #ifdef HAVE_STAT
130        integer ntotenc, ncenc, nbytes, fs_isdone        integer ntotenc, ncenc, nbytes, fs_isdone
131        character*(200) cenc        character*(200) cenc
# Line 133  C     Functions Line 139  C     Functions
139  C     Only do I/O if I am the master thread  C     Only do I/O if I am the master thread
140        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
141    
142          DO i = 1,MNC_MAX_PATH
143            bpath(i:i) = ' '
144          ENDDO
145    
146  C     Get the current index for the unlimited dimension from the file  C     Get the current index for the unlimited dimension from the file
147  C     group (or base) name  C     group (or base) name
148        fg1 = IFNBLNK(fbname)        fg1 = IFNBLNK(fbname)
# Line 185  C     Set the bi,bj indicies Line 195  C     Set the bi,bj indicies
195    
196  C         Create the file name  C         Create the file name
197            CALL MNC_CW_GET_TILE_NUM(lbi,lbj, uniq_tnum, myThid)            CALL MNC_CW_GET_TILE_NUM(lbi,lbj, uniq_tnum, myThid)
198            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)            fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
199            n1 = IFNBLNK(fbname)            n1 = IFNBLNK(fbname)
200            n2 = ILNBLNK(fbname)            n2 = ILNBLNK(fbname)
201    
202    #ifdef MNC_WRITE_OLDNAMES
203    
204            ntot = n2 - n1 + 1            ntot = n2 - n1 + 1
205            fname(1:ntot) = fbname(n1:n2)            fname(1:ntot) = fbname(n1:n2)
206            ntot = ntot + 1            ntot = ntot + 1
207            fname(ntot:ntot) = '.'            fname(ntot:ntot) = '.'
208            write(fname((ntot+1):(ntot+14)),'(i4.4,a1,i6.6,a3)')            IF ( mnc_use_name_ni0 ) THEN
209       &         iseq,'.',uniq_tnum, '.nc'              write(fname((ntot+1):(ntot+17)),'(i10.10,a1,i6.6)')
210            nfname = ntot + 14       &           nIter0,'.',uniq_tnum
211                write(fname((ntot+18):(ntot+25)),'(a1,i4.4,a3)')
212         &           '.', iseq, '.nc'
213                nfname = ntot + 25
214              ELSE
215                write(fname((ntot+1):(ntot+14)),'(i4.4,a1,i6.6,a3)')
216         &           iseq,'.',uniq_tnum, '.nc'
217                nfname = ntot + 14
218              ENDIF
219    
220    #else
221    
222              CALL MNC_PSNCM(tmpnm, uniq_tnum, MNC_DEF_TMNC)
223              k = ILNBLNK(tmpnm)
224              IF ( mnc_cw_cit(1,mnc_cw_fgci(indfg)) .GT. -1 ) THEN
225                j = mnc_cw_cit(2,mnc_cw_fgci(indfg))
226                IF ( mnc_cw_fgis(indfg) .GT. j )
227         &           j = mnc_cw_fgis(indfg)
228                write(fname,'(a,a1,i10.10,a2,a,a3)') fbname(n1:n2),
229         &           '.', j, '.t', tmpnm(1:k), '.nc'
230              ELSEIF ( mnc_cw_cit(1,mnc_cw_fgci(indfg)) .EQ. -1 ) THEN
231    C           Leave off the myIter value entirely
232                write(fname,'(a,a2,a,a3)') fbname(n1:n2), '.t',
233         &           tmpnm(1:k),'.nc'
234              ELSE
235    C           We have an error--bad flag value
236                write(msgbuf,'(4a)')
237         &           'MNC_CW_RX_W ERROR: bad mnc_cw_cit(1,...) ',
238         &           'flag value for base name ''', fbname(fg1:fg2),
239         &           ''''
240                CALL print_error(msgbuf, mythid)
241                STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
242              ENDIF
243              nfname = ILNBLNK(fname)
244    
245    #endif
246    
247  C         Add the path to the file name  C         Add the path to the file name
248            IF (mnc_use_outdir) THEN            IF (mnc_use_outdir) THEN
249              path_fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)              path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
250              npath = ILNBLNK(mnc_out_path)              npath = ILNBLNK(mnc_out_path)
251              path_fname(1:npath) = mnc_out_path(1:npath)              path_fname(1:npath) = mnc_out_path(1:npath)
252              path_fname((npath+1):(npath+nfname)) = fname(1:nfname)              path_fname((npath+1):(npath+nfname)) = fname(1:nfname)
253              fname(1:MNC_MAX_CHAR) = path_fname(1:MNC_MAX_CHAR)              fname(1:MNC_MAX_PATH) = path_fname(1:MNC_MAX_PATH)
254              nfname = npath + nfname              nfname = npath + nfname
255            ENDIF            ENDIF
256    
# Line 241  C           file based on the byte count Line 289  C           file based on the byte count
289  C               Delete the now-full fname from the lookup tables since  C               Delete the now-full fname from the lookup tables since
290  C               we are all done writing to it.  C               we are all done writing to it.
291                  CALL MNC_FILE_CLOSE(fname, myThid)                  CALL MNC_FILE_CLOSE(fname, myThid)
                 iseq = iseq + 1  
292                  indu = 1                  indu = 1
293                  mnc_cw_fgud(indfg) = 1                  mnc_cw_fgud(indfg) = 1
294    
295    #ifdef MNC_WRITE_OLDNAMES
296                    iseq = iseq + 1
297                  mnc_cw_fgis(indfg) = iseq                  mnc_cw_fgis(indfg) = iseq
298    #else
299                    IF (mnc_cw_cit(1,mnc_cw_fgci(indfg)) .LT. 0) THEN
300                      write(msgbuf,'(5a)')
301         &            'MNC_CW_RX_W ERROR: output file for base name ''',
302         &            fbname(fg1:fg2), ''' is about to exceed the max ',
303         &            'file size and is NOT ALLOWED an iteration value ',
304         &            'within its file name'
305                      CALL print_error(msgbuf, mythid)
306                      STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
307                    ELSEIF (mnc_cw_cit(3,mnc_cw_fgci(indfg)) .LT. 0) THEN
308                      write(msgbuf,'(5a)')
309         &            'MNC_CW_RX_W ERROR: output file for base name ''',
310         &            fbname(fg1:fg2), ''' is about to exceed the max ',
311         &            'file size and no next-iter has been specified--',
312         &            'please see the MNC CITER functions'
313                      CALL print_error(msgbuf, mythid)
314                      STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
315                    ENDIF
316                    mnc_cw_fgis(indfg) = mnc_cw_cit(3,mnc_cw_fgci(indfg))
317    C               DO NOT BUMP THE CURRENT ITER FOR ALL FILES IN THIS CITER
318    C               GROUP SINCE THIS IS ONLY GROWTH TO AVOID FILE SIZE
319    C               LIMITS FOR THIS ONE BASENAME GROUP, NOT GROWTH OF THE
320    C               ENTIRE CITER GROUP !!!
321    C               mnc_cw_cit(2,mnc_cw_fgci(indfg))
322    C               &   = mnc_cw_cit(3,mnc_cw_fgci(indfg))
323    C               mnc_cw_cit(3,mnc_cw_fgci(indfg)) = -1
324    #endif
325                  fs_isdone = 1                  fs_isdone = 1
326                  GOTO 10                  GOTO 10
327    
328                ENDIF                ENDIF
329              ENDIF              ENDIF
330            ENDIF            ENDIF
# Line 275  C         Ensure that the "grid" is defi Line 353  C         Ensure that the "grid" is defi
353       &        mnc_cw_ndim(igrid), mnc_cw_dn(1,igrid), myThid)       &        mnc_cw_ndim(igrid), mnc_cw_dn(1,igrid), myThid)
354    
355  C         Ensure that the variable is defined  C         Ensure that the variable is defined
356              irv = 0
357            IF (stype(1:1) .EQ. 'D')            IF (stype(1:1) .EQ. 'D')
358       &         CALL MNC_VAR_INIT_DBL(       &         CALL MNC_VAR_INIT_DBL(
359       &         fname, mnc_cw_gname(igrid), vtype, myThid)       &         fname, mnc_cw_gname(igrid), vtype, irv, myThid)
360            IF (stype(1:1) .EQ. 'R')            IF (stype(1:1) .EQ. 'R')
361       &         CALL MNC_VAR_INIT_REAL(       &         CALL MNC_VAR_INIT_REAL(
362       &         fname, mnc_cw_gname(igrid), vtype, myThid)       &         fname, mnc_cw_gname(igrid), vtype, irv, myThid)
363            IF (stype(1:1) .EQ. 'I')            IF (stype(1:1) .EQ. 'I')
364       &         CALL MNC_VAR_INIT_INT(       &         CALL MNC_VAR_INIT_INT(
365       &         fname, mnc_cw_gname(igrid), vtype, myThid)       &         fname, mnc_cw_gname(igrid), vtype, irv, myThid)
366    
367              IF (irv .GT. 0) THEN
368    C           Return value indicates that the variable did not previously
369    C           exist in this file, so we need to write all the attributes
370                write_attributes = .TRUE.
371              ELSE
372                write_attributes = .FALSE.
373              ENDIF
374    
375            DO i = 1,mnc_fv_ids(indf,1)            DO i = 1,mnc_fv_ids(indf,1)
376              j = 2 + 3*(i - 1)              j = 2 + 3*(i - 1)
# Line 376  C         Check the offsets Line 463  C         Check the offsets
463              ENDIF              ENDIF
464            ENDDO            ENDDO
465    
466  C         Add the per-variable attributes            IF (write_attributes) THEN
467            DO i = 1,mnc_cw_vnat(1,indv)  C           Add the per-variable attributes
468              CALL MNC_VAR_ADD_ATTR_STR( fname, vtype,              DO i = 1,mnc_cw_vnat(1,indv)
469       &           mnc_cw_vtnm(i,indv), mnc_cw_vtat(i,indv), myThid)                CALL MNC_VAR_ADD_ATTR_STR( fname, vtype,
470            ENDDO       &             mnc_cw_vtnm(i,indv), mnc_cw_vtat(i,indv), myThid)
471            DO i = 1,mnc_cw_vnat(2,indv)              ENDDO
472              CALL MNC_VAR_ADD_ATTR_INT( fname, vtype,              DO i = 1,mnc_cw_vnat(2,indv)
473       &           mnc_cw_vinm(i,indv), 1, mnc_cw_viat(i,indv), myThid)                CALL MNC_VAR_ADD_ATTR_INT( fname, vtype,
474            ENDDO       &             mnc_cw_vinm(i,indv), 1, mnc_cw_viat(i,indv), myThid)
475            DO i = 1,mnc_cw_vnat(3,indv)              ENDDO
476              CALL MNC_VAR_ADD_ATTR_DBL( fname, vtype,              DO i = 1,mnc_cw_vnat(3,indv)
477       &           mnc_cw_vdnm(i,indv), 1, mnc_cw_vdat(i,indv), myThid)                CALL MNC_VAR_ADD_ATTR_DBL( fname, vtype,
478            ENDDO       &             mnc_cw_vdnm(i,indv), 1, mnc_cw_vdat(i,indv), myThid)
479                ENDDO
480              ENDIF
481    
482    C         Handle missing values
483              use_missing = .FALSE.
484              IF (mnc_cw_vfmv(indv) .EQ. 0) THEN
485                use_missing = .FALSE.
486              ELSE
487                IF (mnc_cw_vfmv(indv) .EQ. 1) THEN
488                  use_missing = .TRUE.
489                  dvm(1)  = mnc_def_dmv(1)
490                  dvm(2)  = mnc_def_dmv(2)
491                  rvm(1)  = mnc_def_rmv(1)
492                  rvm(2)  = mnc_def_rmv(2)
493                  ivm(1)  = mnc_def_imv(1)
494                  ivm(2)  = mnc_def_imv(2)
495                ELSEIF (mnc_cw_vfmv(indv) .EQ. 2) THEN
496                  use_missing = .TRUE.
497                  dvm(1)  = mnc_cw_vmvd(1,indv)
498                  dvm(2)  = mnc_cw_vmvd(2,indv)
499                  rvm(1)  = mnc_cw_vmvr(1,indv)
500                  rvm(2)  = mnc_cw_vmvr(2,indv)
501                  ivm(1)  = mnc_cw_vmvi(1,indv)
502                  ivm(2)  = mnc_cw_vmvi(2,indv)
503                ENDIF
504              ENDIF
505              IF (write_attributes .AND. use_missing) THEN
506                write(msgbuf,'(4a)') 'writing attribute ''missing_value''',
507         &           ' within file ''', fname(1:nfname), ''''
508                IF (stype(1:1) .EQ. 'D') THEN
509                  err = NF_PUT_ATT_DOUBLE(fid, idv, 'missing_value',
510         &             NF_DOUBLE, 1, dvm(2))
511                ELSEIF (stype(1:1) .EQ. 'R') THEN
512                  err = NF_PUT_ATT_REAL(fid, idv, 'missing_value',
513         &             NF_FLOAT, 1, dvm(2))
514                ELSEIF (stype(1:1) .EQ. 'I') THEN
515                  err = NF_PUT_ATT_INT(fid, idv, 'missing_value',
516         &             NF_INT, 1, ivm(2))
517                ENDIF
518                CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
519              ENDIF
520    
521            CALL MNC_FILE_ENDDEF(fname, myThid)            CALL MNC_FILE_ENDDEF(fname, myThid)
522    
# Line 434  C         Write the variable one vector Line 562  C         Write the variable one vector
562        IF (vcount(1) .GT. MNC_MAX_BUFF) THEN        IF (vcount(1) .GT. MNC_MAX_BUFF) THEN
563          write(msgbuf,'(2a,I7,a)') 'MNC_MAX_BUFF is too small',          write(msgbuf,'(2a,I7,a)') 'MNC_MAX_BUFF is too small',
564       &       '--please increase to at least ',       &       '--please increase to at least ',
565       &       vcount(1), ' in ''MNC_SIZE.h'''       &       vcount(1), ' in ''MNC_BUFF.h'''
566          CALL PRINT_ERROR(msgBuf , 1)          CALL PRINT_ERROR(msgBuf , 1)
567          STOP 'ABNORMAL END: S/R MNC_CW_RX_W_OFFSET'          STOP 'ABNORMAL END: S/R MNC_CW_RX_W_OFFSET'
568        ENDIF        ENDIF
569    
570        IF (stype(1:1) .EQ. 'D') THEN        IF (use_missing) THEN
571          DO j1 = s(1),e(1)  
572            k1 = k2 + j1          IF (stype(1:1) .EQ. 'D') THEN
573            kr = kr + 1            DO j1 = s(1),e(1)
574            resh_d(kr) = var(k1)              k1 = k2 + j1
575          ENDDO              kr = kr + 1
576          err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d)              dval = var(k1)
577        ENDIF              IF (dval .EQ. dvm(1)) THEN
578        IF (stype(1:1) .EQ. 'R') THEN                resh_d(kr) = dvm(2)
579          DO j1 = s(1),e(1)              ELSE
580            k1 = k2 + j1                resh_d(kr) = dval
581            kr = kr + 1              ENDIF
582            resh_r(kr) = var(k1)            ENDDO
583          ENDDO            err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d)
584          err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh_r)          ELSEIF (stype(1:1) .EQ. 'R') THEN
585        ENDIF            DO j1 = s(1),e(1)
586        IF (stype(1:1) .EQ. 'I') THEN              k1 = k2 + j1
587          DO j1 = s(1),e(1)              kr = kr + 1
588            k1 = k2 + j1              rval = var(k1)
589            kr = kr + 1              IF (rval .EQ. rvm(1)) THEN
590            resh_i(kr) = MNC2I( var(k1) )                resh_r(kr) = rvm(2)
591          ENDDO              ELSE
592          err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh_i)                resh_r(kr) = rval
593        ENDIF              ENDIF
594              ENDDO
595              err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh_r)
596            ELSEIF (stype(1:1) .EQ. 'I') THEN
597              DO j1 = s(1),e(1)
598                k1 = k2 + j1
599                kr = kr + 1
600                ival = MNC2I( var(k1) )
601                IF (ival .EQ. ivm(1)) THEN
602                  resh_i(kr) = ivm(2)
603                ELSE
604                  resh_i(kr) = ival
605                ENDIF
606              ENDDO
607              err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh_i)
608            ENDIF
609    
610          ELSE
611            
612            IF (stype(1:1) .EQ. 'D') THEN
613              DO j1 = s(1),e(1)
614                k1 = k2 + j1
615                kr = kr + 1
616                resh_d(kr) = var(k1)
617              ENDDO
618              err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d)
619            ELSEIF (stype(1:1) .EQ. 'R') THEN
620              DO j1 = s(1),e(1)
621                k1 = k2 + j1
622                kr = kr + 1
623                resh_r(kr) = var(k1)
624              ENDDO
625              err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh_r)
626            ELSEIF (stype(1:1) .EQ. 'I') THEN
627              DO j1 = s(1),e(1)
628                k1 = k2 + j1
629                kr = kr + 1
630                resh_i(kr) = MNC2I( var(k1) )
631              ENDDO
632              err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh_i)
633            ENDIF
634    
635          ENDIF
636        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
637    
638                      ENDDO                      ENDDO
# Line 542  C     !USES: Line 711  C     !USES:
711  #include "netcdf.inc"  #include "netcdf.inc"
712  #include "mnc_common.h"  #include "mnc_common.h"
713  #include "SIZE.h"  #include "SIZE.h"
714  #include "MNC_SIZE.h"  #include "MNC_BUFF.h"
715  #include "EEPARAMS.h"  #include "EEPARAMS.h"
716  #include "PARAMS.h"  #include "PARAMS.h"
717  #include "MNC_PARAMS.h"  #include "MNC_PARAMS.h"
# Line 555  CEOP Line 724  CEOP
724    
725  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
726        integer i,k, nvf,nvl, n1,n2, igrid, ntot, indu        integer i,k, nvf,nvl, n1,n2, igrid, ntot, indu
727        integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv        integer bis,bie, bjs,bje, uniq_tnum,uniq_fnum, nfname, fid, idv
728        integer ndim, err, lbi,lbj, bidim,bjdim, unlim_sz, kr        integer ndim, err, lbi,lbj, bidim,bjdim, unlim_sz, kr
729        integer ind_vt, npath, unlid        integer ind_vt, npath, unlid, f_or_t, ixoff,iyoff
730  C     integer f_sNx,f_sNy, alen, atype, ind_fv_ids, ierr, indf  C     integer f_sNx,f_sNy, alen, atype, ind_fv_ids, ierr, indf
731        integer p(9),s(9),e(9), vstart(9),vcount(9), udo(9)        integer p(9),s(9),e(9), vstart(9),vcount(9), udo(9)
732        integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7        integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7
733        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
734        character*(MNC_MAX_CHAR) fname        character*(MNC_MAX_PATH) fname
735        character*(MNC_MAX_CHAR) fname_zs        character*(MNC_MAX_PATH) fname_zs
736        character*(MNC_MAX_CHAR) path_fname        character*(MNC_MAX_PATH) tmpnm
737          character*(MNC_MAX_PATH) path_fname
738          character*(MNC_MAX_PATH) bpath
739        integer indfg, fg1,fg2        integer indfg, fg1,fg2
740        REAL*8  resh_d( MNC_MAX_BUFF )        REAL*8  resh_d( MNC_MAX_BUFF )
741        REAL*4  resh_r( MNC_MAX_BUFF )        REAL*4  resh_r( MNC_MAX_BUFF )
# Line 576  C     Functions Line 747  C     Functions
747  C     Only do I/O if I am the master thread  C     Only do I/O if I am the master thread
748        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
749    
750          DO i = 1,MNC_MAX_PATH
751            bpath(i:i) = ' '
752          ENDDO
753    
754  C     Get the current index for the unlimited dimension from the file  C     Get the current index for the unlimited dimension from the file
755  C     group (or base) name  C     group (or base) name
756        fg1 = IFNBLNK(fbname)        fg1 = IFNBLNK(fbname)
# Line 625  C     Set the bi,bj indicies Line 800  C     Set the bi,bj indicies
800    
801  C         Create the file name  C         Create the file name
802            CALL MNC_CW_GET_TILE_NUM( lbi,lbj, uniq_tnum, myThid)            CALL MNC_CW_GET_TILE_NUM( lbi,lbj, uniq_tnum, myThid)
803            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)            fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
804    
805    #ifdef MNC_READ_OLDNAMES
806    
807            n1 = IFNBLNK(fbname)            n1 = IFNBLNK(fbname)
808            n2 = ILNBLNK(fbname)            n2 = ILNBLNK(fbname)
809            ntot = n2 - n1 + 1            ntot = n2 - n1 + 1
# Line 637  C         Create the file name Line 815  C         Create the file name
815    
816  C         Add the path to the file name  C         Add the path to the file name
817            IF (mnc_use_indir) THEN            IF (mnc_use_indir) THEN
818              path_fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)              path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
819              npath = ILNBLNK(mnc_indir_str)              npath = ILNBLNK(mnc_indir_str)
820              path_fname(1:npath) = mnc_indir_str(1:npath)              path_fname(1:npath) = mnc_indir_str(1:npath)
821              path_fname((npath+1):(npath+nfname)) = fname(1:nfname)              path_fname((npath+1):(npath+nfname)) = fname(1:nfname)
822              fname(1:MNC_MAX_CHAR) = path_fname(1:MNC_MAX_CHAR)              fname(1:MNC_MAX_PATH) = path_fname(1:MNC_MAX_PATH)
823              nfname = npath + nfname              nfname = npath + nfname
824            ENDIF            ENDIF
825    
# Line 665  C           zero sequence number inserte Line 843  C           zero sequence number inserte
843            ENDIF            ENDIF
844            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
845    
846            write(msgbuf,'(6a)')            write(msgbuf,'(5a)')
847       &         'MNC_CW_RX_R: cannot get id for variable ''',       &         'MNC_CW_RX_R: cannot get id for variable ''',
848       &         vtype(nvf:nvl), '''in file ''', fname(1:nfname), ''''       &         vtype(nvf:nvl), '''in file ''', fname(1:nfname), ''''
849            err = NF_INQ_VARID(fid, vtype, idv)            err = NF_INQ_VARID(fid, vtype, idv)
850            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
851              f_or_t = 0
852    
853    #else
854    
855    C         The sequence for PER-FACE and PER-TILE is:
856    C         (1) check whether a PER-FACE file exists
857    C         .   (a) if only one face is used for the entire domain,
858    C         .       then omit the face index from the file name
859    C         .   (b) if the PER-FACE file exists and is somehow faulty,
860    C         .       then we die with an error message
861    C         (2) if no PER-FACE file exists, then use a PER-TILE file
862    
863    C         Create the PER-FACE file name
864              n1 = IFNBLNK(fbname)
865              n2 = ILNBLNK(fbname)
866    C         Add an iteraton count to the file name if its requested
867              IF (mnc_cw_cit(1,mnc_cw_fgci(indfg)) .LT. 0) THEN
868                WRITE(fname,'(a,a1)') fbname(n1:n2), '.'
869              ELSE
870                WRITE(fname,'(a,a1,i10.10,a1)') fbname(n1:n2), '.',
871         &            mnc_cw_cit(2,mnc_cw_fgci(indfg)), '.'
872              ENDIF
873              ntot = ILNBLNK(fname)
874              path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
875              npath = ILNBLNK(mnc_indir_str)
876    C         Add the face index
877              CALL MNC_CW_GET_FACE_NUM( lbi,lbj, uniq_fnum, myThid)
878              IF ( uniq_fnum .EQ. -1 ) THEN
879    C           There is only one face
880                WRITE(path_fname,'(2a,a2)')
881         &           mnc_indir_str(1:npath), fname(1:ntot), 'nc'
882              ELSE
883                CALL MNC_PSNCM(tmpnm, uniq_fnum, MNC_DEF_FMNC)
884                k = ILNBLNK(tmpnm)
885                WRITE(path_fname,'(2a,a1,a,a3)')
886         &           mnc_indir_str(1:npath), fname(1:ntot), 'f',
887         &           tmpnm(1:k), '.nc'
888              ENDIF
889    
890    C         Try to open the PER-FACE file
891    C         WRITE(*,*) 'trying: "', path_fname, '"'
892              err = NF_OPEN(path_fname, NF_NOWRITE, fid)
893              IF ( err .EQ. NF_NOERR ) THEN
894                f_or_t = 1
895              ELSE
896    
897    C           Create the PER-TILE file name
898                CALL MNC_PSNCM(tmpnm, uniq_tnum, MNC_DEF_TMNC)
899                k = ILNBLNK(tmpnm)
900                path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
901                WRITE(path_fname,'(2a,a1,a,a3)')
902         &           mnc_indir_str(1:npath), fname(1:ntot), 't',
903         &           tmpnm(1:k), '.nc'
904    C           WRITE(*,*) 'trying: "', path_fname, '"'
905                err = NF_OPEN(path_fname, NF_NOWRITE, fid)
906                IF ( err .EQ. NF_NOERR ) THEN
907                  f_or_t = 0
908                ELSE
909                  k = ILNBLNK(path_fname)
910                  write(msgbuf,'(4a)')
911         &             'MNC_CW_RX_R: cannot open either a per-face or a ',
912         &             'per-tile file: last try was ''', path_fname(1:k),
913         &             ''''
914                  CALL print_error(msgbuf, mythid)
915                  STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
916                ENDIF
917    
918              ENDIF
919    
920              ntot = ILNBLNK(path_fname)
921              write(msgbuf,'(5a)')
922         &         'MNC_CW_RX_R: cannot get netCDF id for variable ''',
923         &         vtype(nvf:nvl), ''' in file ''', path_fname(1:ntot),
924         &         ''''
925              err = NF_INQ_VARID(fid, vtype, idv)
926              CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
927    
928              k = ILNBLNK(path_fname)
929              fname(1:k) = path_fname(1:k)
930              nfname = k
931    
932    #endif
933    
934              IF ( f_or_t .EQ. 1 ) THEN
935    
936    C           write(msgbuf,'(2a)')
937    C           &           'MNC_CW_RX_R: per-face reads are not yet ',
938    C           &           'implemented -- so pester Ed to finish them'
939    C           CALL print_error(msgbuf, mythid)
940    C           STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
941                
942    C           Get the X,Y PER-FACE offsets
943                CALL MNC_CW_GET_XYFO(lbi,lbj, ixoff,iyoff, myThid)
944    
945              ENDIF
946    
947    C         WRITE(*,*) 'f_or_t = ',f_or_t
948    
949  C         Check that the current sNy,sNy values and the in-file values  C         Check that the current sNy,sNy values and the in-file values
950  C         are compatible and WARN (only warn) if not  C         are compatible and WARN (only warn) if not
# Line 747  C         the unlimited dimension offset Line 1022  C         the unlimited dimension offset
1022              IF (i .LE. ndim) THEN              IF (i .LE. ndim) THEN
1023                s(i) = mnc_cw_is(i,igrid)                s(i) = mnc_cw_is(i,igrid)
1024                e(i) = mnc_cw_ie(i,igrid)                e(i) = mnc_cw_ie(i,igrid)
1025    
1026                  IF ( f_or_t .EQ. 1 ) THEN
1027    C               Add the per-face X,Y offsets to the udo offset vector
1028    C               since they accomplish the same thing
1029                    IF ( mnc_cw_dn(i,igrid)(1:1) .EQ. 'X' ) THEN
1030                      udo(i) = ixoff - 1
1031                    ELSEIF ( mnc_cw_dn(i,igrid)(1:1) .EQ. 'Y' ) THEN
1032                      udo(i) = iyoff - 1
1033                    ENDIF
1034                  ENDIF
1035    
1036              ENDIF              ENDIF
1037  C           Check for the unlimited dimension  C           Check for the unlimited dimension
1038              IF ((i .EQ. ndim)              IF ((i .EQ. ndim)
# Line 820  C         Read the variable one vector a Line 1106  C         Read the variable one vector a
1106        IF (vcount(1) .GT. MNC_MAX_BUFF) THEN        IF (vcount(1) .GT. MNC_MAX_BUFF) THEN
1107          write(msgbuf,'(2a,I7,a)') 'MNC_MAX_BUFF is too small',          write(msgbuf,'(2a,I7,a)') 'MNC_MAX_BUFF is too small',
1108       &       '--please increase to at least ',       &       '--please increase to at least ',
1109       &       vcount(1), ' in ''MNC_SIZE.h'''       &       vcount(1), ' in ''MNC_BUFF.h'''
1110          CALL PRINT_ERROR(msgBuf , 1)          CALL PRINT_ERROR(msgBuf , 1)
1111          STOP 'ABNORMAL END: S/R MNC_CW_RX_R_OFFSET'          STOP 'ABNORMAL END: S/R MNC_CW_RX_R_OFFSET'
1112        ENDIF        ENDIF
Legend:
Removed from v.1.30  
changed lines
  Added in v.1.36
  ViewVC Help
Powered by ViewVC 1.1.22