/[MITgcm]/MITgcm/pkg/mnc/mnc_cwrapper.F
ViewVC logotype

Diff of /MITgcm/pkg/mnc/mnc_cwrapper.F

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

revision 1.8 by edhill, Tue Mar 9 14:43:16 2004 UTC revision 1.9 by edhill, Fri Mar 19 03:28:36 2004 UTC
# Line 6  C $Name$ Line 6  C $Name$
6  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    
8        SUBROUTINE MNC_CW_ADD_GNAME(        SUBROUTINE MNC_CW_ADD_GNAME(
      I     myThid,  
9       I     name,       I     name,
10       I     ndim,       I     ndim,
11       I     dlens,       I     dlens,
12       I     dnames,       I     dnames,
13       I     inds_beg, inds_end )       I     inds_beg, inds_end,
14         I     myThid )
15    
16        implicit none        implicit none
17  #include "mnc_common.h"  #include "mnc_common.h"
# Line 34  C     Local Variables Line 34  C     Local Variables
34        nnl = ILNBLNK(name)        nnl = ILNBLNK(name)
35    
36  C     Check that this name is not already defined  C     Check that this name is not already defined
37        CALL MNC_GET_IND(myThid, MNC_MAX_ID, name, mnc_cw_gname, indg)        CALL MNC_GET_IND(MNC_MAX_ID, name, mnc_cw_gname, indg, myThid)
38        IF (indg .GT. 0) THEN        IF (indg .GT. 0) THEN
39          write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,          write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,
40       &       ''' is already defined'       &       ''' is already defined'
41          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
42          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'
43        ENDIF        ENDIF
44        CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_cw_gname,        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname,
45       &     indg)       &     indg, myThid)
46    
47        mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)        mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
48        mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)        mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)
# Line 127  C     Local Variables Line 127  C     Local Variables
127  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
128    
129        SUBROUTINE MNC_CW_INIT(        SUBROUTINE MNC_CW_INIT(
130       I     myThid,       I     sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr,
131       I     sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr )       I     myThid )
132    
133        implicit none        implicit none
134  #include "mnc_common.h"  #include "mnc_common.h"
# Line 305  C               Time dimension Line 305  C               Time dimension
305       &                 '  | ', (dn(i)(1:4), i=1,5)       &                 '  | ', (dn(i)(1:4), i=1,5)
306  #endif  #endif
307    
308                    CALL MNC_CW_ADD_GNAME(myThid, name, ndim,                    CALL MNC_CW_ADD_GNAME(name, ndim,
309       &                 dim, dn, ib, ie)       &                 dim, dn, ib, ie, myThid)
310                  ENDIF                  ENDIF
311    
312                ENDDO                ENDDO
# Line 323  C               Time dimension Line 323  C               Time dimension
323  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
324    
325        SUBROUTINE MNC_CW_ADD_VNAME(        SUBROUTINE MNC_CW_ADD_VNAME(
      I     myThid,  
326       I     vname,       I     vname,
327       I     gname,       I     gname,
328       I     bi_dim, bj_dim )       I     bi_dim, bj_dim,
329         I     myThid )
330    
331        implicit none        implicit none
332  #include "mnc_common.h"  #include "mnc_common.h"
# Line 349  C     Local Variables Line 349  C     Local Variables
349        ngl = ILNBLNK(gname)        ngl = ILNBLNK(gname)
350    
351  C     Check that this vname is not already defined  C     Check that this vname is not already defined
352        CALL MNC_GET_IND(myThid, MNC_MAX_ID, vname, mnc_cw_vname, indv)        CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
353        IF (indv .GT. 0) THEN        IF (indv .GT. 0) THEN
354          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
355       &       vname(nvf:nvl), ''' is already defined'       &       vname(nvf:nvl), ''' is already defined'
356          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
357          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
358        ENDIF        ENDIF
359        CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_cw_vname,        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname,
360       &     indv)       &     indv, myThid)
361    
362  C     Check that gname exists  C     Check that gname exists
363        CALL MNC_GET_IND(myThid, MNC_MAX_ID, gname, mnc_cw_gname, indg)        CALL MNC_GET_IND(MNC_MAX_ID, gname, mnc_cw_gname, indg, myThid)
364        IF (indg .LT. 1) THEN        IF (indg .LT. 1) THEN
365          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
366       &       gname(ngf:ngl), ''' is not defined'       &       gname(ngf:ngl), ''' is not defined'
# Line 377  C     Check that gname exists Line 377  C     Check that gname exists
377        mnc_cw_vbij(1,indv) = bi_dim        mnc_cw_vbij(1,indv) = bi_dim
378        mnc_cw_vbij(2,indv) = bj_dim        mnc_cw_vbij(2,indv) = bj_dim
379    
380        CALL MNC_CW_ADD_VATTR_TEXT(myThid,vname,1,'mitgcm_grid',gname)        CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid)
381    
382        RETURN        RETURN
383        END        END
# Line 385  C     Check that gname exists Line 385  C     Check that gname exists
385  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
386    
387        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
      I     myThid,  
388       I     vname,       I     vname,
389       I     ntat,       I     ntat,
390       I     tnames,       I     tnames,
391       I     tvals )       I     tvals,
392         I     myThid )
393    
394        implicit none        implicit none
395    
# Line 397  C     Arguments Line 397  C     Arguments
397        integer myThid, ntat        integer myThid, ntat
398        character*(*) vname, tnames(*), tvals(*)        character*(*) vname, tnames(*), tvals(*)
399    
400        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
401       &     ntat, 0, 0,       &     ntat, 0, 0,
402       &     tnames, ' ', ' ',       &     tnames, ' ', ' ',
403       &     tvals, 0, 0.0D0 )       &     tvals, 0, 0.0D0, myThid )
404    
405        RETURN        RETURN
406        END        END
# Line 408  C     Arguments Line 408  C     Arguments
408  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
409    
410        SUBROUTINE MNC_CW_ADD_VATTR_INT(        SUBROUTINE MNC_CW_ADD_VATTR_INT(
      I     myThid,  
411       I     vname,       I     vname,
412       I     niat,       I     niat,
413       I     inames,       I     inames,
414       I     ivals )       I     ivals,
415         I     myThid )
416    
417        implicit none        implicit none
418    
# Line 421  C     Arguments Line 421  C     Arguments
421        character*(*) vname, inames(*)        character*(*) vname, inames(*)
422        integer ivals(*)        integer ivals(*)
423    
424        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
425       &     0, niat, 0,       &     0, niat, 0,
426       &     ' ', inames, ' ',       &     ' ', inames, ' ',
427       &     ' ', ivals, 0.0D0 )       &     ' ', ivals, 0.0D0, myThid )
428    
429        RETURN        RETURN
430        END        END
# Line 432  C     Arguments Line 432  C     Arguments
432  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
433    
434        SUBROUTINE MNC_CW_ADD_VATTR_DBL(        SUBROUTINE MNC_CW_ADD_VATTR_DBL(
      I     myThid,  
435       I     vname,       I     vname,
436       I     ndat,       I     ndat,
437       I     dnames,       I     dnames,
438       I     dvals )       I     dvals,
439         I     myThid )
440    
441        implicit none        implicit none
442    
# Line 445  C     Arguments Line 445  C     Arguments
445        character*(*) vname, dnames(*)        character*(*) vname, dnames(*)
446        REAL*8 dvals(*)        REAL*8 dvals(*)
447    
448        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
449       &     0, 0, ndat,       &     0, 0, ndat,
450       &     ' ', ' ', dnames,       &     ' ', ' ', dnames,
451       &     ' ', 0, dvals )       &     ' ', 0, dvals, myThid )
452    
453        RETURN        RETURN
454        END        END
# Line 456  C     Arguments Line 456  C     Arguments
456  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
457    
458        SUBROUTINE MNC_CW_ADD_VATTR_ANY(        SUBROUTINE MNC_CW_ADD_VATTR_ANY(
      I     myThid,  
459       I     vname,       I     vname,
460       I     ntat,   niat,   ndat,       I     ntat,   niat,   ndat,
461       I     tnames, inames, dnames,       I     tnames, inames, dnames,
462       I     tvals,  ivals,  dvals )       I     tvals,  ivals,  dvals,
463         I     myThid )
464    
465        implicit none        implicit none
466  #include "mnc_common.h"  #include "mnc_common.h"
# Line 485  C     Local Variables Line 485  C     Local Variables
485        nvl = ILNBLNK(vname)        nvl = ILNBLNK(vname)
486    
487  C     Check that vname is defined  C     Check that vname is defined
488        CALL MNC_GET_IND(myThid, MNC_MAX_ID, vname, mnc_cw_vname, indv)        CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
489        IF (indv .LT. 1) THEN        IF (indv .LT. 1) THEN
490          write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',
491       &       vname(nvf:nvl), ''' is not defined'       &       vname(nvf:nvl), ''' is not defined'
# Line 531  C     Double Attributes Line 531  C     Double Attributes
531  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
532    
533        SUBROUTINE MNC_CW_GET_TILE_NUM(        SUBROUTINE MNC_CW_GET_TILE_NUM(
      I     myThid,  
534       I     bi, bj,       I     bi, bj,
535       O     uniq_tnum )       O     uniq_tnum,
536         I     myThid )
537    
538        implicit none        implicit none
539  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 574  CEH3      write(*,*) 'iG,jG,uniq_tnum :' Line 574  CEH3      write(*,*) 'iG,jG,uniq_tnum :'
574  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
575    
576        SUBROUTINE MNC_CW_FILE_AORC(        SUBROUTINE MNC_CW_FILE_AORC(
      I     myThid,  
577       I     fname,       I     fname,
578       O     indf )       O     indf,
579         I     myThid )
580    
581        implicit none        implicit none
582  #include "netcdf.inc"  #include "netcdf.inc"
# Line 592  C     Local Variables Line 592  C     Local Variables
592        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
593    
594  C     Check if the file is already open  C     Check if the file is already open
595        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)        CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
596        IF (indf .GT. 0) THEN        IF (indf .GT. 0) THEN
597          RETURN          RETURN
598        ENDIF        ENDIF
599    
600  C     Try to open an existing file  C     Try to open an existing file
601        CALL MNC_FILE_TRY_READ(myThid, fname, ierr, indf)        CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)
602        IF (ierr .EQ. NF_NOERR) THEN        IF (ierr .EQ. NF_NOERR) THEN
603          RETURN          RETURN
604        ENDIF        ENDIF
605    
606  C     Try to create a new one  C     Try to create a new one
607        CALL MNC_FILE_OPEN(myThid, fname, 0, indf)        CALL MNC_FILE_OPEN(fname, 0, indf, myThid)
608    
609        RETURN        RETURN
610        END        END
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22