C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_grid.F,v 1.20 2008/06/20 20:36:58 utke Exp $
C $Name: $
#include "MNC_OPTIONS.h"
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C !ROUTINE: MNC_GRID_INIT
C !INTERFACE:
SUBROUTINE MNC_GRID_INIT(
I fname,
I gname,
I ndim,
I dnames,
I myThid )
C !DESCRIPTION:
C Create an MNC grid within a NetCDF file context.
C !USES:
implicit none
C !INPUT PARAMETERS:
integer myThid, ndim
character*(*) fname,gname
character*(*) dnames(ndim)
CEOP
C !LOCAL VARIABLES:
integer ind
CALL MNC_GRID_INIT_ALL(fname, gname, ndim, dnames, ind, myThid)
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C !ROUTINE: MNC_GRID_INIT_ALL
C !INTERFACE:
SUBROUTINE MNC_GRID_INIT_ALL(
I fname,
I gname,
I ndim,
I dnames,
O ind,
I myThid )
C !DESCRIPTION:
C Initialize a new conceptual (MNC inner layer) grid within a NetCDF
C file context. If the requested grid name already exists, then
C verify that it has exactly the same number of dimensions, each
C with exactly the same size and report a fatal error if not. This
C is a necessary check since the MNC inner layer does not support
C grid name re--definition.
C !USES:
implicit none
#include "MNC_COMMON.h"
#include "EEPARAMS.h"
#include "netcdf.inc"
C !INPUT PARAMETERS:
integer myThid, ndim, ind
character*(*) fname,gname
character*(*) dnames(ndim)
CEOP
C !LOCAL VARIABLES:
integer i,j,k,ii,jj,kk, n,nf, indf,indg,indd, fid, ngrid
integer ng_ind,lg_ind, ds_last, ndim_file, igr,ig1,ig2
integer ngt, ngn
character*(MAX_LEN_MBUF) msgbuf
character*(MNC_MAX_PATH) file_name
C Functions
integer ILNBLNK
C Get the file ID and indicies
DO i =1,MNC_MAX_PATH
file_name(i:i) = ' '
ENDDO
nf = ILNBLNK(fname)
IF (nf .GT. MNC_MAX_PATH) nf = MNC_MAX_PATH
file_name(1:nf) = fname(1:nf)
CALL MNC_GET_IND(MNC_MAX_FID,file_name,mnc_f_names,indf,myThid)
IF (indf .LT. 1) THEN
write(msgbuf,'(3a)') 'MNC ERROR: file ''', file_name(1:nf),
& ''' does not exist'
CALL PRINT_ERROR( msgbuf, mythid )
stop 'ABNORMAL END: S/R MNC_GRID_INIT'
ENDIF
fid = mnc_f_info(indf,2)
ngrid = mnc_f_info(indf,3)
ng_ind = 4 + 3*ngrid
IF (ngrid .EQ. 0) THEN
ds_last = 0
ELSE
lg_ind = 4 + 3*(ngrid - 1)
ds_last = mnc_f_info(indf,(lg_ind+2))
ENDIF
C Check for sufficient space in memory
i = ds_last + ndim
j = 3 + 3*(ngrid + 1)
IF ((i .GE. MNC_MAX_INFO) .OR. (j .GE. MNC_MAX_INFO)) THEN
write(msgbuf,'(2a)') 'MNC_GRID_INIT_ALL ERROR: insufficient',
& ' space--please increase MNC_MAX_INFO'
CALL PRINT_ERROR( msgbuf, mythid )
stop 'ABNORMAL END: S/R MNC_GRID_INIT_ALL'
ENDIF
C Enter DEFINE mode
CALL MNC_FILE_REDEF(fname, myThid)
ngn = ILNBLNK(gname)
C Check for grid re-definition
DO igr = 1,mnc_f_info(indf,3)
ii = 4 + 3*(igr - 1)
ngt = ILNBLNK(mnc_g_names(mnc_f_info(indf,ii)))
IF ( (ngt .EQ. ngn)
& .AND. (mnc_g_names(mnc_f_info(indf,ii))(1:ngt)
& .EQ. gname(1:ngn)) ) THEN
ig1 = mnc_f_info(indf,ii+1)
ig2 = mnc_f_info(indf,ii+2)
C Check if different number of dims
IF (ndim .NE. (ig2-ig1+1)) THEN
kk = ILNBLNK( mnc_f_names(indf) )
write(msgbuf,'(6a)') 'MNC ERROR: grid ''', gname(1:ngn),
& ''' was previously defined for file ''',
& mnc_f_names(indf)(1:kk), ''' with a different ',
& 'number of dimensions'
CALL PRINT_ERROR(msgbuf, mythid)
stop 'ABNORMAL END: S/R MNC_GRID_INIT'
ENDIF
C Check if same number of dims but different dim names
k = 0
DO jj = ig1,ig2
k = k + 1
IF (mnc_d_names(mnc_fd_ind(indf,jj)) .NE. dnames(k)) THEN
kk = ILNBLNK( mnc_f_names(indf) )
write(msgbuf,'(6a)') 'MNC ERROR: grid ''', gname(1:ngn),
& ''' was previously defined for file ''',
& mnc_f_names(indf)(1:kk), ''' with a different ',
& 'combination of dimensions'
CALL PRINT_ERROR(msgbuf, mythid)
stop 'ABNORMAL END: S/R MNC_GRID_INIT'
ENDIF
ENDDO
C Reaching this point means that the grid name WAS previously
C defined and the number and sizes of the associated dimensions
C exactly match so everything is OK and we do not need to create
C a new definition for this grid.
RETURN
ENDIF
ENDDO
C Reaching this point means the grid was NOT previously defined and
C we must therefore create a new definition.
CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_g_names,
& 'mnc_g_names', indg, myThid)
mnc_g_names(indg)(1:MNC_MAX_CHAR) =
& mnc_blank_name(1:MNC_MAX_CHAR)
n = ILNBLNK(gname)
mnc_g_names(indg)(1:n) = gname(1:n)
C Add the dimensions
DO i = 1,ndim
j = ds_last + i
n = ILNBLNK(dnames(i))
C Search for the dimension ID within the list of dimensions
C defined for this file
ndim_file = mnc_f_alld(indf,1)
indd = 0
DO ii = 1,ndim_file
jj = mnc_f_alld(indf,ii+1)
kk = ILNBLNK(mnc_d_names(jj))
IF ((n .EQ. kk)
& .AND. (dnames(i)(1:n) .EQ. mnc_d_names(jj)(1:kk))) THEN
indd = jj
GOTO 20
ENDIF
ENDDO
20 CONTINUE
IF (indd .LT. 1) THEN
write(msgbuf,'(5a)') 'MNC ERROR: dimension ''',
& dnames(i)(1:n), ''' does not exist for file ''',
& fname(1:nf), ''''
CALL PRINT_ERROR( msgbuf, mythid )
stop 'ABNORMAL END: S/R MNC_GRID_INIT'
ENDIF
mnc_fd_ind(indf,j) = indd
ENDDO
C Grid successfully added, so update file table
mnc_f_info(indf,ng_ind) = indg
mnc_f_info(indf,ng_ind+1) = ds_last + 1
mnc_f_info(indf,ng_ind+2) = ds_last + ndim
mnc_f_info(indf,3) = ngrid + 1
ind = indg
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C !ROUTINE: MNC_GRID_GET_DIMIND
C !INTERFACE:
SUBROUTINE MNC_GRID_GET_DIMIND(
I indf,
I dname,
O ind_fg_ids,
I myThid )
C !DESCRIPTION:
C Get the dimension ID (index) for the named dimension.
C !USES:
implicit none
#include "MNC_COMMON.h"
C !INPUT PARAMETERS:
integer indf, ind_fg_ids, myThid
character*(*) dname
CEOP
C !LOCAL VARIABLES:
integer i,j,k,l, n,n1, ngrid, ds,de
C Functions
integer ILNBLNK
ind_fg_ids = -1
n = ILNBLNK(dname)
ngrid = mnc_f_info(indf,3)
DO i = 1,ngrid
j = 4 + 3*(i - 1)
ds = mnc_f_info(indf,j+1)
de = mnc_f_info(indf,j+2)
DO k = ds,de
l = mnc_fd_ind(indf,k)
n1 = ILNBLNK(mnc_d_names(l))
IF ((n .EQ. n1)
& .AND. (mnc_d_names(l)(1:n1) .EQ. dname(1:n))) THEN
ind_fg_ids = k
RETURN
ENDIF
ENDDO
ENDDO
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|