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

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

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

revision 1.1 by jmc, Sun Jul 31 22:07:48 2005 UTC revision 1.2 by jmc, Wed Nov 29 04:39:06 2006 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "PACKAGES_CONFIG.h"  c #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
6    
7  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 11  C     !INTERFACE: Line 11  C     !INTERFACE:
11        SUBROUTINE LOAD_GRID_SPACING( myThid )        SUBROUTINE LOAD_GRID_SPACING( myThid )
12    
13  C     !DESCRIPTION:  C     !DESCRIPTION:
14  C     load grid-spacing (vector array) delX, delY or delR from file.  C     load grid-spacing (vector array) delX, delY, delR or delRc from file.
15  C     notes: loading of delR from file not yet implemented  
         
16  C     !USES:  C     !USES:
17        IMPLICIT NONE        IMPLICIT NONE
18  #include "SIZE.h"  #include "SIZE.h"
19  #include "EEPARAMS.h"  #include "EEPARAMS.h"
20  #include "PARAMS.h"  #include "PARAMS.h"
21  #include "GRID.h"  c #include "GRID.h"
22    
23  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
24  C     myThid - Number of this instance of INI_PARMS  C     myThid    :: my Thread Id. number
25        INTEGER myThid        INTEGER myThid
26  CEOP  CEOP
27    
# Line 31  C     tmp4delX  :: temporary arrays to r Line 30  C     tmp4delX  :: temporary arrays to r
30  C     tmp8delX  :: temporary arrays to read in delX  C     tmp8delX  :: temporary arrays to read in delX
31  C     tmp4delY  :: temporary arrays to read in delY  C     tmp4delY  :: temporary arrays to read in delY
32  C     tmp8delY  :: temporary arrays to read in delY  C     tmp8delY  :: temporary arrays to read in delY
33    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  C     msgBuf    :: Informational/error meesage buffer  C     msgBuf    :: Informational/error meesage buffer
38  C     iUnit     :: Work variable for IO unit number  C     iUnit     :: Work variable for IO unit number
39  C     i, j      :: Loop counters  C     rcLen1    :: record length of 1 element to read
40        REAL*4 tmp4delX(Nx), tmp4delY(Ny)  C     i, j, k   :: Loop counters
41        REAL*8 tmp8delX(Nx), tmp8delY(Ny)        REAL*4 tmp4delX(Nx), tmp4delY(Ny), tmp4delR(Nr), tmp4delRc(Nr+1)
42          REAL*8 tmp8delX(Nx), tmp8delY(Ny), tmp8delR(Nr), tmp8delRc(Nr+1)
43        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
44        INTEGER i, j, iLen, iUnit        INTEGER i, j, k, iLen, iUnit, rcLen1
45        INTEGER  ILNBLNK        INTEGER  ILNBLNK
46        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
47    
48    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  C     X coordinate  C     X coordinate
55        IF ( delXFile .NE. ' ' ) THEN        IF ( delXFile .NE. ' ' ) THEN
         _BEGIN_MASTER( myThid )  
56          CALL MDSFINDUNIT( iUnit, myThid )          CALL MDSFINDUNIT( iUnit, myThid )
57          iLen = ILNBLNK(delXFile)          iLen = ILNBLNK(delXFile)
58          IF (readBinaryPrec.EQ.precFloat32) THEN          IF (readBinaryPrec.EQ.precFloat32) THEN
59           OPEN(iUnit, FILE=delXFile(1:iLen), STATUS='OLD',           OPEN(iUnit, FILE=delXFile(1:iLen), STATUS='OLD',
60       &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=WORDLENGTH*Nx)       &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Nx)
61           READ(iUnit,rec=1) tmp4delX           READ(iUnit,rec=1) tmp4delX
62           CLOSE(iUnit)           CLOSE(iUnit)
63  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
# Line 59  C     X coordinate Line 68  C     X coordinate
68           ENDDO           ENDDO
69          ELSEIF (readBinaryPrec.EQ.precFloat64) THEN          ELSEIF (readBinaryPrec.EQ.precFloat64) THEN
70           OPEN(iUnit, FILE=delXFile(1:iLen), STATUS='OLD',           OPEN(iUnit, FILE=delXFile(1:iLen), STATUS='OLD',
71       &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=WORDLENGTH*2*Nx)       &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Nx)
72           READ(iUnit,rec=1) tmp8delX           READ(iUnit,rec=1) tmp8delX
73           CLOSE(iUnit)           CLOSE(iUnit)
74  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
# Line 72  C     X coordinate Line 81  C     X coordinate
81          WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',          WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',
82       &    ' delX loaded from file: ', delXFile(1:iLen)       &    ' delX loaded from file: ', delXFile(1:iLen)
83          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
84       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
         _END_MASTER(myThid)  
85        ENDIF        ENDIF
86    
87  C     Y coordinate  C     Y coordinate
88        IF ( delYFile .NE. ' ' ) THEN        IF ( delYFile .NE. ' ' ) THEN
         _BEGIN_MASTER( myThid )  
89          CALL MDSFINDUNIT( iUnit, myThid )          CALL MDSFINDUNIT( iUnit, myThid )
90          iLen = ILNBLNK(delYFile)          iLen = ILNBLNK(delYFile)
91          IF (readBinaryPrec.EQ.precFloat32) THEN          IF (readBinaryPrec.EQ.precFloat32) THEN
92           OPEN(iUnit, FILE=delYFile(1:iLen), STATUS='OLD',           OPEN(iUnit, FILE=delYFile(1:iLen), STATUS='OLD',
93       &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=WORDLENGTH*Ny)       &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Ny)
94           READ(iUnit,rec=1) tmp4delY           READ(iUnit,rec=1) tmp4delY
95           CLOSE(iUnit)           CLOSE(iUnit)
96  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
# Line 94  C     Y coordinate Line 101  C     Y coordinate
101           ENDDO           ENDDO
102          ELSEIF (readBinaryPrec.EQ.precFloat64) THEN          ELSEIF (readBinaryPrec.EQ.precFloat64) THEN
103           OPEN(iUnit, FILE=delYFile(1:iLen), STATUS='OLD',           OPEN(iUnit, FILE=delYFile(1:iLen), STATUS='OLD',
104       &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=WORDLENGTH*2*Ny)       &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Ny)
105           READ(iUnit,rec=1) tmp8delY           READ(iUnit,rec=1) tmp8delY
106           CLOSE(iUnit)           CLOSE(iUnit)
107  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
# Line 107  C     Y coordinate Line 114  C     Y coordinate
114          WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',          WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',
115       &    ' delY loaded from file: ', delYFile(1:iLen)       &    ' delY loaded from file: ', delYFile(1:iLen)
116          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
117       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
118          _END_MASTER(myThid)        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        ENDIF        ENDIF
184    
185          _END_MASTER(myThid)
186  C--   Everyone else must wait for the parameters to be loaded  C--   Everyone else must wait for the parameters to be loaded
187        _BARRIER        _BARRIER
188    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22