/[MITgcm]/MITgcm/pkg/mnc/mnc_cw_cvars.F
ViewVC logotype

Diff of /MITgcm/pkg/mnc/mnc_cw_cvars.F

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

revision 1.3 by edhill, Sat Dec 18 19:42:39 2004 UTC revision 1.4 by edhill, Mon Dec 20 17:10:27 2004 UTC
# Line 4  C $Name$ Line 4  C $Name$
4  #include "MNC_OPTIONS.h"  #include "MNC_OPTIONS.h"
5    
6  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
 C CBOP 1  
 C C     !ROUTINE: MNC_CW_DEF_CVAR  
         
 C C     !INTERFACE:  
 C       SUBROUTINE MNC_CW_DEF_CVAR(  
 C      I     cvname,  
 C      I     cvnum,  
 C      I     cvdat,  
 C      I     myThid )  
   
 C C     !DESCRIPTION:  
 C C     Store data for a CF-convention coordinate variable (a vector) for  
 C C     the given dimension name.  
   
 C C     !USES:  
 C       implicit none  
 C #include "mnc_common.h"  
 C #include "EEPARAMS.h"  
   
 C C     !INPUT PARAMETERS:  
 C       character*(*) cvname  
 C       _RL cvdat(*)  
 C       integer cvnum, myThid  
 C CEOP  
   
 C C     !LOCAL VARIABLES:  
 C       integer i, imx, ind, nnf,nnl  
 C       character*(MAX_LEN_MBUF) msgbuf  
   
 C C     Functions  
 C       integer IFNBLNK, ILNBLNK  
   
 C       nnf = IFNBLNK(cvname)  
 C       nnl = ILNBLNK(cvname)  
   
 C C     Check that this name is not already defined  
 C       CALL MNC_GET_IND(MNC_MAX_ID, cvname, mnc_cw_cvnm, ind, myThid)  
 C       IF (ind .GT. 0) THEN  
 C         write(msgbuf,'(3a)') 'MNC_CW_DEF_CVAR ERROR: ''',  
 C      &       cvname(nnf:nnl), ''' is already defined'  
 C         CALL print_error(msgbuf, mythid)  
 C         stop 'ABNORMAL END: S/R MNC_CW_DEF_CVAR'  
 C       ENDIF  
 C       CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_cvnm,  
 C      &     ind, myThid)  
   
 C       imx = 0  
 C       DO i = 1,MNC_MAX_ID  
 C         IF (mnc_cw_cvnm(i)(1:1) .NE. ' ') THEN  
 C           imx = max(imx, mnc_cw_cvse(2,i))  
 C         ENDIF  
 C       ENDDO  
   
 C       IF ((MNC_CW_CVDAT - imx - 1) .LT. cvnum) THEN  
 C         write(msgbuf,'(3a)') 'MNC_CW_DEF_CVAR ERROR: out of space',  
 C      &       '--please increase size of MNC_CW_CVDAT in the file ',  
 C      &       '''mnc_common.h'''  
 C         CALL print_error(msgbuf, mythid)  
 C         stop 'ABNORMAL END: S/R MNC_CW_DEF_CVAR'  
 C       ENDIF  
   
 C       DO i = 1,cvnum  
 C         mnc_cw_cvdt(imx+i) = cvdat(i)  
 C       ENDDO  
 C       mnc_cw_cvse(1,ind) = imx + 1  
 C       mnc_cw_cvse(2,ind) = imx + cvnum  
   
 C       RETURN  
 C       END  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
7  CBOP 1  CBOP 1
8  C     !ROUTINE: MNC_CW_WRITE_CVAR  C     !ROUTINE: MNC_CW_WRITE_CVAR
9                
# Line 99  C     !USES: Line 28  C     !USES:
28  #include "EESUPPORT.h"  #include "EESUPPORT.h"
29  #include "PARAMS.h"  #include "PARAMS.h"
30  #include "GRID.h"  #include "GRID.h"
31    #ifdef ALLOW_EXCH2
32    #include "W2_EXCH2_TOPOLOGY.h"
33    #include "W2_EXCH2_PARAMS.h"
34    #endif
35    
36    C     Functions
37          integer IFNBLNK, ILNBLNK
38    
39  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
40        character*(*) fname        character*(*) fname
# Line 108  C     !INPUT PARAMETERS: Line 44  C     !INPUT PARAMETERS:
44  CEOP  CEOP
45    
46  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
47        integer i, vid, nnf,nnl, doit, err        integer i,j, vid, nnf,nnl, doit, err
48        integer nids, cv_did(1)        integer nids, cv_did(1), xtmin,ytmin
49        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
50        integer cv_start(1), cv_count(1)        integer cv_start(1), cv_count(1)
51        _RS rtmp(sNx + 2*OLx + sNy + 2*OLy + Nr)        _RS rtmp(sNx + 2*OLx + sNy + 2*OLy + Nr)
52    
 C     Functions  
       integer IFNBLNK, ILNBLNK  
   
53        nnf = IFNBLNK(cvname)        nnf = IFNBLNK(cvname)
54        nnl = ILNBLNK(cvname)        nnl = ILNBLNK(cvname)
55    
56        doit = 0        xtmin = 0
57          ytmin = 0
58    #ifdef ALLOW_EXCH2
59          xtmin = exch2_tbasex(W2_myTileList(bi))
60          ytmin = exch2_tbasey(W2_myTileList(bi))
61    #endif
62          doit = 1
63        nids = 1        nids = 1
64        cv_did(1)= did        cv_did(1)= did
65    
# Line 130  C     Check all the coordinate variables Line 69  C     Check all the coordinate variables
69          cv_start(1) = 1          cv_start(1) = 1
70          cv_count(1) = sNx          cv_count(1) = sNx
71          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
72    #ifdef ALLOW_EXCH2
73              rtmp(i) = xtmin + i
74    #else
75            rtmp(i) = xC(i,1,bi,bj)            rtmp(i) = xC(i,1,bi,bj)
76    #endif
77          ENDDO          ENDDO
         doit = 1  
78    
79        ELSEIF (cvname(nnf:nnl) .EQ. 'Xp1') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Xp1') THEN
80    
81          cv_start(1) = 1          cv_start(1) = 1
82          cv_count(1) = sNx + 1          cv_count(1) = sNx + 1
83          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
84    #ifdef ALLOW_EXCH2
85              rtmp(i) = xtmin + i
86    #else
87            rtmp(i) = xG(i,1,bi,bj)            rtmp(i) = xG(i,1,bi,bj)
88    #endif
89          ENDDO          ENDDO
         doit = 1  
90    
91        ELSEIF (cvname(nnf:nnl) .EQ. 'Xwh') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Xwh') THEN
92    
93          cv_start(1) = 1          cv_start(1) = 1
94          cv_count(1) = sNx + 2*OLx          cv_count(1) = sNx + 2*OLx
95          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
96    #ifdef ALLOW_EXCH2
97              rtmp(i) = xtmin - OLx + i
98    #else
99            rtmp(i) = xC(i,1,bi,bj)            rtmp(i) = xC(i,1,bi,bj)
100    #endif
101          ENDDO          ENDDO
102          doit = 1          
   
103        ELSEIF (cvname(nnf:nnl) .EQ. 'Y') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Y') THEN
104    
105          cv_start(1) = 1          cv_start(1) = 1
106          cv_count(1) = sNy          cv_count(1) = sNy
107          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
108    #ifdef ALLOW_EXCH2
109              rtmp(i) = ytmin + i
110    #else
111            rtmp(i) = yC(1,i,bi,bj)            rtmp(i) = yC(1,i,bi,bj)
112    #endif
113          ENDDO          ENDDO
         doit = 1  
114    
115        ELSEIF (cvname(nnf:nnl) .EQ. 'Yp1') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Yp1') THEN
116    
117          cv_start(1) = 1          cv_start(1) = 1
118          cv_count(1) = sNy + 1          cv_count(1) = sNy + 1
119          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
120    #ifdef ALLOW_EXCH2
121              rtmp(i) = ytmin + i
122    #else
123            rtmp(i) = yG(1,i,bi,bj)            rtmp(i) = yG(1,i,bi,bj)
124    #endif
125          ENDDO          ENDDO
         doit = 1  
126    
127        ELSEIF (cvname(nnf:nnl) .EQ. 'Ywh') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Ywh') THEN
128    
129          cv_start(1) = 1          cv_start(1) = 1
130          cv_count(1) = sNy + 2*OLy          cv_count(1) = sNy + 2*OLy
131          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
132    #ifdef ALLOW_EXCH2
133              rtmp(i) = ytmin - OLy + i
134    #else
135            rtmp(i) = yC(1,i-OLy,bi,bj)            rtmp(i) = yC(1,i-OLy,bi,bj)
136    #endif
137          ENDDO          ENDDO
         doit = 1  
138    
139        ELSEIF (cvname(nnf:nnl) .EQ. 'Z') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Z') THEN
140    
# Line 186  C     Check all the coordinate variables Line 143  C     Check all the coordinate variables
143          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
144            rtmp(i) = rC(i)            rtmp(i) = rC(i)
145          ENDDO          ENDDO
         doit = 1  
146    
147        ELSEIF (cvname(nnf:nnl) .EQ. 'Zp1') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Zp1') THEN
148    
# Line 195  C     Check all the coordinate variables Line 151  C     Check all the coordinate variables
151          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
152            rtmp(i) = rF(i)            rtmp(i) = rF(i)
153          ENDDO          ENDDO
154          doit = 1  
155          ELSE
156    
157            doit = 0
158    
159        ENDIF        ENDIF
160    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22