/[MITgcm]/MITgcm/model/src/load_grid_spacing.F
ViewVC logotype

Annotation of /MITgcm/model/src/load_grid_spacing.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.2 - (hide annotations) (download)
Wed Nov 29 04:39:06 2006 UTC (17 years, 6 months ago) by jmc
Branch: MAIN
CVS Tags: mitgcm_mapl_00, checkpoint58u_post, checkpoint58w_post, checkpoint60, checkpoint61, checkpoint62, checkpoint58x_post, checkpoint58t_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint59, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint58y_post, checkpoint58v_post, checkpoint58s_post, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.1: +93 -21 lines 
setting both delR & delRc => no assumption on vertical grid (center@middle
 or interface@middle) ; + allow to load delR & delRc from (binary) file.
1 jmc 1.2 C $Header: /u/gcmpack/MITgcm/model/src/load_grid_spacing.F,v 1.1 2005/07/31 22:07:48 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4 jmc 1.2 c #include "PACKAGES_CONFIG.h"
5 jmc 1.1 #include "CPP_OPTIONS.h"
6    
7     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
8     CBOP
9     C !ROUTINE: LOAD_GRID_SPACING
10     C !INTERFACE:
11     SUBROUTINE LOAD_GRID_SPACING( myThid )
12    
13     C !DESCRIPTION:
14 jmc 1.2 C load grid-spacing (vector array) delX, delY, delR or delRc from file.
15    
16 jmc 1.1 C !USES:
17     IMPLICIT NONE
18     #include "SIZE.h"
19     #include "EEPARAMS.h"
20     #include "PARAMS.h"
21 jmc 1.2 c #include "GRID.h"
22 jmc 1.1
23     C !INPUT/OUTPUT PARAMETERS:
24 jmc 1.2 C myThid :: my Thread Id. number
25 jmc 1.1 INTEGER myThid
26     CEOP
27    
28     C !LOCAL VARIABLES:
29     C tmp4delX :: temporary arrays to read in delX
30     C tmp8delX :: temporary arrays to read in delX
31     C tmp4delY :: temporary arrays to read in delY
32     C tmp8delY :: temporary arrays to read in delY
33 jmc 1.2 C tmp4delR :: temporary arrays to read in delR
34     C tmp8delR :: temporary arrays to read in delR
35     C tmp4delRc :: temporary arrays to read in delRc
36     C tmp8delRc :: temporary arrays to read in delRc
37 jmc 1.1 C msgBuf :: Informational/error meesage buffer
38     C iUnit :: Work variable for IO unit number
39 jmc 1.2 C rcLen1 :: record length of 1 element to read
40     C i, j, k :: Loop counters
41     REAL*4 tmp4delX(Nx), tmp4delY(Ny), tmp4delR(Nr), tmp4delRc(Nr+1)
42     REAL*8 tmp8delX(Nx), tmp8delY(Ny), tmp8delR(Nr), tmp8delRc(Nr+1)
43 jmc 1.1 CHARACTER*(MAX_LEN_MBUF) msgBuf
44 jmc 1.2 INTEGER i, j, k, iLen, iUnit, rcLen1
45 jmc 1.1 INTEGER ILNBLNK
46     EXTERNAL ILNBLNK
47    
48 jmc 1.2 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
49    
50     _BEGIN_MASTER( myThid )
51     rcLen1 = WORDLENGTH
52     IF (readBinaryPrec.EQ.precFloat64) rcLen1 = WORDLENGTH*2
53    
54 jmc 1.1 C X coordinate
55     IF ( delXFile .NE. ' ' ) THEN
56     CALL MDSFINDUNIT( iUnit, myThid )
57     iLen = ILNBLNK(delXFile)
58     IF (readBinaryPrec.EQ.precFloat32) THEN
59     OPEN(iUnit, FILE=delXFile(1:iLen), STATUS='OLD',
60 jmc 1.2 & FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Nx)
61 jmc 1.1 READ(iUnit,rec=1) tmp4delX
62     CLOSE(iUnit)
63     #ifdef _BYTESWAPIO
64     CALL MDS_BYTESWAPR4( Nx, tmp4delX )
65     #endif
66     DO i=1,Nx
67     delX(i) = tmp4delX(i)
68     ENDDO
69     ELSEIF (readBinaryPrec.EQ.precFloat64) THEN
70     OPEN(iUnit, FILE=delXFile(1:iLen), STATUS='OLD',
71 jmc 1.2 & FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Nx)
72 jmc 1.1 READ(iUnit,rec=1) tmp8delX
73     CLOSE(iUnit)
74     #ifdef _BYTESWAPIO
75     CALL MDS_BYTESWAPR8( Nx, tmp8delX )
76     #endif
77     DO i=1,Nx
78     delX(i) = tmp8delX(i)
79     ENDDO
80     ENDIF
81     WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',
82     & ' delX loaded from file: ', delXFile(1:iLen)
83     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
84 jmc 1.2 & SQUEEZE_RIGHT , myThid )
85 jmc 1.1 ENDIF
86    
87     C Y coordinate
88     IF ( delYFile .NE. ' ' ) THEN
89     CALL MDSFINDUNIT( iUnit, myThid )
90     iLen = ILNBLNK(delYFile)
91     IF (readBinaryPrec.EQ.precFloat32) THEN
92     OPEN(iUnit, FILE=delYFile(1:iLen), STATUS='OLD',
93 jmc 1.2 & FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Ny)
94 jmc 1.1 READ(iUnit,rec=1) tmp4delY
95     CLOSE(iUnit)
96     #ifdef _BYTESWAPIO
97     CALL MDS_BYTESWAPR4( Ny, tmp4delY )
98     #endif
99     DO j=1,Ny
100     delY(j) = tmp4delY(j)
101     ENDDO
102     ELSEIF (readBinaryPrec.EQ.precFloat64) THEN
103     OPEN(iUnit, FILE=delYFile(1:iLen), STATUS='OLD',
104 jmc 1.2 & FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Ny)
105 jmc 1.1 READ(iUnit,rec=1) tmp8delY
106     CLOSE(iUnit)
107     #ifdef _BYTESWAPIO
108     CALL MDS_BYTESWAPR8( Ny, tmp8delY )
109     #endif
110     DO j=1,Ny
111     delY(j) = tmp8delY(j)
112     ENDDO
113     ENDIF
114     WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',
115     & ' delY loaded from file: ', delYFile(1:iLen)
116     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
117 jmc 1.2 & SQUEEZE_RIGHT , myThid )
118     ENDIF
119    
120     C vertical coordinate "R"
121     IF ( delRFile .NE. ' ' ) THEN
122     CALL MDSFINDUNIT( iUnit, myThid )
123     iLen = ILNBLNK(delRFile)
124     IF (readBinaryPrec.EQ.precFloat32) THEN
125     OPEN(iUnit, FILE=delRFile(1:iLen), STATUS='OLD',
126     & FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Nr)
127     READ(iUnit,rec=1) tmp4delR
128     CLOSE(iUnit)
129     #ifdef _BYTESWAPIO
130     CALL MDS_BYTESWAPR4( Nr, tmp4delR )
131     #endif
132     DO k=1,Nr
133     delR(k) = tmp4delR(k)
134     ENDDO
135     ELSEIF (readBinaryPrec.EQ.precFloat64) THEN
136     OPEN(iUnit, FILE=delRFile(1:iLen), STATUS='OLD',
137     & FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Nr)
138     READ(iUnit,rec=1) tmp8delR
139     CLOSE(iUnit)
140     #ifdef _BYTESWAPIO
141     CALL MDS_BYTESWAPR8( Nr, tmp8delR )
142     #endif
143     DO k=1,Nr
144     delR(k) = tmp8delR(k)
145     ENDDO
146     ENDIF
147     WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',
148     & ' delR loaded from file: ', delRFile(1:iLen)
149     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
150     & SQUEEZE_RIGHT , myThid )
151     ENDIF
152    
153     IF ( delRcFile .NE. ' ' ) THEN
154     CALL MDSFINDUNIT( iUnit, myThid )
155     iLen = ILNBLNK(delRcFile)
156     IF (readBinaryPrec.EQ.precFloat32) THEN
157     OPEN(iUnit, FILE=delRcFile(1:iLen), STATUS='OLD',
158     & FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*(Nr+1))
159     READ(iUnit,rec=1) tmp4delRc
160     CLOSE(iUnit)
161     #ifdef _BYTESWAPIO
162     CALL MDS_BYTESWAPR4( Nr+1, tmp4delRc )
163     #endif
164     DO k=1,Nr+1
165     delRc(k) = tmp4delRc(k)
166     ENDDO
167     ELSEIF (readBinaryPrec.EQ.precFloat64) THEN
168     OPEN(iUnit, FILE=delRcFile(1:iLen), STATUS='OLD',
169     & FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*(Nr+1))
170     READ(iUnit,rec=1) tmp8delRc
171     CLOSE(iUnit)
172     #ifdef _BYTESWAPIO
173     CALL MDS_BYTESWAPR8( Nr+1, tmp8delRc )
174     #endif
175     DO k=1,Nr+1
176     delRc(k) = tmp8delRc(k)
177     ENDDO
178     ENDIF
179     WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',
180     & ' delRc loaded from file: ', delRcFile(1:iLen)
181     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
182     & SQUEEZE_RIGHT , myThid )
183 jmc 1.1 ENDIF
184    
185 jmc 1.2 _END_MASTER(myThid)
186 jmc 1.1 C-- Everyone else must wait for the parameters to be loaded
187     _BARRIER
188    
189     RETURN
190     END
  ViewVC Help
Powered by ViewVC 1.1.22