/[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.33 by edhill, Mon Sep 19 02:24:40 2005 UTC revision 1.41 by mlosch, Thu May 22 08:29:59 2008 UTC
# Line 108  CEOP Line 108  CEOP
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, uniq_fnum, 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_CHAR) tmpnm        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 134  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 186  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    
# Line 213  C         Create the file name Line 222  C         Create the file name
222            CALL MNC_PSNCM(tmpnm, uniq_tnum, MNC_DEF_TMNC)            CALL MNC_PSNCM(tmpnm, uniq_tnum, MNC_DEF_TMNC)
223            k = ILNBLNK(tmpnm)            k = ILNBLNK(tmpnm)
224            IF ( mnc_cw_cit(1,mnc_cw_fgci(indfg)) .GT. -1 ) THEN            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),              write(fname,'(a,a1,i10.10,a2,a,a3)') fbname(n1:n2),
229       &           '.', mnc_cw_cit(2,mnc_cw_fgci(indfg)),       &           '.', j, '.t', tmpnm(1:k), '.nc'
      &           '.t',tmpnm(1:k),'.nc'  
230            ELSEIF ( mnc_cw_cit(1,mnc_cw_fgci(indfg)) .EQ. -1 ) THEN            ELSEIF ( mnc_cw_cit(1,mnc_cw_fgci(indfg)) .EQ. -1 ) THEN
231  C           Leave off the myIter value entirely  C           Leave off the myIter value entirely
232              write(fname,'(a,a2,a,a3)') fbname(n1:n2), '.t',              write(fname,'(a,a2,a,a3)') fbname(n1:n2), '.t',
# Line 235  C           We have an error--bad flag v Line 246  C           We have an error--bad flag v
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 302  C               we are all done writing Line 313  C               we are all done writing
313                    CALL print_error(msgbuf, mythid)                    CALL print_error(msgbuf, mythid)
314                    STOP 'ABNORMAL END: S/R MNC_CW_RX_W'                    STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
315                  ENDIF                  ENDIF
316                  mnc_cw_cit(2,mnc_cw_fgci(indfg))                  mnc_cw_fgis(indfg) = mnc_cw_cit(3,mnc_cw_fgci(indfg))
317       &               = mnc_cw_cit(3,mnc_cw_fgci(indfg))  C               DO NOT BUMP THE CURRENT ITER FOR ALL FILES IN THIS CITER
318                  mnc_cw_cit(3,mnc_cw_fgci(indfg)) = -1  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  #endif
325                  fs_isdone = 1                  fs_isdone = 1
326                  GOTO 10                  GOTO 10
# Line 337  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 438  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, rvm(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    CMLC     it may be better to use the attribute _FillValue, or both
520    CML            write(msgbuf,'(4a)') 'writing attribute ''_FillValue''',
521    CML     &           ' within file ''', fname(1:nfname), ''''
522    CML            IF (stype(1:1) .EQ. 'D') THEN
523    CML              err = NF_PUT_ATT_DOUBLE(fid, idv, '_FillValue',
524    CML     &             NF_DOUBLE, 1, dvm(2))
525    CML            ELSEIF (stype(1:1) .EQ. 'R') THEN
526    CML              err = NF_PUT_ATT_REAL(fid, idv, '_FillValue',
527    CML     &             NF_FLOAT, 1, rvm(2))
528    CML            ELSEIF (stype(1:1) .EQ. 'I') THEN
529    CML              err = NF_PUT_ATT_INT(fid, idv, '_FillValue',
530    CML     &             NF_INT, 1, ivm(2))
531    CML            ENDIF
532    CML            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
533              ENDIF
534    
535            CALL MNC_FILE_ENDDEF(fname, myThid)            CALL MNC_FILE_ENDDEF(fname, myThid)
536    
# Line 501  C         Write the variable one vector Line 581  C         Write the variable one vector
581          STOP 'ABNORMAL END: S/R MNC_CW_RX_W_OFFSET'          STOP 'ABNORMAL END: S/R MNC_CW_RX_W_OFFSET'
582        ENDIF        ENDIF
583    
584        IF (stype(1:1) .EQ. 'D') THEN        IF (use_missing) THEN
585          DO j1 = s(1),e(1)  
586            k1 = k2 + j1          IF (stype(1:1) .EQ. 'D') THEN
587            kr = kr + 1            DO j1 = s(1),e(1)
588            resh_d(kr) = var(k1)              k1 = k2 + j1
589          ENDDO              kr = kr + 1
590          err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d)              dval = var(k1)
591        ENDIF              IF (dval .EQ. dvm(1)) THEN
592        IF (stype(1:1) .EQ. 'R') THEN                resh_d(kr) = dvm(2)
593          DO j1 = s(1),e(1)              ELSE
594            k1 = k2 + j1                resh_d(kr) = dval
595            kr = kr + 1              ENDIF
596            resh_r(kr) = var(k1)            ENDDO
597          ENDDO            err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d)
598          err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh_r)          ELSEIF (stype(1:1) .EQ. 'R') THEN
599        ENDIF            DO j1 = s(1),e(1)
600        IF (stype(1:1) .EQ. 'I') THEN              k1 = k2 + j1
601          DO j1 = s(1),e(1)              kr = kr + 1
602            k1 = k2 + j1              rval = var(k1)
603            kr = kr + 1              IF (rval .EQ. rvm(1)) THEN
604            resh_i(kr) = MNC2I( var(k1) )                resh_r(kr) = rvm(2)
605          ENDDO              ELSE
606          err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh_i)                resh_r(kr) = rval
607        ENDIF              ENDIF
608              ENDDO
609              err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh_r)
610            ELSEIF (stype(1:1) .EQ. 'I') THEN
611              DO j1 = s(1),e(1)
612                k1 = k2 + j1
613                kr = kr + 1
614                ival = MNC2I( var(k1) )
615                IF (ival .EQ. ivm(1)) THEN
616                  resh_i(kr) = ivm(2)
617                ELSE
618                  resh_i(kr) = ival
619                ENDIF
620              ENDDO
621              err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh_i)
622            ENDIF
623    
624          ELSE
625            
626            IF (stype(1:1) .EQ. 'D') THEN
627              DO j1 = s(1),e(1)
628                k1 = k2 + j1
629                kr = kr + 1
630                resh_d(kr) = var(k1)
631              ENDDO
632              err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d)
633            ELSEIF (stype(1:1) .EQ. 'R') THEN
634              DO j1 = s(1),e(1)
635                k1 = k2 + j1
636                kr = kr + 1
637                resh_r(kr) = var(k1)
638              ENDDO
639              err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh_r)
640            ELSEIF (stype(1:1) .EQ. 'I') THEN
641              DO j1 = s(1),e(1)
642                k1 = k2 + j1
643                kr = kr + 1
644                resh_i(kr) = MNC2I( var(k1) )
645              ENDDO
646              err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh_i)
647            ENDIF
648    
649          ENDIF
650        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
651    
652                      ENDDO                      ENDDO
# Line 537  C         Write the variable one vector Line 658  C         Write the variable one vector
658    
659  C         Sync the file  C         Sync the file
660            err = NF_SYNC(fid)            err = NF_SYNC(fid)
661            write(msgbuf,'(3a)') 'sync for file ''', fname,            nf = ILNBLNK( fname )
662              write(msgbuf,'(3a)') 'sync for file ''', fname(1:nf),
663       &         ''' in S/R MNC_CW_RX_W'       &         ''' in S/R MNC_CW_RX_W'
664            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
665    
# Line 595  C !INTERFACE: Line 717  C !INTERFACE:
717       I     var,       I     var,
718       I     myThid )       I     myThid )
719    
720    C     !DESCRIPTION:
721    C     A simple wrapper for the old version of this routine.  The new
722    C     version includes the isvar argument which, for backwards
723    C     compatibility, is set to false here.
724          
725    C     !USES:
726          implicit none
727    
728    C     !INPUT PARAMETERS:
729          integer myThid, bi,bj
730          character*(*) stype, fbname, vtype
731          __V var(*)
732    CEOP
733    
734    C     !LOCAL VARIABLES:
735          LOGICAL isvar
736    
737          isvar = .FALSE.
738    
739          CALL MNC_CW_RX_R_TF(stype,fbname,bi,bj,vtype,var,isvar,myThid)
740    
741          RETURN
742          END
743    
744    
745    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
746    CBOP 0
747    C !ROUTINE: MNC_CW_RX_R
748    
749    C !INTERFACE:
750          SUBROUTINE MNC_CW_RX_R_TF(
751         I     stype,
752         I     fbname, bi,bj,
753         I     vtype,
754         I     var,
755         B     isvar,
756         I     myThid )
757    
758  C     !DESCRIPTION:  C     !DESCRIPTION:
759  C     This subroutine reads one variable from a file or a file group,  C     This subroutine reads one variable from a file or a file group,
760  C     depending upon the tile indicies.  C     depending upon the tile indicies.  If isvar is true and the
761    C     variable does not exist, then isvar is set to false and the
762    C     program continues normally.  This allows one to gracefully handle
763    C     the case of reading variables that might or might not exist.
764                
765  C     !USES:  C     !USES:
766        implicit none        implicit none
# Line 613  C     !INPUT PARAMETERS: Line 776  C     !INPUT PARAMETERS:
776        integer myThid, bi,bj        integer myThid, bi,bj
777        character*(*) stype, fbname, vtype        character*(*) stype, fbname, vtype
778        __V var(*)        __V var(*)
779          LOGICAL isvar
780  CEOP  CEOP
781    
782  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
# Line 624  C     integer f_sNx,f_sNy, alen, atype, Line 788  C     integer f_sNx,f_sNy, alen, atype,
788        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)
789        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
790        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
791        character*(MNC_MAX_CHAR) fname        character*(MNC_MAX_PATH) fname
792        character*(MNC_MAX_CHAR) fname_zs        character*(MNC_MAX_PATH) fname_zs
793        character*(MNC_MAX_CHAR) tmpnm        character*(MNC_MAX_PATH) tmpnm
794        character*(MNC_MAX_CHAR) path_fname        character*(MNC_MAX_PATH) path_fname
795          character*(MNC_MAX_PATH) bpath
796        integer indfg, fg1,fg2        integer indfg, fg1,fg2
797        REAL*8  resh_d( MNC_MAX_BUFF )        REAL*8  resh_d( MNC_MAX_BUFF )
798        REAL*4  resh_r( MNC_MAX_BUFF )        REAL*4  resh_r( MNC_MAX_BUFF )
# Line 639  C     Functions Line 804  C     Functions
804  C     Only do I/O if I am the master thread  C     Only do I/O if I am the master thread
805        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
806    
807          DO i = 1,MNC_MAX_PATH
808            bpath(i:i) = ' '
809          ENDDO
810    
811  C     Get the current index for the unlimited dimension from the file  C     Get the current index for the unlimited dimension from the file
812  C     group (or base) name  C     group (or base) name
813        fg1 = IFNBLNK(fbname)        fg1 = IFNBLNK(fbname)
# Line 688  C     Set the bi,bj indicies Line 857  C     Set the bi,bj indicies
857    
858  C         Create the file name  C         Create the file name
859            CALL MNC_CW_GET_TILE_NUM( lbi,lbj, uniq_tnum, myThid)            CALL MNC_CW_GET_TILE_NUM( lbi,lbj, uniq_tnum, myThid)
860            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)            fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
861    
862  #ifdef MNC_READ_OLDNAMES  #ifdef MNC_READ_OLDNAMES
863    
# Line 703  C         Create the file name Line 872  C         Create the file name
872    
873  C         Add the path to the file name  C         Add the path to the file name
874            IF (mnc_use_indir) THEN            IF (mnc_use_indir) THEN
875              path_fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)              path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
876              npath = ILNBLNK(mnc_indir_str)              npath = ILNBLNK(mnc_indir_str)
877              path_fname(1:npath) = mnc_indir_str(1:npath)              path_fname(1:npath) = mnc_indir_str(1:npath)
878              path_fname((npath+1):(npath+nfname)) = fname(1:nfname)              path_fname((npath+1):(npath+nfname)) = fname(1:nfname)
879              fname(1:MNC_MAX_CHAR) = path_fname(1:MNC_MAX_CHAR)              fname(1:MNC_MAX_PATH) = path_fname(1:MNC_MAX_PATH)
880              nfname = npath + nfname              nfname = npath + nfname
881            ENDIF            ENDIF
882    
# Line 735  C           zero sequence number inserte Line 904  C           zero sequence number inserte
904       &         'MNC_CW_RX_R: cannot get id for variable ''',       &         'MNC_CW_RX_R: cannot get id for variable ''',
905       &         vtype(nvf:nvl), '''in file ''', fname(1:nfname), ''''       &         vtype(nvf:nvl), '''in file ''', fname(1:nfname), ''''
906            err = NF_INQ_VARID(fid, vtype, idv)            err = NF_INQ_VARID(fid, vtype, idv)
907              IF ( isvar .AND. ( err .NE. NF_NOERR ) ) THEN
908                isvar = .FALSE.
909                RETURN
910              ENDIF
911              isvar = .TRUE.
912            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
913            f_or_t = 0            f_or_t = 0
914    
# Line 759  C         Add an iteraton count to the f Line 933  C         Add an iteraton count to the f
933       &            mnc_cw_cit(2,mnc_cw_fgci(indfg)), '.'       &            mnc_cw_cit(2,mnc_cw_fgci(indfg)), '.'
934            ENDIF            ENDIF
935            ntot = ILNBLNK(fname)            ntot = ILNBLNK(fname)
936            path_fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)            path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
937            npath = ILNBLNK(mnc_indir_str)            npath = ILNBLNK(mnc_indir_str)
938  C         Add the face index  C         Add the face index
939            CALL MNC_CW_GET_FACE_NUM( lbi,lbj, uniq_fnum, myThid)            CALL MNC_CW_GET_FACE_NUM( lbi,lbj, uniq_fnum, myThid)
# Line 785  C         WRITE(*,*) 'trying: "', path_f Line 959  C         WRITE(*,*) 'trying: "', path_f
959  C           Create the PER-TILE file name  C           Create the PER-TILE file name
960              CALL MNC_PSNCM(tmpnm, uniq_tnum, MNC_DEF_TMNC)              CALL MNC_PSNCM(tmpnm, uniq_tnum, MNC_DEF_TMNC)
961              k = ILNBLNK(tmpnm)              k = ILNBLNK(tmpnm)
962              path_fname(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)              path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
963              WRITE(path_fname,'(2a,a1,a,a3)')              WRITE(path_fname,'(2a,a1,a,a3)')
964       &           mnc_indir_str(1:npath), fname(1:ntot), 't',       &           mnc_indir_str(1:npath), fname(1:ntot), 't',
965       &           tmpnm(1:k), '.nc'       &           tmpnm(1:k), '.nc'
# Line 811  C           WRITE(*,*) 'trying: "', path Line 985  C           WRITE(*,*) 'trying: "', path
985       &         vtype(nvf:nvl), ''' in file ''', path_fname(1:ntot),       &         vtype(nvf:nvl), ''' in file ''', path_fname(1:ntot),
986       &         ''''       &         ''''
987            err = NF_INQ_VARID(fid, vtype, idv)            err = NF_INQ_VARID(fid, vtype, idv)
988              IF ( isvar .AND. ( err .NE. NF_NOERR ) ) THEN
989                isvar = .FALSE.
990                RETURN
991              ENDIF
992              isvar = .TRUE.
993            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
994    
995            k = ILNBLNK(path_fname)            k = ILNBLNK(path_fname)
Legend:
Removed from v.1.33  
changed lines
  Added in v.1.41
  ViewVC Help
Powered by ViewVC 1.1.22