pkg/rw/write_local_rl.F

C $Header: /u/gcmpack/MITgcm/pkg/rw/write_local_rl.F,v 1.4 2005/11/04 01:33:50 jmc Exp $
C $Name:  $

#include "RW_OPTIONS.h"

      SUBROUTINE WRITE_LOCAL_RL(
     I          pref,suff,nNr,field,bi,bj,iRec,myIter,myThid)
C WRITE_LOCAL_RL 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
      INTEGER nNr
      _RL field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nNr)
      INTEGER bi,bj
      INTEGER iRec
      INTEGER myIter
      INTEGER myThid
C Functions
      INTEGER ILNBLNK,IFNBLNK
C Common
      COMMON /RD_WR_FLD/ globalFile
      LOGICAL globalFile
C Local
      CHARACTER*(2) fType
      INTEGER s1Lo,s1Hi,s2Lo,s2Hi
      CHARACTER*(MAX_LEN_FNAM) fullName

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
C
      fType='RL'
#ifdef ALLOW_MDSIO
      IF (nSx.EQ.1.AND.nSy.EQ.1) THEN
C The hack below replaces MDS_WRITELOCAL with MDSWRITEFIELD_LOC for
C single-threaded execution because the former does not support the
C singleCpuIo option. This is a placeholder until MDS_WRITELOCAL
C functionality is superseded by pkg/diagnostics.
         CALL MDSWRITEFIELD_LOC(
     &        fullName, writeBinaryPrec, globalFile,
     &        fType, nNr, field, iRec, myIter, myThid )
      ELSE
         CALL MDS_WRITELOCAL(
     &        fullName, writeBinaryPrec, globalFile,
     &        fType, nNr, field, bi, bj, iRec, myIter, myThid )
      ENDIF
#endif
      RETURN
      END
1	C $Header: /u/gcmpack/MITgcm/pkg/rw/write_local_rl.F,v 1.4 2005/11/04 01:33:50 jmc Exp $
2	C $Name: $
3
4	#include "RW_OPTIONS.h"
5
6	SUBROUTINE WRITE_LOCAL_RL(
7	I pref,suff,nNr,field,bi,bj,iRec,myIter,myThid)
8	C WRITE_LOCAL_RL is a "front-end" interface to the low-level I/O
9	C routines. It assumes single record files.
10	IMPLICIT NONE
11	C Global
12	#include "SIZE.h"
13	#include "EEPARAMS.h"
14	#include "PARAMS.h"
15	C Arguments
16	CHARACTER() pref,suff
17	INTEGER nNr
18	_RL field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nNr)
19	INTEGER bi,bj
20	INTEGER iRec
21	INTEGER myIter
22	INTEGER myThid
23	C Functions
24	INTEGER ILNBLNK,IFNBLNK
25	C Common
26	COMMON /RD_WR_FLD/ globalFile
27	LOGICAL globalFile
28	C Local
29	CHARACTER*(2) fType
30	INTEGER s1Lo,s1Hi,s2Lo,s2Hi
31	CHARACTER*(MAX_LEN_FNAM) fullName
32
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	ELSEIF ( suff .EQ. 'I10' ) THEN
41	WRITE( fullName, '(A,A,I10.10)' ) pref(s1Lo:s1Hi),'.',myIter
42	ELSE
43	s2Lo = IFNBLNK(suff)
44	s2Hi = ILNBLNK(suff)
45	WRITE( fullName, '(A,A)' ) pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
46	ENDIF
47	C
48	fType='RL'
49	#ifdef ALLOW_MDSIO
50	IF (nSx.EQ.1.AND.nSy.EQ.1) THEN
51	C The hack below replaces MDS_WRITELOCAL with MDSWRITEFIELD_LOC for
52	C single-threaded execution because the former does not support the
53	C singleCpuIo option. This is a placeholder until MDS_WRITELOCAL
54	C functionality is superseded by pkg/diagnostics.
55	CALL MDSWRITEFIELD_LOC(
56	& fullName, writeBinaryPrec, globalFile,
57	& fType, nNr, field, iRec, myIter, myThid )
58	ELSE
59	CALL MDS_WRITELOCAL(
60	& fullName, writeBinaryPrec, globalFile,
61	& fType, nNr, field, bi, bj, iRec, myIter, myThid )
62	ENDIF
63	#endif
64	RETURN
65	END