source: trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/frame/md_calls.m4 @ 667

Last change on this file since 667 was 11, checked in by aslmd, 15 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 15.8 KB
Line 
1!
2! WRF io macro file
3!
4! This file is used to generate the series of 40 meta-data get and
5! put calls in the WRF I/O API.  It contains an M4 macro and then
6! a series of invocations of the macro to generate the subroutine
7! definitions, which are then included by the file module_io.F
8!
9
10! $1 = get|put $2=dom|var $3=type $4=[char] $5=td|ti
11
12define( md_call_2,
13`!--- $1_$2_$6_$3$4
14
15SUBROUTINE wrf_$1_$2_$6_$3$4_$5 ( DataHandle,Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, ifelse($4,char,,`Count, ifelse($1,get,`Outcount,')') Status )
16!<DESCRIPTION>
17!<PRE>
18!
19! ifelse($1,get,`Attempt to read',`Write') ifelse($4,char,,ifelse($5,arr,`Count words of '))time ifelse($6,ti,`in')dependent
20! ifelse($2,var,`attribute "Element" of variable "Varname"',`domain metadata named "Element"') ifelse($6,td,`valid at time DateStr')
21! ifelse($1,get,`from',`to') the open dataset described by DataHandle. 
22! ifelse($2,var,`Attribute',`Metadata') of type $3$4 ifelse($2,var,`is',`are')
23! ifelse($1,put,`copied from',`stored in') ifelse($4,char,`string',ifelse($5,arr,`array',`scalar')) Data.
24! ifelse($4,char,,ifelse($5,arr,ifelse($1,get,`Actual number of words read is returned in OutCount.')))
25!
26!</PRE>
27!</DESCRIPTION>
28USE module_state_description
29IMPLICIT NONE
30INTEGER ,       INTENT(IN)  :: DataHandle
31CHARACTER*(*) , INTENT(IN)  :: Element
32ifelse($6,td,`CHARACTER*(*) , INTENT(IN)  :: DateStr')
33ifelse($2,var,`CHARACTER*(*) , INTENT(IN)  :: VarName')
34
35 ifelse($4,char,`CHARACTER*(*)  :: Data', `ifelse($3,double,real*8,$3)  :: Data ifelse($5,arr,(*),)')
36
37ifelse($4,char,,`INTEGER ,       INTENT(IN)  :: Count')
38ifelse($4,char,,`ifelse($1,get,`INTEGER ,       INTENT(OUT)  :: OutCount')')
39INTEGER ,       INTENT(OUT) :: Status
40
41#include <wrf_status_codes.h>
42INTEGER                     :: len_of_str
43LOGICAL                     :: for_out
44INTEGER, EXTERNAL           :: use_package
45LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
46INTEGER                     :: locCount
47
48INTEGER io_form , Hndl
49
50CALL wrf_debug( DEBUG_LVL, "module_io.F (md_calls.m4) : in wrf_$1_$2_$6_$3$4_$5 " )
51
52ifelse($3,integer,`locCount = Count')
53ifelse($3,real,`locCount = Count')
54ifelse($3,logical,`locCount = Count')
55
56Status = 0
57CALL get_handle ( Hndl, io_form , for_out, DataHandle )
58IF ( Hndl .GT. -1 ) THEN
59  IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
60    SELECT CASE ( use_package( io_form ) )
61#ifdef NETCDF
62      CASE ( IO_NETCDF   )
63        IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
64ifelse($3,real,
65`#  if ( RWORDSIZE == DWORDSIZE )
66           CALL ext_ncd_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
67                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
68#  else
69           CALL ext_ncd_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
70                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
71#  endif',
72`           CALL ext_ncd_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
73                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
74        ENDIF
75        IF ( .NOT. multi_files(io_form) ) THEN
76          ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
77          ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( Data, IWORDSIZE*locCount )'))
78          ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
79          ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( Data, RWORDSIZE*locCount )'))
80          ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
81          ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( Data, LWORDSIZE*locCount )'))
82          ifelse($1,get,ifelse($4,char,   `len_of_str = LEN(Data)'))
83          ifelse($1,get,ifelse($4,char,   `CALL wrf_dm_bcast_string( Data, len_of_str )'))
84          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
85        ENDIF
86#endif
87#ifdef PNETCDF
88      CASE ( IO_PNETCDF   )
89ifelse($3,real,
90`#  if ( RWORDSIZE == DWORDSIZE )
91        CALL ext_pnc_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
92                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
93#  else
94        CALL ext_pnc_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
95                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
96#  endif',
97`        CALL ext_pnc_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
98                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
99#endif
100#ifdef PHDF5
101      CASE ( IO_PHDF5   )
102ifelse($3,real,
103`#  if ( RWORDSIZE == DWORDSIZE )
104        CALL ext_phdf5_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
105                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
106#  else
107        CALL ext_phdf5_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
108                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
109#  endif',
110`        CALL ext_phdf5_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
111                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
112#endif
113#ifdef ESMFIO
114      CASE ( IO_ESMF )
115ifelse($3,real,
116`#  if ( RWORDSIZE == DWORDSIZE )
117        CALL ext_esmf_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
118                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
119#  else
120        CALL ext_esmf_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
121                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
122#  endif',
123`        CALL ext_esmf_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
124                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
125#endif
126#ifdef XXX
127      CASE ( IO_XXX   )
128ifelse($3,real,
129`#  if ( RWORDSIZE == DWORDSIZE )
130        CALL ext_xxx_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
131                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
132#  else
133        CALL ext_xxx_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
134                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
135#  endif',
136`        CALL ext_xxx_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
137                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
138#endif
139#ifdef YYY
140      CASE ( IO_YYY   )
141ifelse($3,real,
142`#  if ( RWORDSIZE == DWORDSIZE )
143        CALL ext_yyy_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
144                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
145#  else
146        CALL ext_yyy_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
147                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
148#  endif',
149`        CALL ext_yyy_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
150                              ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
151#endif
152#ifdef GRIB1
153      CASE ( IO_GRIB1   )
154        IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
155ifelse($3,real,
156`#  if ( RWORDSIZE == DWORDSIZE )
157           CALL ext_gr1_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
158                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
159#  else
160           CALL ext_gr1_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
161                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
162#  endif',
163`           CALL ext_gr1_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
164                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
165        ENDIF
166        IF ( .NOT. multi_files(io_form) ) THEN
167          ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
168          ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( Data, IWORDSIZE*locCount )'))
169          ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
170          ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( Data, RWORDSIZE*locCount )'))
171          ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
172          ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( Data, LWORDSIZE*locCount )'))
173          ifelse($1,get,ifelse($4,char,   `len_of_str = LEN(Data)'))
174          ifelse($1,get,ifelse($4,char,   `CALL wrf_dm_bcast_string( Data, len_of_str )'))
175          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
176        ENDIF
177#endif
178#ifdef GRIB2
179      CASE ( IO_GRIB2   )
180        IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
181ifelse($3,real,
182`#  if ( RWORDSIZE == DWORDSIZE )
183           CALL ext_gr2_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
184                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
185#  else
186           CALL ext_gr2_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
187                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
188#  endif',
189`           CALL ext_gr2_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
190                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
191        ENDIF
192        IF ( .NOT. multi_files(io_form) ) THEN
193          ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
194          ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( Data, IWORDSIZE*locCount )'))
195          ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
196          ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( Data, RWORDSIZE*locCount )'))
197          ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
198          ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( Data, LWORDSIZE*locCount )'))
199          ifelse($1,get,ifelse($4,char,   `len_of_str = LEN(Data)'))
200          ifelse($1,get,ifelse($4,char,   `CALL wrf_dm_bcast_string( Data, len_of_str )'))
201          CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
202        ENDIF
203#endif
204#ifdef INTIO
205      CASE ( IO_INTIO   )
206        IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
207ifelse($3,real,
208`#  if ( RWORDSIZE == DWORDSIZE )
209           CALL ext_int_$1_$2_$6_double$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
210                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
211#  else
212           CALL ext_int_$1_$2_$6_real$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
213                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
214#  endif',
215`           CALL ext_int_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
216                                 ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )' )
217        ENDIF
218        IF ( .NOT. multi_files(io_form) ) THEN
219           ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
220           ifelse($1,get,ifelse($3,integer,`CALL wrf_dm_bcast_bytes( Data, IWORDSIZE*locCount )'))
221           ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
222           ifelse($1,get,ifelse($3,real,   `CALL wrf_dm_bcast_bytes( Data, RWORDSIZE*locCount )'))
223           ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( locCount, IWORDSIZE )'))
224           ifelse($1,get,ifelse($3,logical,`CALL wrf_dm_bcast_bytes( Data, LWORDSIZE*locCount )'))
225           ifelse($1,get,ifelse($4,char,   `len_of_str = LEN(Data)'))
226           ifelse($1,get,ifelse($4,char,   `CALL wrf_dm_bcast_string( Data, len_of_str )'))
227           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
228        ENDIF
229#endif
230      CASE DEFAULT
231    END SELECT
232  ELSE IF ( for_out .AND. use_output_servers() ) THEN
233    CALL wrf_quilt_$1_$2_$6_$3$4 ( Hndl, Element, ifelse($6,td,`DateStr,') ifelse($2,var,`Varname,') Data, &
234                          ifelse($4,char,,`locCount, ifelse($1,get,`Outcount,')') Status )
235  ELSE
236    Status = 0
237ENDIF
238ELSE
239  Status = WRF_ERR_FATAL_BAD_FILE_STATUS
240ENDIF
241RETURN
242END SUBROUTINE wrf_$1_$2_$6_$3$4_$5' )
243
244define( md_call,
245`ifelse($4,char,
246`md_call_2($1,$2,$3,$4,arr,$5)'
247,
248`md_call_2($1,$2,$3,$4,arr,$5)
249md_call_2($1,$2,$3,$4,sca,$5)'
250)'
251)
252
253define( md_interface,
254`ifelse($4,char,
255`INTERFACE wrf_$1_$2_$5_$3$4
256  MODULE PROCEDURE wrf_$1_$2_$5_$3$4_arr
257END INTERFACE'
258,
259`INTERFACE wrf_$1_$2_$5_$3$4
260  MODULE PROCEDURE wrf_$1_$2_$5_$3$4_arr, wrf_$1_$2_$5_$3$4_sca
261END INTERFACE'
262)'
263)
264
265md_interface(get,dom,real,,ti)
266md_interface(put,dom,real,,ti)
267md_interface(get,dom,double,,ti)
268md_interface(put,dom,double,,ti)
269md_interface(get,dom,integer,,ti)
270md_interface(put,dom,integer,,ti)
271md_interface(get,dom,logical,,ti)
272md_interface(put,dom,logical,,ti)
273md_interface(get,dom,,char,ti)
274md_interface(put,dom,,char,ti)
275
276md_interface(get,dom,real,,td)
277md_interface(put,dom,real,,td)
278md_interface(get,dom,double,,td)
279md_interface(put,dom,double,,td)
280md_interface(get,dom,integer,,td)
281md_interface(put,dom,integer,,td)
282md_interface(get,dom,logical,,td)
283md_interface(put,dom,logical,,td)
284md_interface(get,dom,,char,td)
285md_interface(put,dom,,char,td)
286
287md_interface(get,var,real,,ti)
288md_interface(put,var,real,,ti)
289md_interface(get,var,double,,ti)
290md_interface(put,var,double,,ti)
291md_interface(get,var,integer,,ti)
292md_interface(put,var,integer,,ti)
293md_interface(get,var,logical,,ti)
294md_interface(put,var,logical,,ti)
295md_interface(get,var,,char,ti)
296md_interface(put,var,,char,ti)
297
298md_interface(get,var,real,,td)
299md_interface(put,var,real,,td)
300md_interface(get,var,double,,td)
301md_interface(put,var,double,,td)
302md_interface(get,var,integer,,td)
303md_interface(put,var,integer,,td)
304md_interface(get,var,logical,,td)
305md_interface(put,var,logical,,td)
306md_interface(get,var,,char,td)
307md_interface(put,var,,char,td)
308
309CONTAINS
310
311md_call(get,dom,real,,ti)
312md_call(put,dom,real,,ti)
313md_call(get,dom,double,,ti)
314md_call(put,dom,double,,ti)
315md_call(get,dom,integer,,ti)
316md_call(put,dom,integer,,ti)
317md_call(get,dom,logical,,ti)
318md_call(put,dom,logical,,ti)
319md_call(get,dom,,char,ti)
320md_call(put,dom,,char,ti)
321
322md_call(get,dom,real,,td)
323md_call(put,dom,real,,td)
324md_call(get,dom,double,,td)
325md_call(put,dom,double,,td)
326md_call(get,dom,integer,,td)
327md_call(put,dom,integer,,td)
328md_call(get,dom,logical,,td)
329md_call(put,dom,logical,,td)
330md_call(get,dom,,char,td)
331md_call(put,dom,,char,td)
332
333md_call(get,var,real,,ti)
334md_call(put,var,real,,ti)
335md_call(get,var,double,,ti)
336md_call(put,var,double,,ti)
337md_call(get,var,integer,,ti)
338md_call(put,var,integer,,ti)
339md_call(get,var,logical,,ti)
340md_call(put,var,logical,,ti)
341md_call(get,var,,char,ti)
342md_call(put,var,,char,ti)
343
344md_call(get,var,real,,td)
345md_call(put,var,real,,td)
346md_call(get,var,double,,td)
347md_call(put,var,double,,td)
348md_call(get,var,integer,,td)
349md_call(put,var,integer,,td)
350md_call(get,var,logical,,td)
351md_call(put,var,logical,,td)
352md_call(get,var,,char,td)
353md_call(put,var,,char,td)
354
Note: See TracBrowser for help on using the repository browser.