/[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.2 by jmc, Wed Nov 29 04:39:06 2006 UTC revision 1.7 by jmc, Mon Dec 27 23:26:39 2010 UTC
# Line 18  C     !USES: Line 18  C     !USES:
18  #include "SIZE.h"  #include "SIZE.h"
19  #include "EEPARAMS.h"  #include "EEPARAMS.h"
20  #include "PARAMS.h"  #include "PARAMS.h"
21  c #include "GRID.h"  #include "GRID.h"
22    
23  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
24  C     myThid    :: my Thread Id. number  C     myThid    :: my Thread Id. number
25        INTEGER myThid        INTEGER myThid
26  CEOP  CEOP
27    
28  C     !LOCAL VARIABLES:  C     !FUNCTIONS:
 C     tmp4delX  :: temporary arrays to read in delX  
 C     tmp8delX  :: temporary arrays to read in delX  
 C     tmp4delY  :: temporary arrays to read in delY  
 C     tmp8delY  :: temporary arrays to read in delY  
 C     tmp4delR  :: temporary arrays to read in delR  
 C     tmp8delR  :: temporary arrays to read in delR  
 C     tmp4delRc :: temporary arrays to read in delRc  
 C     tmp8delRc :: temporary arrays to read in delRc  
 C     msgBuf    :: Informational/error meesage buffer  
 C     iUnit     :: Work variable for IO unit number  
 C     rcLen1    :: record length of 1 element to read  
 C     i, j, k   :: Loop counters  
       REAL*4 tmp4delX(Nx), tmp4delY(Ny), tmp4delR(Nr), tmp4delRc(Nr+1)  
       REAL*8 tmp8delX(Nx), tmp8delY(Ny), tmp8delR(Nr), tmp8delRc(Nr+1)  
       CHARACTER*(MAX_LEN_MBUF) msgBuf  
       INTEGER i, j, k, iLen, iUnit, rcLen1  
29        INTEGER  ILNBLNK        INTEGER  ILNBLNK
30        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
31    
32    C     !LOCAL VARIABLES:
33    C     msgBuf    :: Informational/error message buffer
34          INTEGER iLen
35          INTEGER i, j, n
36          CHARACTER*(MAX_LEN_MBUF) msgBuf
37    
38  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
39    
40        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
       rcLen1 = WORDLENGTH  
       IF (readBinaryPrec.EQ.precFloat64) rcLen1 = WORDLENGTH*2  
41    
42  C     X coordinate  C--   X coordinate
43        IF ( delXFile .NE. ' ' ) THEN        IF ( delXFile .NE. ' ' ) THEN
         CALL MDSFINDUNIT( iUnit, myThid )  
44          iLen = ILNBLNK(delXFile)          iLen = ILNBLNK(delXFile)
45          IF (readBinaryPrec.EQ.precFloat32) THEN          CALL READ_GLVEC_RL( delXFile, ' ', delX, Nx, 1, myThid )
          OPEN(iUnit, FILE=delXFile(1:iLen), STATUS='OLD',  
      &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Nx)  
          READ(iUnit,rec=1) tmp4delX  
          CLOSE(iUnit)  
 #ifdef _BYTESWAPIO  
         CALL MDS_BYTESWAPR4( Nx, tmp4delX )  
 #endif  
          DO i=1,Nx  
            delX(i) = tmp4delX(i)  
          ENDDO  
         ELSEIF (readBinaryPrec.EQ.precFloat64) THEN  
          OPEN(iUnit, FILE=delXFile(1:iLen), STATUS='OLD',  
      &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Nx)  
          READ(iUnit,rec=1) tmp8delX  
          CLOSE(iUnit)  
 #ifdef _BYTESWAPIO  
          CALL MDS_BYTESWAPR8( Nx, tmp8delX )  
 #endif  
          DO i=1,Nx  
            delX(i) = tmp8delX(i)  
          ENDDO  
         ENDIF  
46          WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',          WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',
47       &    ' delX loaded from file: ', delXFile(1:iLen)       &    ' delX loaded from file: ', delXFile(1:iLen)
48          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
49       &                      SQUEEZE_RIGHT , myThid )       &                      SQUEEZE_RIGHT , myThid )
50        ENDIF        ENDIF
51    
52  C     Y coordinate  C--   Y coordinate
53        IF ( delYFile .NE. ' ' ) THEN        IF ( delYFile .NE. ' ' ) THEN
         CALL MDSFINDUNIT( iUnit, myThid )  
54          iLen = ILNBLNK(delYFile)          iLen = ILNBLNK(delYFile)
55          IF (readBinaryPrec.EQ.precFloat32) THEN          CALL READ_GLVEC_RL( delYFile, ' ', delY, Ny, 1, myThid )
          OPEN(iUnit, FILE=delYFile(1:iLen), STATUS='OLD',  
      &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Ny)  
          READ(iUnit,rec=1) tmp4delY  
          CLOSE(iUnit)  
 #ifdef _BYTESWAPIO  
          CALL MDS_BYTESWAPR4( Ny, tmp4delY )  
 #endif  
          DO j=1,Ny  
            delY(j) = tmp4delY(j)  
          ENDDO  
         ELSEIF (readBinaryPrec.EQ.precFloat64) THEN  
          OPEN(iUnit, FILE=delYFile(1:iLen), STATUS='OLD',  
      &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Ny)  
          READ(iUnit,rec=1) tmp8delY  
          CLOSE(iUnit)  
 #ifdef _BYTESWAPIO  
          CALL MDS_BYTESWAPR8( Ny, tmp8delY )  
 #endif  
          DO j=1,Ny  
            delY(j) = tmp8delY(j)  
          ENDDO  
         ENDIF  
56          WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',          WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',
57       &    ' delY loaded from file: ', delYFile(1:iLen)       &    ' delY loaded from file: ', delYFile(1:iLen)
58          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
59       &                      SQUEEZE_RIGHT , myThid )       &                      SQUEEZE_RIGHT , myThid )
60        ENDIF        ENDIF
61    
62  C     vertical coordinate "R"  C--   vertical coordinate "R"
63        IF ( delRFile .NE. ' ' ) THEN        IF ( delRFile .NE. ' ' ) THEN
         CALL MDSFINDUNIT( iUnit, myThid )  
64          iLen = ILNBLNK(delRFile)          iLen = ILNBLNK(delRFile)
65          IF (readBinaryPrec.EQ.precFloat32) THEN          CALL READ_GLVEC_RL( delRFile, ' ', delR, Nr, 1, myThid )
          OPEN(iUnit, FILE=delRFile(1:iLen), STATUS='OLD',  
      &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Nr)  
          READ(iUnit,rec=1) tmp4delR  
          CLOSE(iUnit)  
 #ifdef _BYTESWAPIO  
          CALL MDS_BYTESWAPR4( Nr, tmp4delR )  
 #endif  
          DO k=1,Nr  
            delR(k) = tmp4delR(k)  
          ENDDO  
         ELSEIF (readBinaryPrec.EQ.precFloat64) THEN  
          OPEN(iUnit, FILE=delRFile(1:iLen), STATUS='OLD',  
      &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*Nr)  
          READ(iUnit,rec=1) tmp8delR  
          CLOSE(iUnit)  
 #ifdef _BYTESWAPIO  
          CALL MDS_BYTESWAPR8( Nr, tmp8delR )  
 #endif  
          DO k=1,Nr  
            delR(k) = tmp8delR(k)  
          ENDDO  
         ENDIF  
66          WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',          WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',
67       &    ' delR loaded from file: ', delRFile(1:iLen)       &    ' delR loaded from file: ', delRFile(1:iLen)
68          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
# Line 151  C     vertical coordinate "R" Line 70  C     vertical coordinate "R"
70        ENDIF        ENDIF
71    
72        IF ( delRcFile .NE. ' ' ) THEN        IF ( delRcFile .NE. ' ' ) THEN
         CALL MDSFINDUNIT( iUnit, myThid )  
73          iLen = ILNBLNK(delRcFile)          iLen = ILNBLNK(delRcFile)
74          IF (readBinaryPrec.EQ.precFloat32) THEN          CALL READ_GLVEC_RL( delRcFile, ' ', delRc, Nr+1, 1, myThid )
          OPEN(iUnit, FILE=delRcFile(1:iLen), STATUS='OLD',  
      &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*(Nr+1))  
          READ(iUnit,rec=1) tmp4delRc  
          CLOSE(iUnit)  
 #ifdef _BYTESWAPIO  
          CALL MDS_BYTESWAPR4( Nr+1, tmp4delRc )  
 #endif  
          DO k=1,Nr+1  
            delRc(k) = tmp4delRc(k)  
          ENDDO  
         ELSEIF (readBinaryPrec.EQ.precFloat64) THEN  
          OPEN(iUnit, FILE=delRcFile(1:iLen), STATUS='OLD',  
      &        FORM='UNFORMATTED',ACCESS='DIRECT',RECL=rcLen1*(Nr+1))  
          READ(iUnit,rec=1) tmp8delRc  
          CLOSE(iUnit)  
 #ifdef _BYTESWAPIO  
          CALL MDS_BYTESWAPR8( Nr+1, tmp8delRc )  
 #endif  
          DO k=1,Nr+1  
            delRc(k) = tmp8delRc(k)  
          ENDDO  
         ENDIF  
75          WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',          WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',
76       &    ' delRc loaded from file: ', delRcFile(1:iLen)       &    ' delRc loaded from file: ', delRcFile(1:iLen)
77          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
78       &                      SQUEEZE_RIGHT , myThid )       &                      SQUEEZE_RIGHT , myThid )
79        ENDIF        ENDIF
80    
81    C--   hybrid sigma vertical coordinate coefficient
82          IF ( hybSigmFile .NE. ' ' ) THEN
83            iLen = ILNBLNK(hybSigmFile)
84            CALL READ_GLVEC_RS( hybSigmFile,' ',aHybSigmF,Nr+1, 1,myThid )
85            CALL READ_GLVEC_RS( hybSigmFile,' ',bHybSigmF,Nr+1, 2,myThid )
86            WRITE(msgBuf,'(3A)') 'S/R LOAD_GRID_SPACING:',
87         &    ' a&b_HybSigmF loaded from file: ', hybSigmFile(1:iLen)
88            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
89         &                      SQUEEZE_RIGHT , myThid )
90          ENDIF
91    
92    C--   Check horizontal grid-spacing
93          IF ( .NOT.usingCurvilinearGrid ) THEN
94    C Note: To avoid multiple copies of the same code in several horiz.grid
95    C       initialisation S/R, check horiz.grid spacing here, after
96    C       loading delX,delY (and before calling any of these S/R).
97    
98    C--   Check delX grid-spacing:
99           n = 0
100           DO i=1,Nx
101    C-    check that delX has been set
102            IF ( delX(i).EQ.UNSET_RL ) THEN
103             n = n+1
104             WRITE(msgBuf,'(2A,I5)') 'S/R LOAD_GRID_SPACING:',
105         &       ' No value for delX at i =', i
106             CALL PRINT_ERROR( msgBuf, myThid )
107            ENDIF
108    C-    check that delX is > 0
109            IF ( delX(i).LE.0. ) THEN
110             n = n+1
111             WRITE(msgBuf,'(2A,I5,A,1PE16.8,A)') 'S/R LOAD_GRID_SPACING:',
112         &       ' delX(i=', i, ')=', delX(i), ' : MUST BE >0'
113             CALL PRINT_ERROR( msgBuf, myThid )
114            ENDIF
115           ENDDO
116           IF ( n.GE.1 ) THEN
117             WRITE(msgBuf,'(2A,I5,A)') 'S/R LOAD_GRID_SPACING:',
118         &       ' found', n, ' invalid delX values'
119             CALL PRINT_ERROR( msgBuf, myThid )
120             STOP 'ABNORMAL END: S/R LOAD_GRID_SPACING'
121           ENDIF
122    
123    C--   Check delY grid-spacing:
124           n = 0
125           DO j=1,Ny
126    C-    check that delY has been set
127            IF ( delY(j).EQ.UNSET_RL ) THEN
128             n = n+1
129             WRITE(msgBuf,'(2A,I5)') 'S/R LOAD_GRID_SPACING:',
130         &       ' No value for delY at j =', j
131             CALL PRINT_ERROR( msgBuf, myThid )
132            ENDIF
133    C-    check that delY is > 0
134            IF ( delY(j).LE.0. ) THEN
135             n = n+1
136             WRITE(msgBuf,'(2A,I5,A,1PE16.8,A)') 'S/R LOAD_GRID_SPACING:',
137         &       ' delY(j=', j, ')=', delY(j), ' : MUST BE >0'
138             CALL PRINT_ERROR( msgBuf, myThid )
139            ENDIF
140           ENDDO
141           IF ( n.GE.1 ) THEN
142             WRITE(msgBuf,'(2A,I5,A)') 'S/R LOAD_GRID_SPACING:',
143         &       ' found', n, ' invalid delY values'
144             CALL PRINT_ERROR( msgBuf, myThid )
145             STOP 'ABNORMAL END: S/R LOAD_GRID_SPACING'
146           ENDIF
147    C--   end of grid-spacing check (not usingCurvilinearGrid)
148          ENDIF
149    
150        _END_MASTER(myThid)        _END_MASTER(myThid)
151  C--   Everyone else must wait for the parameters to be loaded  C--   Everyone else must wait for the parameters to be loaded
152        _BARRIER        _BARRIER
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22