rpa_layers/layers/write_fld_xyg_rl.F

#include "RW_OPTIONS.h"

      SUBROUTINE WRITE_FLD_XYG_RL( pref,suff,field,myIter,myThid )

C     This routine is based on WRITE_FLD_XYZ_RL from the rw package.
C     It is for writing a 3D MDS file with G (temp/density/etc.) as the vertical coordinate

      IMPLICIT NONE
C Global
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "LAYERS_SIZE.h"

C Arguments
      CHARACTER*(*) pref,suff
      _RL field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
      INTEGER myIter
      INTEGER myThid
C Functions
      INTEGER ILNBLNK,IFNBLNK
C Common
      COMMON /RD_WR_FLD/ globalFile
      LOGICAL globalFile
C Local
      LOGICAL useCurrentDir
      CHARACTER*(2) fType
      _RS dummyRS(1)
      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)
      ELSE
       s2Lo = IFNBLNK(suff)
       s2Hi = ILNBLNK(suff)
       WRITE( fullName, '(A,A)' ) pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
      ENDIF
C
      useCurrentDir = .FALSE.
      fType='RL'
      nNz=Nlayers
      iRec=1
#ifdef ALLOW_MDSIO
      CALL MDS_WRITE_FIELD(
     I                      fullName, writeBinaryPrec,
     I                      globalFile, useCurrentDir,
     I                      fType, nNz, 1, nNz, field, dummyRS,
     I                      iRec, myIter, myThid )
#endif
      RETURN
      END
1	rpa	1.1	#include "RW_OPTIONS.h"
2
3			SUBROUTINE WRITE_FLD_XYG_RL( pref,suff,field,myIter,myThid )
4
5			C This routine is based on WRITE_FLD_XYZ_RL from the rw package.
6			C It is for writing a 3D MDS file with G (temp/density/etc.) as the vertical coordinate
7
8			IMPLICIT NONE
9			C Global
10			#include "SIZE.h"
11			#include "EEPARAMS.h"
12			#include "PARAMS.h"
13			#include "LAYERS_SIZE.h"
14
15			C Arguments
16			CHARACTER() pref,suff
17			_RL field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
18			INTEGER myIter
19			INTEGER myThid
20			C Functions
21			INTEGER ILNBLNK,IFNBLNK
22			C Common
23			COMMON /RD_WR_FLD/ globalFile
24			LOGICAL globalFile
25			C Local
26			LOGICAL useCurrentDir
27			CHARACTER*(2) fType
28			_RS dummyRS(1)
29			INTEGER nNz
30			INTEGER iRec
31			INTEGER s1Lo,s1Hi,s2Lo,s2Hi
32			CHARACTER*(MAX_LEN_FNAM) fullName
33			C
34			C-- Build file name
35			C Name has form 'prefix.suffix'
36			C e.g. U.0000000100
37			s1Lo = IFNBLNK(pref)
38			s1Hi = ILNBLNK(pref)
39			IF ( suff .EQ. ' ' ) THEN
40			WRITE( fullName, '(A)' ) pref(s1Lo:s1Hi)
41			ELSE
42			s2Lo = IFNBLNK(suff)
43			s2Hi = ILNBLNK(suff)
44			WRITE( fullName, '(A,A)' ) pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
45			ENDIF
46			C
47			useCurrentDir = .FALSE.
48			fType='RL'
49			nNz=Nlayers
50			iRec=1
51			#ifdef ALLOW_MDSIO
52			CALL MDS_WRITE_FIELD(
53			I fullName, writeBinaryPrec,
54			I globalFile, useCurrentDir,
55			I fType, nNz, 1, nNz, field, dummyRS,
56			I iRec, myIter, myThid )
57			#endif
58			RETURN
59			END