/[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.9 - (hide annotations) (download)
Fri May 23 07:22:29 2008 UTC (16 years, 1 month ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint65, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint59r, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x, 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, HEAD
Changes since 1.8: +2 -2 lines 
replace another instance of mnc_common.h with MNC_COMMON.h
1 mlosch 1.9 C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_mnc_init.F,v 1.8 2004/10/10 06:08:49 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.6 #include "EEPARAMS.h"
23 edhill 1.8 #include "PARAMS.h"
24 edhill 1.5 #ifdef ALLOW_MNC
25     #include "MNC_PARAMS.h"
26 mlosch 1.9 #include "MNC_COMMON.h"
27 edhill 1.5 #endif
28 edhill 1.1
29     C !INPUT PARAMETERS:
30     integer myThid
31     CEOP
32    
33     #ifdef ALLOW_MNC
34    
35     C !LOCAL VARIABLES:
36     integer CW_MAX_LOC
37     parameter ( CW_MAX_LOC = 5 )
38     integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot
39     integer ndim, ncomb, nvch
40     character*(MNC_MAX_CHAR) name
41     character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)
42     character*(5) horz_dat(CW_MAX_LOC), hsub_dat(CW_MAX_LOC),
43     & vert_dat(CW_MAX_LOC), time_dat(CW_MAX_LOC),
44     & halo_dat(CW_MAX_LOC)
45     integer dim(CW_MAX_LOC), ib(CW_MAX_LOC), ie(CW_MAX_LOC)
46    
47     C Functions
48     integer ILNBLNK
49     external ILNBLNK
50    
51     C ......12345....12345....12345....12345....12345...
52     data horz_dat /
53     & '- ', 'U ', 'V ', 'Cen ', 'Cor ' /
54     data hsub_dat /
55     & 'xy ', 'x ', 'y ', '- ', ' ' /
56     data halo_dat /
57     & 'Hn ', 'Hy ', '-- ', ' ', ' ' /
58     data vert_dat /
59     & 'Zph ', 'Zphi ', ' ', ' ', ' ' /
60     data time_dat /
61     & '- ', 't ', ' ', ' ', ' ' /
62    
63 edhill 1.5 IF (useMNC) THEN
64    
65 edhill 1.3 C Define a few "standard" or "convenience" types
66 edhill 1.1 ncomb = 0
67     DO ihorz = 1,5
68     DO is = 1,3
69     DO ih = 1,2
70    
71     C Loop just ONCE if the Horiz component is "-"
72     ihsub = is
73     ihalo = ih
74     IF (ihorz .EQ. 1) THEN
75     IF ((is .EQ. 1) .AND. (ih .EQ. 1)) THEN
76     ihsub = 4
77     ihalo = 3
78     ELSE
79     GOTO 10
80     ENDIF
81     ENDIF
82    
83 edhill 1.7 DO ivert = 1,2
84 edhill 1.1 DO itime = 1,2
85    
86     C horiz and hsub
87     name(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
88     n = ILNBLNK(horz_dat(ihorz))
89     name(1:n) = horz_dat(ihorz)(1:n)
90     ntot = n + 1
91     name(ntot:ntot) = '_'
92     n = ILNBLNK(hsub_dat(ihsub))
93     name((ntot+1):(ntot+n)) = hsub_dat(ihsub)(1:n)
94     ntot = ntot + n
95    
96     C halo, vert, and time
97     write(name((ntot+1):(ntot+5)), '(a1,2a2)')
98     & '_', halo_dat(ihalo)(1:2), '__'
99     nvch = ILNBLNK(vert_dat(ivert))
100     n = ntot+6+nvch-1
101     name((ntot+6):(n)) = vert_dat(ivert)(1:nvch)
102     write(name((n+1):(n+3)), '(a2,a1)')
103     & '__', time_dat(itime)(1:1)
104    
105     ndim = 0
106     DO i = 1,CW_MAX_LOC
107     dn(i)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
108     dim(i) = 0
109     ib(i) = 0
110     ie(i) = 0
111     ENDDO
112    
113     C Horizontal dimensions
114     IF (halo_dat(ihalo)(1:5) .EQ. 'Hn ') THEN
115    
116     IF (hsub_dat(ihsub)(1:1) .EQ. 'x') THEN
117     ndim = ndim + 1
118     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cen')
119     & .OR. (horz_dat(ihorz)(1:1) .EQ. 'V') ) THEN
120     dn(ndim)(1:1) = 'X'
121     dim(ndim) = sNx + 2*OLx
122     ib(ndim) = OLx + 1
123     ie(ndim) = OLx + sNx
124     ENDIF
125     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cor')
126     & .OR. (horz_dat(ihorz)(1:1) .EQ. 'U') ) THEN
127     dn(ndim)(1:3) = 'Xp1'
128     dim(ndim) = sNx + 2*OLx
129     ib(ndim) = OLx + 1
130     ie(ndim) = OLx + sNx + 1
131     ENDIF
132     ENDIF
133     IF ((hsub_dat(ihsub)(1:1) .EQ. 'y')
134     & .OR. (hsub_dat(ihsub)(2:2) .EQ. 'y')) THEN
135     ndim = ndim + 1
136     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cen')
137     & .OR. (horz_dat(ihorz)(1:1) .EQ. 'U') ) THEN
138     dn(ndim)(1:1) = 'Y'
139     dim(ndim) = sNy + 2*OLy
140     ib(ndim) = OLy + 1
141     ie(ndim) = OLy + sNy
142     ENDIF
143     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cor')
144     & .OR. (horz_dat(ihorz)(1:1) .EQ. 'V') ) THEN
145     dn(ndim)(1:3) = 'Yp1'
146     dim(ndim) = sNy + 2*OLy
147     ib(ndim) = OLy + 1
148     ie(ndim) = OLy + sNy + 1
149     ENDIF
150     ENDIF
151    
152     ELSEIF (halo_dat(ihalo)(1:5) .EQ. 'Hy ') THEN
153    
154     IF (hsub_dat(ihsub)(1:1) .EQ. 'x') THEN
155     ndim = ndim + 1
156     dn(ndim)(1:3) = 'Xwh'
157     dim(ndim) = sNx + 2*OLx
158     ib(ndim) = 1
159     ie(ndim) = sNx + 2*OLx
160     ENDIF
161     IF ((hsub_dat(ihsub)(1:1) .EQ. 'y')
162     & .OR. (hsub_dat(ihsub)(2:2) .EQ. 'y')) THEN
163     ndim = ndim + 1
164     dn(ndim)(1:3) = 'Ywh'
165     dim(ndim) = sNy + 2*OLy
166     ib(ndim) = 1
167     ie(ndim) = sNy + 2*OLy
168     ENDIF
169    
170     ENDIF
171    
172     C Vertical dimension
173     IF (vert_dat(ivert)(1:5) .EQ. 'Phys ') THEN
174     ndim = ndim + 1
175     dn(ndim)(1:5) = 'Zphys'
176     dim(ndim) = NrPhys
177     ib(ndim) = 1
178     ie(ndim) = NrPhys
179     ENDIF
180     IF (vert_dat(ivert)(1:5) .EQ. 'PhysI') THEN
181     ndim = ndim + 1
182     dn(ndim)(1:7) = 'Zphysm1'
183     dim(ndim) = NrPhys - 1
184     ib(ndim) = 1
185     ie(ndim) = NrPhys - 1
186     ENDIF
187    
188     C Time dimension
189     IF ( (time_dat(itime)(1:1) .EQ. 't')
190     & .and. (ndim .ne. 0) ) THEN
191     ndim = ndim + 1
192     dn(ndim)(1:1) = 'T'
193     dim(ndim) = -1
194     ib(ndim) = 1
195     ie(ndim) = 1
196     ENDIF
197    
198     IF (ndim .GT. 0) THEN
199    
200     CALL MNC_CW_ADD_GNAME(name, ndim,
201     & dim, dn, ib, ie, myThid)
202     ENDIF
203    
204     ENDDO
205     ENDDO
206    
207     10 CONTINUE
208     ENDDO
209     ENDDO
210     ENDDO
211    
212 edhill 1.3 C Define a "fizhi_veg" type to be used in FIZHI_INIT_VEG()
213     C
214     C name 1234567890
215     ndim = 3
216     dn(1)(1:10) = 'X '
217     dim(1) = sNx + 2*OLx
218     ib(1) = OLx + 1
219     ie(1) = OLx + sNx
220     dn(2)(1:10) = 'Y '
221     dim(2) = sNy + 2*OLy
222     ib(2) = OLy + 1
223     ie(2) = OLy + sNy
224     dn(3)(1:10) = 'VegType '
225     dim(3) = maxtyp
226     ib(3) = 1
227     ie(3) = maxtyp
228    
229     CALL MNC_CW_ADD_GNAME('fizhi_veg', ndim, dim, dn,ib,ie, myThid)
230     CALL MNC_CW_ADD_VNAME('surftype', 'fizhi_veg', 4,5, myThid)
231     CALL MNC_CW_ADD_VNAME('tilefrac', 'fizhi_veg', 4,5, myThid)
232    
233 edhill 1.4 C Used for the pickups
234     CALL MNC_CW_ADD_VNAME('uphy', 'U_xy_Hn__Zph__-' ,4,5,myThid)
235     CALL MNC_CW_ADD_VNAME('vphy', 'V_xy_Hn__Zph__-' ,4,5,myThid)
236     CALL MNC_CW_ADD_VNAME('thphy','Cen_xy_Hn__Zph__-',4,5,myThid)
237     CALL MNC_CW_ADD_VNAME('sphy', 'Cen_xy_Hn__Zph__-',4,5,myThid)
238    
239     C For the veg IO
240     C name 1234567890
241     ndim = 1
242     dn(1)(1:10) = 'chips '
243     dim(1) = nchp
244     ib(1) = 1
245     ie(1) = nchp
246     CALL MNC_CW_ADD_GNAME('fizhi_chip', ndim, dim, dn,ib,ie, myThid)
247     CALL MNC_CW_ADD_VNAME('ctmt', 'fizhi_chip', 2,3, myThid)
248     CALL MNC_CW_ADD_VNAME('xxmt', 'fizhi_chip', 2,3, myThid)
249     CALL MNC_CW_ADD_VNAME('yymt', 'fizhi_chip', 2,3, myThid)
250     CALL MNC_CW_ADD_VNAME('zetamt', 'fizhi_chip', 2,3, myThid)
251     CALL MNC_CW_ADD_VNAME('tcanopy', 'fizhi_chip', 2,3, myThid)
252     CALL MNC_CW_ADD_VNAME('tdeep', 'fizhi_chip', 2,3, myThid)
253     CALL MNC_CW_ADD_VNAME('ecanopy', 'fizhi_chip', 2,3, myThid)
254     CALL MNC_CW_ADD_VNAME('swetshal', 'fizhi_chip', 2,3, myThid)
255     CALL MNC_CW_ADD_VNAME('swetroot', 'fizhi_chip', 2,3, myThid)
256     CALL MNC_CW_ADD_VNAME('swetdeep', 'fizhi_chip', 2,3, myThid)
257     CALL MNC_CW_ADD_VNAME('snodep', 'fizhi_chip', 2,3, myThid)
258     CALL MNC_CW_ADD_VNAME('capac', 'fizhi_chip', 2,3, myThid)
259     CALL MNC_CW_ADD_VNAME('chlt', 'fizhi_chip', 2,3, myThid)
260     CALL MNC_CW_ADD_VNAME('chlon', 'fizhi_chip', 2,3, myThid)
261     CALL MNC_CW_ADD_VNAME('igrd', 'fizhi_chip', 2,3, myThid)
262     CALL MNC_CW_ADD_VNAME('ityp', 'fizhi_chip', 2,3, myThid)
263     CALL MNC_CW_ADD_VNAME('chfr', 'fizhi_chip', 2,3, myThid)
264    
265     C name 1234567890
266     ndim = 2
267     dn(1)(1:10) = 'chips '
268     dim(1) = nchp
269     ib(1) = 1
270     ie(1) = nchp
271     dn(2)(1:10) = 'Zph '
272     dim(2) = NrPhys
273     ib(2) = 1
274     ie(2) = NrPhys
275     CALL MNC_CW_ADD_GNAME('fizhi_chiplev',ndim,dim,dn,ib,ie,myThid)
276     CALL MNC_CW_ADD_VNAME('xlmt', 'fizhi_chiplev', 3,4, myThid)
277     CALL MNC_CW_ADD_VNAME('khmt', 'fizhi_chiplev', 3,4, myThid)
278     CALL MNC_CW_ADD_VNAME('tke', 'fizhi_chiplev', 3,4, myThid)
279 edhill 1.3
280 edhill 1.5 ENDIF
281    
282 edhill 1.1 #endif /* ALLOW_MNC */
283    
284     RETURN
285     END
286    
287     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
  ViewVC Help
Powered by ViewVC 1.1.22