/[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.31 by edhill, Mon Jun 27 20:19:52 2005 UTC revision 1.39 by edhill, Fri Aug 4 15:14:25 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, nf
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)
114        integer vstart(9),vcount(9), udo(9)        integer vstart(9),vcount(9), udo(9)
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
# Line 204  C         Create the file name Line 217  C         Create the file name
217              nfname = ntot + 14              nfname = ntot + 14
218            ENDIF            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 249  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 283  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 384  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 442  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 483  C         Write the variable one vector Line 644  C         Write the variable one vector
644    
645  C         Sync the file  C         Sync the file
646            err = NF_SYNC(fid)            err = NF_SYNC(fid)
647            write(msgbuf,'(3a)') 'sync for file ''', fname,            nf = ILNBLNK( fname )
648              write(msgbuf,'(3a)') 'sync for file ''', fname(1:nf),
649       &         ''' in S/R MNC_CW_RX_W'       &         ''' in S/R MNC_CW_RX_W'
650            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
651    
# Line 550  C     !USES: Line 712  C     !USES:
712  #include "netcdf.inc"  #include "netcdf.inc"
713  #include "mnc_common.h"  #include "mnc_common.h"
714  #include "SIZE.h"  #include "SIZE.h"
715  #include "MNC_SIZE.h"  #include "MNC_BUFF.h"
716  #include "EEPARAMS.h"  #include "EEPARAMS.h"
717  #include "PARAMS.h"  #include "PARAMS.h"
718  #include "MNC_PARAMS.h"  #include "MNC_PARAMS.h"
# Line 563  CEOP Line 725  CEOP
725    
726  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
727        integer i,k, nvf,nvl, n1,n2, igrid, ntot, indu        integer i,k, nvf,nvl, n1,n2, igrid, ntot, indu
728        integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv        integer bis,bie, bjs,bje, uniq_tnum,uniq_fnum, nfname, fid, idv
729        integer ndim, err, lbi,lbj, bidim,bjdim, unlim_sz, kr        integer ndim, err, lbi,lbj, bidim,bjdim, unlim_sz, kr
730        integer ind_vt, npath, unlid        integer ind_vt, npath, unlid, f_or_t, ixoff,iyoff
731  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
732        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)
733        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
734        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
735        character*(MNC_MAX_CHAR) fname        character*(MNC_MAX_PATH) fname
736        character*(MNC_MAX_CHAR) fname_zs        character*(MNC_MAX_PATH) fname_zs
737        character*(MNC_MAX_CHAR) path_fname        character*(MNC_MAX_PATH) tmpnm
738          character*(MNC_MAX_PATH) path_fname
739          character*(MNC_MAX_PATH) bpath
740        integer indfg, fg1,fg2        integer indfg, fg1,fg2
741        REAL*8  resh_d( MNC_MAX_BUFF )        REAL*8  resh_d( MNC_MAX_BUFF )
742        REAL*4  resh_r( MNC_MAX_BUFF )        REAL*4  resh_r( MNC_MAX_BUFF )
# Line 584  C     Functions Line 748  C     Functions
748  C     Only do I/O if I am the master thread  C     Only do I/O if I am the master thread
749        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
750    
751          DO i = 1,MNC_MAX_PATH
752            bpath(i:i) = ' '
753          ENDDO
754    
755  C     Get the current index for the unlimited dimension from the file  C     Get the current index for the unlimited dimension from the file
756  C     group (or base) name  C     group (or base) name
757        fg1 = IFNBLNK(fbname)        fg1 = IFNBLNK(fbname)
# Line 633  C     Set the bi,bj indicies Line 801  C     Set the bi,bj indicies
801    
802  C         Create the file name  C         Create the file name
803            CALL MNC_CW_GET_TILE_NUM( lbi,lbj, uniq_tnum, myThid)            CALL MNC_CW_GET_TILE_NUM( lbi,lbj, uniq_tnum, myThid)
804            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)            fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
805    
806    #ifdef MNC_READ_OLDNAMES
807    
808            n1 = IFNBLNK(fbname)            n1 = IFNBLNK(fbname)
809            n2 = ILNBLNK(fbname)            n2 = ILNBLNK(fbname)
810            ntot = n2 - n1 + 1            ntot = n2 - n1 + 1
# Line 645  C         Create the file name Line 816  C         Create the file name
816    
817  C         Add the path to the file name  C         Add the path to the file name
818            IF (mnc_use_indir) THEN            IF (mnc_use_indir) THEN
819              path_fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)              path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
820              npath = ILNBLNK(mnc_indir_str)              npath = ILNBLNK(mnc_indir_str)
821              path_fname(1:npath) = mnc_indir_str(1:npath)              path_fname(1:npath) = mnc_indir_str(1:npath)
822              path_fname((npath+1):(npath+nfname)) = fname(1:nfname)              path_fname((npath+1):(npath+nfname)) = fname(1:nfname)
823              fname(1:MNC_MAX_CHAR) = path_fname(1:MNC_MAX_CHAR)              fname(1:MNC_MAX_PATH) = path_fname(1:MNC_MAX_PATH)
824              nfname = npath + nfname              nfname = npath + nfname
825            ENDIF            ENDIF
826    
# Line 673  C           zero sequence number inserte Line 844  C           zero sequence number inserte
844            ENDIF            ENDIF
845            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
846    
847            write(msgbuf,'(6a)')            write(msgbuf,'(5a)')
848       &         'MNC_CW_RX_R: cannot get id for variable ''',       &         'MNC_CW_RX_R: cannot get id for variable ''',
849       &         vtype(nvf:nvl), '''in file ''', fname(1:nfname), ''''       &         vtype(nvf:nvl), '''in file ''', fname(1:nfname), ''''
850            err = NF_INQ_VARID(fid, vtype, idv)            err = NF_INQ_VARID(fid, vtype, idv)
851            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
852              f_or_t = 0
853    
854    #else
855    
856    C         The sequence for PER-FACE and PER-TILE is:
857    C         (1) check whether a PER-FACE file exists
858    C         .   (a) if only one face is used for the entire domain,
859    C         .       then omit the face index from the file name
860    C         .   (b) if the PER-FACE file exists and is somehow faulty,
861    C         .       then we die with an error message
862    C         (2) if no PER-FACE file exists, then use a PER-TILE file
863    
864    C         Create the PER-FACE file name
865              n1 = IFNBLNK(fbname)
866              n2 = ILNBLNK(fbname)
867    C         Add an iteraton count to the file name if its requested
868              IF (mnc_cw_cit(1,mnc_cw_fgci(indfg)) .LT. 0) THEN
869                WRITE(fname,'(a,a1)') fbname(n1:n2), '.'
870              ELSE
871                WRITE(fname,'(a,a1,i10.10,a1)') fbname(n1:n2), '.',
872         &            mnc_cw_cit(2,mnc_cw_fgci(indfg)), '.'
873              ENDIF
874              ntot = ILNBLNK(fname)
875              path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
876              npath = ILNBLNK(mnc_indir_str)
877    C         Add the face index
878              CALL MNC_CW_GET_FACE_NUM( lbi,lbj, uniq_fnum, myThid)
879              IF ( uniq_fnum .EQ. -1 ) THEN
880    C           There is only one face
881                WRITE(path_fname,'(2a,a2)')
882         &           mnc_indir_str(1:npath), fname(1:ntot), 'nc'
883              ELSE
884                CALL MNC_PSNCM(tmpnm, uniq_fnum, MNC_DEF_FMNC)
885                k = ILNBLNK(tmpnm)
886                WRITE(path_fname,'(2a,a1,a,a3)')
887         &           mnc_indir_str(1:npath), fname(1:ntot), 'f',
888         &           tmpnm(1:k), '.nc'
889              ENDIF
890    
891    C         Try to open the PER-FACE file
892    C         WRITE(*,*) 'trying: "', path_fname, '"'
893              err = NF_OPEN(path_fname, NF_NOWRITE, fid)
894              IF ( err .EQ. NF_NOERR ) THEN
895                f_or_t = 1
896              ELSE
897    
898    C           Create the PER-TILE file name
899                CALL MNC_PSNCM(tmpnm, uniq_tnum, MNC_DEF_TMNC)
900                k = ILNBLNK(tmpnm)
901                path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
902                WRITE(path_fname,'(2a,a1,a,a3)')
903         &           mnc_indir_str(1:npath), fname(1:ntot), 't',
904         &           tmpnm(1:k), '.nc'
905    C           WRITE(*,*) 'trying: "', path_fname, '"'
906                err = NF_OPEN(path_fname, NF_NOWRITE, fid)
907                IF ( err .EQ. NF_NOERR ) THEN
908                  f_or_t = 0
909                ELSE
910                  k = ILNBLNK(path_fname)
911                  write(msgbuf,'(4a)')
912         &             'MNC_CW_RX_R: cannot open either a per-face or a ',
913         &             'per-tile file: last try was ''', path_fname(1:k),
914         &             ''''
915                  CALL print_error(msgbuf, mythid)
916                  STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
917                ENDIF
918    
919              ENDIF
920    
921              ntot = ILNBLNK(path_fname)
922              write(msgbuf,'(5a)')
923         &         'MNC_CW_RX_R: cannot get netCDF id for variable ''',
924         &         vtype(nvf:nvl), ''' in file ''', path_fname(1:ntot),
925         &         ''''
926              err = NF_INQ_VARID(fid, vtype, idv)
927              CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
928    
929              k = ILNBLNK(path_fname)
930              fname(1:k) = path_fname(1:k)
931              nfname = k
932    
933    #endif
934    
935              IF ( f_or_t .EQ. 1 ) THEN
936    
937    C           write(msgbuf,'(2a)')
938    C           &           'MNC_CW_RX_R: per-face reads are not yet ',
939    C           &           'implemented -- so pester Ed to finish them'
940    C           CALL print_error(msgbuf, mythid)
941    C           STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
942                
943    C           Get the X,Y PER-FACE offsets
944                CALL MNC_CW_GET_XYFO(lbi,lbj, ixoff,iyoff, myThid)
945    
946              ENDIF
947    
948    C         WRITE(*,*) 'f_or_t = ',f_or_t
949    
950  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
951  C         are compatible and WARN (only warn) if not  C         are compatible and WARN (only warn) if not
# Line 755  C         the unlimited dimension offset Line 1023  C         the unlimited dimension offset
1023              IF (i .LE. ndim) THEN              IF (i .LE. ndim) THEN
1024                s(i) = mnc_cw_is(i,igrid)                s(i) = mnc_cw_is(i,igrid)
1025                e(i) = mnc_cw_ie(i,igrid)                e(i) = mnc_cw_ie(i,igrid)
1026    
1027                  IF ( f_or_t .EQ. 1 ) THEN
1028    C               Add the per-face X,Y offsets to the udo offset vector
1029    C               since they accomplish the same thing
1030                    IF ( mnc_cw_dn(i,igrid)(1:1) .EQ. 'X' ) THEN
1031                      udo(i) = ixoff - 1
1032                    ELSEIF ( mnc_cw_dn(i,igrid)(1:1) .EQ. 'Y' ) THEN
1033                      udo(i) = iyoff - 1
1034                    ENDIF
1035                  ENDIF
1036    
1037              ENDIF              ENDIF
1038  C           Check for the unlimited dimension  C           Check for the unlimited dimension
1039              IF ((i .EQ. ndim)              IF ((i .EQ. ndim)
# Line 828  C         Read the variable one vector a Line 1107  C         Read the variable one vector a
1107        IF (vcount(1) .GT. MNC_MAX_BUFF) THEN        IF (vcount(1) .GT. MNC_MAX_BUFF) THEN
1108          write(msgbuf,'(2a,I7,a)') 'MNC_MAX_BUFF is too small',          write(msgbuf,'(2a,I7,a)') 'MNC_MAX_BUFF is too small',
1109       &       '--please increase to at least ',       &       '--please increase to at least ',
1110       &       vcount(1), ' in ''MNC_SIZE.h'''       &       vcount(1), ' in ''MNC_BUFF.h'''
1111          CALL PRINT_ERROR(msgBuf , 1)          CALL PRINT_ERROR(msgBuf , 1)
1112          STOP 'ABNORMAL END: S/R MNC_CW_RX_R_OFFSET'          STOP 'ABNORMAL END: S/R MNC_CW_RX_R_OFFSET'
1113        ENDIF        ENDIF
Legend:
Removed from v.1.31  
changed lines
  Added in v.1.39
  ViewVC Help
Powered by ViewVC 1.1.22