pkg/rw/write_fld_xy_rs.F

C $Header: /u/gcmpack/MITgcm/pkg/rw/write_fld_xy_rs.F,v 1.5 2009/09/01 19:28:24 jmc Exp $
C $Name:  $

#include "RW_OPTIONS.h"

      SUBROUTINE WRITE_FLD_XY_RS( pref,suff,field,myIter,myThid )
C WRITE_FLD_XY_RS is a "front-end" interface to the low-level I/O
C routines. It assumes single record files.
      IMPLICIT NONE
C Global
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
C Arguments
      CHARACTER*(*) pref,suff
      _RS field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)
      INTEGER myIter
      INTEGER myThid
C Functions
      INTEGER ILNBLNK,IFNBLNK
C Common
      COMMON /RD_WR_FLD/ globalFile
      LOGICAL globalFile
C Local
      LOGICAL useCurrentDir
      _RL dummyRL(1)
      CHARACTER*(2) fType
      INTEGER nNz
      INTEGER iRec
      INTEGER s1Lo,s1Hi,s2Lo,s2Hi
      CHARACTER*(MAX_LEN_FNAM) fullName
C
C--   Build file name
C     Name has form 'prefix.suffix'
C     e.g. U.0000000100
      s1Lo = IFNBLNK(pref)
      s1Hi = ILNBLNK(pref)
      IF ( suff .EQ. ' ' ) THEN
       WRITE( fullName, '(A)' ) pref(s1Lo:s1Hi)
      ELSEIF ( suff .EQ. 'I10' ) THEN
       WRITE( fullName, '(A,A,I10.10)' ) pref(s1Lo:s1Hi),'.',myIter
      ELSE
       s2Lo = IFNBLNK(suff)
       s2Hi = ILNBLNK(suff)
       WRITE( fullName, '(A,A)' ) pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
      ENDIF

      useCurrentDir = .FALSE.
      fType='RS'
      nNz=1
      iRec=1
#ifdef ALLOW_MDSIO
      CALL MDS_WRITE_FIELD(
     I                      fullName, writeBinaryPrec,
     I                      globalFile, useCurrentDir,
     I                      fType, nNz, 1, nNz, dummyRL, field,
     I                      iRec, myIter, myThid )
#endif
      RETURN
      END
1	jmc	1.6	C $Header: /u/gcmpack/MITgcm/pkg/rw/write_fld_xy_rs.F,v 1.5 2009/09/01 19:28:24 jmc Exp $
2	jmc	1.2	C $Name: $
3	adcroft	1.1
4	jmc	1.2	#include "RW_OPTIONS.h"
5	adcroft	1.1
6	jmc	1.4	SUBROUTINE WRITE_FLD_XY_RS( pref,suff,field,myIter,myThid )
7	adcroft	1.1	C WRITE_FLD_XY_RS is a "front-end" interface to the low-level I/O
8			C routines. It assumes single record files.
9			IMPLICIT NONE
10			C Global
11			#include "SIZE.h"
12			#include "EEPARAMS.h"
13			#include "PARAMS.h"
14			C Arguments
15			CHARACTER() pref,suff
16			_RS field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)
17			INTEGER myIter
18			INTEGER myThid
19			C Functions
20			INTEGER ILNBLNK,IFNBLNK
21			C Common
22			COMMON /RD_WR_FLD/ globalFile
23			LOGICAL globalFile
24			C Local
25	jmc	1.4	LOGICAL useCurrentDir
26	jmc	1.5	_RL dummyRL(1)
27	adcroft	1.1	CHARACTER*(2) fType
28			INTEGER nNz
29	jmc	1.4	INTEGER iRec
30	adcroft	1.1	INTEGER s1Lo,s1Hi,s2Lo,s2Hi
31	jmc	1.3	CHARACTER*(MAX_LEN_FNAM) fullName
32	adcroft	1.1	C
33			C-- Build file name
34			C Name has form 'prefix.suffix'
35			C e.g. U.0000000100
36			s1Lo = IFNBLNK(pref)
37			s1Hi = ILNBLNK(pref)
38			IF ( suff .EQ. ' ' ) THEN
39			WRITE( fullName, '(A)' ) pref(s1Lo:s1Hi)
40	jmc	1.6	ELSEIF ( suff .EQ. 'I10' ) THEN
41			WRITE( fullName, '(A,A,I10.10)' ) pref(s1Lo:s1Hi),'.',myIter
42	adcroft	1.1	ELSE
43			s2Lo = IFNBLNK(suff)
44			s2Hi = ILNBLNK(suff)
45			WRITE( fullName, '(A,A)' ) pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
46			ENDIF
47	jmc	1.4
48			useCurrentDir = .FALSE.
49	adcroft	1.1	fType='RS'
50			nNz=1
51	jmc	1.4	iRec=1
52	jmc	1.2	#ifdef ALLOW_MDSIO
53	jmc	1.4	CALL MDS_WRITE_FIELD(
54			I fullName, writeBinaryPrec,
55			I globalFile, useCurrentDir,
56	jmc	1.5	I fType, nNz, 1, nNz, dummyRL, field,
57	jmc	1.4	I iRec, myIter, myThid )
58	jmc	1.2	#endif
59	adcroft	1.1	RETURN
60			END