/[MITgcm]/MITgcm/pkg/fizhi/fizhi_mnc_init.F
ViewVC logotype

Annotation of /MITgcm/pkg/fizhi/fizhi_mnc_init.F

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

Revision 1.5 - (hide annotations) (download)
Thu Sep 23 03:28:42 2004 UTC (19 years, 9 months ago) by edhill
Branch: MAIN
CVS Tags: checkpoint55c_post
Changes since 1.4: +8 -1 lines 
 o finish MNC_CW_ADD_VATTR_* cleanup and add 'IF (useMNC) THEN' around
   all current sections of MNC code
   - the following tests compiled & ran with these fixes:
       exp0 global_ocean.90x40x15 aim.5l_cs dic_example hs94.cs-32x32x5
1 edhill 1.5 C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_mnc_init.F,v 1.4 2004/08/06 21:12:14 edhill Exp $
2 edhill 1.1 C $Name: $
3    
4     #include "FIZHI_OPTIONS.h"
5    
6     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7     CBOP 0
8     C !ROUTINE: FIZHI_MNC_INIT
9    
10     C !INTERFACE:
11 edhill 1.3 SUBROUTINE FIZHI_MNC_INIT( myThid )
12 edhill 1.1
13     C !DESCRIPTION:
14 edhill 1.3 C Create some pre-defined MNC grid types and variable types useful
15     C for the FIZHI package. Borrows heavily from MNC_CW_INIT().
16 edhill 1.1
17 edhill 1.3 C !USES:
18     implicit none
19     #include "SIZE.h"
20     #include "fizhi_SIZE.h"
21     #include "fizhi_land_SIZE.h"
22 edhill 1.5 #ifdef ALLOW_MNC
23     #include "MNC_PARAMS.h"
24     #endif
25 edhill 1.1
26     C !INPUT PARAMETERS:
27     integer myThid
28    
29     C !USES:
30     #ifdef ALLOW_MNC
31     #include "mnc_common.h"
32     #endif /* ALLOW_MNC */
33     #include "EEPARAMS.h"
34     CEOP
35    
36     #ifdef ALLOW_MNC
37    
38     C !LOCAL VARIABLES:
39     integer CW_MAX_LOC
40     parameter ( CW_MAX_LOC = 5 )
41     integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot
42     integer ndim, ncomb, nvch
43     character*(MNC_MAX_CHAR) name
44     character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)
45     character*(5) horz_dat(CW_MAX_LOC), hsub_dat(CW_MAX_LOC),
46     & vert_dat(CW_MAX_LOC), time_dat(CW_MAX_LOC),
47     & halo_dat(CW_MAX_LOC)
48     integer dim(CW_MAX_LOC), ib(CW_MAX_LOC), ie(CW_MAX_LOC)
49    
50     C Functions
51     integer ILNBLNK
52     external ILNBLNK
53    
54     C ......12345....12345....12345....12345....12345...
55     data horz_dat /
56     & '- ', 'U ', 'V ', 'Cen ', 'Cor ' /
57     data hsub_dat /
58     & 'xy ', 'x ', 'y ', '- ', ' ' /
59     data halo_dat /
60     & 'Hn ', 'Hy ', '-- ', ' ', ' ' /
61     data vert_dat /
62     & 'Zph ', 'Zphi ', ' ', ' ', ' ' /
63     data time_dat /
64     & '- ', 't ', ' ', ' ', ' ' /
65    
66 edhill 1.5 IF (useMNC) THEN
67    
68 edhill 1.3 C Define a few "standard" or "convenience" types
69 edhill 1.1 ncomb = 0
70     DO ihorz = 1,5
71     DO is = 1,3
72     DO ih = 1,2
73    
74     C Loop just ONCE if the Horiz component is "-"
75     ihsub = is
76     ihalo = ih
77     IF (ihorz .EQ. 1) THEN
78     IF ((is .EQ. 1) .AND. (ih .EQ. 1)) THEN
79     ihsub = 4
80     ihalo = 3
81     ELSE
82     GOTO 10
83     ENDIF
84     ENDIF
85    
86     DO ivert = 1,5
87     DO itime = 1,2
88    
89     C horiz and hsub
90     name(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
91     n = ILNBLNK(horz_dat(ihorz))
92     name(1:n) = horz_dat(ihorz)(1:n)
93     ntot = n + 1
94     name(ntot:ntot) = '_'
95     n = ILNBLNK(hsub_dat(ihsub))
96     name((ntot+1):(ntot+n)) = hsub_dat(ihsub)(1:n)
97     ntot = ntot + n
98    
99     C halo, vert, and time
100     write(name((ntot+1):(ntot+5)), '(a1,2a2)')
101     & '_', halo_dat(ihalo)(1:2), '__'
102     nvch = ILNBLNK(vert_dat(ivert))
103     n = ntot+6+nvch-1
104     name((ntot+6):(n)) = vert_dat(ivert)(1:nvch)
105     write(name((n+1):(n+3)), '(a2,a1)')
106     & '__', time_dat(itime)(1:1)
107    
108     ndim = 0
109     DO i = 1,CW_MAX_LOC
110     dn(i)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
111     dim(i) = 0
112     ib(i) = 0
113     ie(i) = 0
114     ENDDO
115    
116     C Horizontal dimensions
117     IF (halo_dat(ihalo)(1:5) .EQ. 'Hn ') THEN
118    
119     IF (hsub_dat(ihsub)(1:1) .EQ. 'x') THEN
120     ndim = ndim + 1
121     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cen')
122     & .OR. (horz_dat(ihorz)(1:1) .EQ. 'V') ) THEN
123     dn(ndim)(1:1) = 'X'
124     dim(ndim) = sNx + 2*OLx
125     ib(ndim) = OLx + 1
126     ie(ndim) = OLx + sNx
127     ENDIF
128     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cor')
129     & .OR. (horz_dat(ihorz)(1:1) .EQ. 'U') ) THEN
130     dn(ndim)(1:3) = 'Xp1'
131     dim(ndim) = sNx + 2*OLx
132     ib(ndim) = OLx + 1
133     ie(ndim) = OLx + sNx + 1
134     ENDIF
135     ENDIF
136     IF ((hsub_dat(ihsub)(1:1) .EQ. 'y')
137     & .OR. (hsub_dat(ihsub)(2:2) .EQ. 'y')) THEN
138     ndim = ndim + 1
139     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cen')
140     & .OR. (horz_dat(ihorz)(1:1) .EQ. 'U') ) THEN
141     dn(ndim)(1:1) = 'Y'
142     dim(ndim) = sNy + 2*OLy
143     ib(ndim) = OLy + 1
144     ie(ndim) = OLy + sNy
145     ENDIF
146     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cor')
147     & .OR. (horz_dat(ihorz)(1:1) .EQ. 'V') ) THEN
148     dn(ndim)(1:3) = 'Yp1'
149     dim(ndim) = sNy + 2*OLy
150     ib(ndim) = OLy + 1
151     ie(ndim) = OLy + sNy + 1
152     ENDIF
153     ENDIF
154    
155     ELSEIF (halo_dat(ihalo)(1:5) .EQ. 'Hy ') THEN
156    
157     IF (hsub_dat(ihsub)(1:1) .EQ. 'x') THEN
158     ndim = ndim + 1
159     dn(ndim)(1:3) = 'Xwh'
160     dim(ndim) = sNx + 2*OLx
161     ib(ndim) = 1
162     ie(ndim) = sNx + 2*OLx
163     ENDIF
164     IF ((hsub_dat(ihsub)(1:1) .EQ. 'y')
165     & .OR. (hsub_dat(ihsub)(2:2) .EQ. 'y')) THEN
166     ndim = ndim + 1
167     dn(ndim)(1:3) = 'Ywh'
168     dim(ndim) = sNy + 2*OLy
169     ib(ndim) = 1
170     ie(ndim) = sNy + 2*OLy
171     ENDIF
172    
173     ENDIF
174    
175     C Vertical dimension
176     IF (vert_dat(ivert)(1:5) .EQ. 'Phys ') THEN
177     ndim = ndim + 1
178     dn(ndim)(1:5) = 'Zphys'
179     dim(ndim) = NrPhys
180     ib(ndim) = 1
181     ie(ndim) = NrPhys
182     ENDIF
183     IF (vert_dat(ivert)(1:5) .EQ. 'PhysI') THEN
184     ndim = ndim + 1
185     dn(ndim)(1:7) = 'Zphysm1'
186     dim(ndim) = NrPhys - 1
187     ib(ndim) = 1
188     ie(ndim) = NrPhys - 1
189     ENDIF
190    
191     C Time dimension
192     IF ( (time_dat(itime)(1:1) .EQ. 't')
193     & .and. (ndim .ne. 0) ) THEN
194     ndim = ndim + 1
195     dn(ndim)(1:1) = 'T'
196     dim(ndim) = -1
197     ib(ndim) = 1
198     ie(ndim) = 1
199     ENDIF
200    
201     IF (ndim .GT. 0) THEN
202    
203     CALL MNC_CW_ADD_GNAME(name, ndim,
204     & dim, dn, ib, ie, myThid)
205     ENDIF
206    
207     ENDDO
208     ENDDO
209    
210     10 CONTINUE
211     ENDDO
212     ENDDO
213     ENDDO
214    
215 edhill 1.3 C Define a "fizhi_veg" type to be used in FIZHI_INIT_VEG()
216     C
217     C name 1234567890
218     ndim = 3
219     dn(1)(1:10) = 'X '
220     dim(1) = sNx + 2*OLx
221     ib(1) = OLx + 1
222     ie(1) = OLx + sNx
223     dn(2)(1:10) = 'Y '
224     dim(2) = sNy + 2*OLy
225     ib(2) = OLy + 1
226     ie(2) = OLy + sNy
227     dn(3)(1:10) = 'VegType '
228     dim(3) = maxtyp
229     ib(3) = 1
230     ie(3) = maxtyp
231    
232     CALL MNC_CW_ADD_GNAME('fizhi_veg', ndim, dim, dn,ib,ie, myThid)
233     CALL MNC_CW_ADD_VNAME('surftype', 'fizhi_veg', 4,5, myThid)
234     CALL MNC_CW_ADD_VNAME('tilefrac', 'fizhi_veg', 4,5, myThid)
235    
236 edhill 1.4 C Used for the pickups
237     CALL MNC_CW_ADD_VNAME('uphy', 'U_xy_Hn__Zph__-' ,4,5,myThid)
238     CALL MNC_CW_ADD_VNAME('vphy', 'V_xy_Hn__Zph__-' ,4,5,myThid)
239     CALL MNC_CW_ADD_VNAME('thphy','Cen_xy_Hn__Zph__-',4,5,myThid)
240     CALL MNC_CW_ADD_VNAME('sphy', 'Cen_xy_Hn__Zph__-',4,5,myThid)
241    
242     C For the veg IO
243     C name 1234567890
244     ndim = 1
245     dn(1)(1:10) = 'chips '
246     dim(1) = nchp
247     ib(1) = 1
248     ie(1) = nchp
249     CALL MNC_CW_ADD_GNAME('fizhi_chip', ndim, dim, dn,ib,ie, myThid)
250     CALL MNC_CW_ADD_VNAME('ctmt', 'fizhi_chip', 2,3, myThid)
251     CALL MNC_CW_ADD_VNAME('xxmt', 'fizhi_chip', 2,3, myThid)
252     CALL MNC_CW_ADD_VNAME('yymt', 'fizhi_chip', 2,3, myThid)
253     CALL MNC_CW_ADD_VNAME('zetamt', 'fizhi_chip', 2,3, myThid)
254     CALL MNC_CW_ADD_VNAME('tcanopy', 'fizhi_chip', 2,3, myThid)
255     CALL MNC_CW_ADD_VNAME('tdeep', 'fizhi_chip', 2,3, myThid)
256     CALL MNC_CW_ADD_VNAME('ecanopy', 'fizhi_chip', 2,3, myThid)
257     CALL MNC_CW_ADD_VNAME('swetshal', 'fizhi_chip', 2,3, myThid)
258     CALL MNC_CW_ADD_VNAME('swetroot', 'fizhi_chip', 2,3, myThid)
259     CALL MNC_CW_ADD_VNAME('swetdeep', 'fizhi_chip', 2,3, myThid)
260     CALL MNC_CW_ADD_VNAME('snodep', 'fizhi_chip', 2,3, myThid)
261     CALL MNC_CW_ADD_VNAME('capac', 'fizhi_chip', 2,3, myThid)
262     CALL MNC_CW_ADD_VNAME('chlt', 'fizhi_chip', 2,3, myThid)
263     CALL MNC_CW_ADD_VNAME('chlon', 'fizhi_chip', 2,3, myThid)
264     CALL MNC_CW_ADD_VNAME('igrd', 'fizhi_chip', 2,3, myThid)
265     CALL MNC_CW_ADD_VNAME('ityp', 'fizhi_chip', 2,3, myThid)
266     CALL MNC_CW_ADD_VNAME('chfr', 'fizhi_chip', 2,3, myThid)
267    
268     C name 1234567890
269     ndim = 2
270     dn(1)(1:10) = 'chips '
271     dim(1) = nchp
272     ib(1) = 1
273     ie(1) = nchp
274     dn(2)(1:10) = 'Zph '
275     dim(2) = NrPhys
276     ib(2) = 1
277     ie(2) = NrPhys
278     CALL MNC_CW_ADD_GNAME('fizhi_chiplev',ndim,dim,dn,ib,ie,myThid)
279     CALL MNC_CW_ADD_VNAME('xlmt', 'fizhi_chiplev', 3,4, myThid)
280     CALL MNC_CW_ADD_VNAME('khmt', 'fizhi_chiplev', 3,4, myThid)
281     CALL MNC_CW_ADD_VNAME('tke', 'fizhi_chiplev', 3,4, myThid)
282 edhill 1.3
283 edhill 1.5 ENDIF
284    
285 edhill 1.1 #endif /* ALLOW_MNC */
286    
287     RETURN
288     END
289    
290     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
  ViewVC Help
Powered by ViewVC 1.1.22