pkg/rw/write_glvec_rs.F

C $Header: /u/gcmpack/MITgcm/pkg/rw/write_glvec_rs.F,v 1.2 2009/02/04 22:55:51 jmc Exp $
C $Name:  $

#include "RW_OPTIONS.h"

CBOP
C !ROUTINE: WRITE_GLVEC_RS
C !INTERFACE:
      SUBROUTINE WRITE_GLVEC_RS(
     I           pref, suff, array, sizArr, myIter, myThid )

C !DESCRIPTION:
C WRITE_GLVEC_RS
C  is a "front-end" interface to the low-level MDS I/O routines.
C  Writes a global (=tile independent) vector.

C !USES:
      IMPLICIT NONE

C == Global Variables
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"

C !INPUT PARAMETERS:
      CHARACTER*(*) pref,suff
      INTEGER sizArr
      _RS     array(sizArr)
      INTEGER myIter
      INTEGER myThid

C !FUNCTIONS:
      INTEGER  ILNBLNK, IFNBLNK
      EXTERNAL ILNBLNK, IFNBLNK

C !LOCAL VARIABLES:
      _RL     dummyRL(1)
      CHARACTER*(2) fType
      INTEGER ioUnit, bi, bj, iRec
      INTEGER s1Lo,s1Hi,s2Lo,s2Hi
      CHARACTER*(MAX_LEN_FNAM) fullName
CEOP

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)
      ELSE
       s2Lo = IFNBLNK(suff)
       s2Hi = ILNBLNK(suff)
       WRITE( fullName, '(A,A)' ) pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
      ENDIF

      ioUnit = 0
      fType ='RS'
      bi = 0
      bj = 0
      iRec = 1
#ifdef ALLOW_MDSIO
      CALL MDS_WRITEVEC_LOC(
     I                       fullName, writeBinaryPrec, ioUnit,
     I                       fType, sizArr, dummyRL, array,
     I                       bi, bj, iRec, myIter, myThid )
#endif

      RETURN
      END
1	jmc	1.3	C $Header: /u/gcmpack/MITgcm/pkg/rw/write_glvec_rs.F,v 1.2 2009/02/04 22:55:51 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "RW_OPTIONS.h"
5
6			CBOP
7			C !ROUTINE: WRITE_GLVEC_RS
8			C !INTERFACE:
9			SUBROUTINE WRITE_GLVEC_RS(
10			I pref, suff, array, sizArr, myIter, myThid )
11
12			C !DESCRIPTION:
13	jmc	1.3	C WRITE_GLVEC_RS
14			C is a "front-end" interface to the low-level MDS I/O routines.
15	jmc	1.1	C Writes a global (=tile independent) vector.
16
17			C !USES:
18			IMPLICIT NONE
19
20			C == Global Variables
21			#include "SIZE.h"
22			#include "EEPARAMS.h"
23			#include "PARAMS.h"
24
25			C !INPUT PARAMETERS:
26			CHARACTER() pref,suff
27			INTEGER sizArr
28			_RS array(sizArr)
29			INTEGER myIter
30			INTEGER myThid
31
32			C !FUNCTIONS:
33			INTEGER ILNBLNK, IFNBLNK
34			EXTERNAL ILNBLNK, IFNBLNK
35
36			C !LOCAL VARIABLES:
37	jmc	1.3	_RL dummyRL(1)
38	jmc	1.1	CHARACTER*(2) fType
39			INTEGER ioUnit, bi, bj, iRec
40			INTEGER s1Lo,s1Hi,s2Lo,s2Hi
41			CHARACTER*(MAX_LEN_FNAM) fullName
42			CEOP
43
44			C-- Build file name
45			C Name has form 'prefix.suffix'
46			C e.g. U.0000000100
47			s1Lo = IFNBLNK(pref)
48			s1Hi = ILNBLNK(pref)
49			IF ( suff .EQ. ' ' ) THEN
50			WRITE( fullName, '(A)' ) pref(s1Lo:s1Hi)
51			ELSE
52			s2Lo = IFNBLNK(suff)
53			s2Hi = ILNBLNK(suff)
54			WRITE( fullName, '(A,A)' ) pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
55			ENDIF
56
57			ioUnit = 0
58	jmc	1.2	fType ='RS'
59	jmc	1.1	bi = 0
60			bj = 0
61			iRec = 1
62			#ifdef ALLOW_MDSIO
63			CALL MDS_WRITEVEC_LOC(
64			I fullName, writeBinaryPrec, ioUnit,
65	jmc	1.3	I fType, sizArr, dummyRL, array,
66	jmc	1.1	I bi, bj, iRec, myIter, myThid )
67			#endif
68
69			RETURN
70			END