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

Contents of /MITgcm/pkg/fizhi/fizhi_readwrite_vegtiles.F

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


Revision 1.5 - (show 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: +7 -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 C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_readwrite_vegtiles.F,v 1.4 2004/08/18 15:55:21 molod Exp $
2 C $Name: $
3
4 #include "FIZHI_OPTIONS.h"
5 CBOP
6 C !ROUTINE: FIZHI_WRITE_VEGTILES
7 C !INTERFACE:
8 SUBROUTINE FIZHI_WRITE_VEGTILES(fn,pickupflg,myTime,myIter,myThid)
9
10 C !DESCRIPTION:
11
12 C !USES:
13 IMPLICIT NONE
14
15 C == Global variables ===
16 #include "SIZE.h"
17 #include "fizhi_SIZE.h"
18 #include "fizhi_land_SIZE.h"
19 #include "fizhi_coms.h"
20 #include "fizhi_land_coms.h"
21 #include "fizhi_earth_coms.h"
22 #include "EEPARAMS.h"
23 #ifdef ALLOW_MNC
24 #include "MNC_PARAMS.h"
25 #endif
26 EXTERNAL ILNBLNK
27 INTEGER ILNBLNK
28
29 C !INPUT/OUTPUT PARAMETERS:
30 CHARACTER*(MAX_LEN_FNAM) fn
31 INTEGER pickupflg
32 _RL myTime
33 INTEGER myIter
34 INTEGER myThid
35
36 CEOP
37 C !LOCAL VARIABLES:
38 CHARACTER*1 prec
39 CHARACTER*80 bnam
40 integer ilst
41 integer i
42
43 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
44
45 DO i = 1,80
46 bnam(i:i) = ' '
47 ENDDO
48 ilst = ILNBLNK(fn)
49 if(pickupflg.eq.0) then
50 prec = 'D'
51 WRITE(bnam,'(a,a)') 'pickup_vegtiles.', fn(1:ilst)
52 else
53 prec = 'D'
54 WRITE(bnam,'(a,a)') 'state_vegtiles.', fn(1:ilst)
55 endif
56
57
58 #ifdef ALLOW_MNC
59 IF (useMNC) THEN
60
61 C Write fizhi veg-space variables using the MNC package
62 CALL MNC_CW_SET_UDIM(bnam, 1, myThid)
63 CALL MNC_CW_I_W('I',bnam,0,0,'iter', myIter, myThid)
64
65 C fizhi_coms.h
66 CALL MNC_CW_RL_W(prec,bnam,0,0,'ctmt', ctmt, myThid)
67 CALL MNC_CW_RL_W(prec,bnam,0,0,'xxmt', xxmt, myThid)
68 CALL MNC_CW_RL_W(prec,bnam,0,0,'yymt', yymt, myThid)
69 CALL MNC_CW_RL_W(prec,bnam,0,0,'zetamt', zetamt, myThid)
70 CALL MNC_CW_RL_W(prec,bnam,0,0,'xlmt', xlmt, myThid)
71 CALL MNC_CW_RL_W(prec,bnam,0,0,'khmt', khmt, myThid)
72 CALL MNC_CW_RL_W(prec,bnam,0,0,'tke', tke, myThid)
73
74 C fizhi_land_coms.h
75 CALL MNC_CW_RL_W(prec,bnam,0,0,'tcanopy', tcanopy, myThid)
76 CALL MNC_CW_RL_W(prec,bnam,0,0,'tdeep', tdeep, myThid)
77 CALL MNC_CW_RL_W(prec,bnam,0,0,'ecanopy', ecanopy, myThid)
78 CALL MNC_CW_RL_W(prec,bnam,0,0,'swetshal', swetshal, myThid)
79 CALL MNC_CW_RL_W(prec,bnam,0,0,'swetroot', swetroot, myThid)
80 CALL MNC_CW_RL_W(prec,bnam,0,0,'swetdeep', swetdeep, myThid)
81 CALL MNC_CW_RL_W(prec,bnam,0,0,'snodep', snodep, myThid)
82 CALL MNC_CW_RL_W(prec,bnam,0,0,'capac', capac, myThid)
83 CALL MNC_CW_RL_W(prec,bnam,0,0,'chlt', chlt, myThid)
84 CALL MNC_CW_RL_W(prec,bnam,0,0,'chlon', chlon, myThid)
85 CALL MNC_CW_RL_W('I',bnam,0,0,'igrd', igrd, myThid)
86
87 C fizhi_earth_coms.h
88 CALL MNC_CW_RL_W('I',bnam,0,0,'ityp', ityp, myThid)
89 CALL MNC_CW_RL_W(prec,bnam,0,0,'chfr', chfr, myThid)
90
91 ENDIF
92 #endif /* ALLOW_MNC */
93
94 RETURN
95 END
96
97
98 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
99
100 CBOP
101 C !ROUTINE: FIZHI_READ_VEGTILES
102 C !INTERFACE:
103 SUBROUTINE FIZHI_READ_VEGTILES(fn,prec,myTime,myIter,myThid)
104
105 C !DESCRIPTION:
106
107 C !USES:
108 IMPLICIT NONE
109
110 C == Global variables ===
111 #include "SIZE.h"
112 #include "fizhi_SIZE.h"
113 #include "fizhi_land_SIZE.h"
114 #include "fizhi_coms.h"
115 #include "fizhi_land_coms.h"
116 #include "fizhi_earth_coms.h"
117 #include "EEPARAMS.h"
118 #ifdef ALLOW_MNC
119 #include "MNC_PARAMS.h"
120 #endif
121 EXTERNAL ILNBLNK
122 INTEGER ILNBLNK
123
124 C !INPUT/OUTPUT PARAMETERS:
125 CHARACTER*(MAX_LEN_FNAM) fn
126 CHARACTER*1 prec
127 _RL myTime
128 INTEGER myIter
129 INTEGER myThid
130
131 CEOP
132 C !LOCAL VARIABLES:
133 CHARACTER*80 bnam
134 integer ilst
135 integer i
136
137 DO i = 1,80
138 bnam(i:i) = ' '
139 ENDDO
140 ilst = ILNBLNK(fn)
141 WRITE(bnam,'(a,a)') 'pickup_vegtiles.', fn(1:ilst)
142
143 #ifdef ALLOW_MNC
144 IF (useMNC) THEN
145
146 C Write fizhi veg-space variables using the MNC package
147 CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
148 CALL MNC_CW_SET_UDIM(bnam, 1, myThid)
149
150 C fizhi_coms.h
151 CALL MNC_CW_RL_R(prec,bnam,0,0,'ctmt', ctmt, myThid)
152 CALL MNC_CW_RL_R(prec,bnam,0,0,'xxmt', xxmt, myThid)
153 CALL MNC_CW_RL_R(prec,bnam,0,0,'yymt', yymt, myThid)
154 CALL MNC_CW_RL_R(prec,bnam,0,0,'zetamt', zetamt, myThid)
155 CALL MNC_CW_RL_R(prec,bnam,0,0,'xlmt', xlmt, myThid)
156 CALL MNC_CW_RL_R(prec,bnam,0,0,'khmt', khmt, myThid)
157 CALL MNC_CW_RL_R(prec,bnam,0,0,'tke', tke, myThid)
158
159 C fizhi_land_coms.h
160 CALL MNC_CW_RL_R(prec,bnam,0,0,'tcanopy', tcanopy, myThid)
161 CALL MNC_CW_RL_R(prec,bnam,0,0,'tdeep', tdeep, myThid)
162 CALL MNC_CW_RL_R(prec,bnam,0,0,'ecanopy', ecanopy, myThid)
163 CALL MNC_CW_RL_R(prec,bnam,0,0,'swetshal', swetshal, myThid)
164 CALL MNC_CW_RL_R(prec,bnam,0,0,'swetroot', swetroot, myThid)
165 CALL MNC_CW_RL_R(prec,bnam,0,0,'swetdeep', swetdeep, myThid)
166 CALL MNC_CW_RL_R(prec,bnam,0,0,'snodep', snodep, myThid)
167 CALL MNC_CW_RL_R(prec,bnam,0,0,'capac', capac, myThid)
168
169 ENDIF
170 #endif /* ALLOW_MNC */
171
172 RETURN
173 END
174
175 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

  ViewVC Help
Powered by ViewVC 1.1.22