source: trunk/WRF.COMMON/WRFV3/external/io_mcel/io_mcel.F90 @ 2759

Last change on this file since 2759 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 37.9 KB
Line 
1MODULE module_ext_mcel
2
3  INTEGER, PARAMETER :: int_num_handles = 99
4  LOGICAL, DIMENSION(int_num_handles) :: okay_to_write, okay_to_read,                     &
5                                         opened_for_write, opened_for_update,             &
6                                         opened_for_read,                                 &
7                                         int_handle_in_use, okay_to_commit
8  LOGICAL, DIMENSION(int_num_handles) :: mcel_grid_defined, mcel_finalized
9  INTEGER, DIMENSION(int_num_handles) :: int_num_bytes_to_write
10  INTEGER, DIMENSION(int_num_handles) :: usemask
11  CHARACTER*256, DIMENSION(int_num_handles) :: CurrentDateInFile
12  CHARACTER*8092, DIMENSION(int_num_handles) :: ListOfFields
13  REAL, POINTER    :: int_local_output_buffer(:)
14  INTEGER          :: int_local_output_cursor
15  INTEGER          :: mcel_npglobal, mcel_mystart, mcel_mnproc, mcel_myproc
16
17  INTEGER, PARAMETER           :: onebyte = 1
18  INTEGER comm_io_servers, iserver, hdrbufsize, obufsize
19  INTEGER itypesize, rtypesize, typesize
20  INTEGER, DIMENSION(512)     :: hdrbuf
21  INTEGER, DIMENSION(int_num_handles)       :: handle
22  INTEGER, DIMENSION(512, int_num_handles)  :: open_file_descriptors
23  INCLUDE "MCEL.inc"
24#include "intio_tags.h"
25#include "wrf_io_flags.h"
26#include "wrf_status_codes.h"
27  CHARACTER*80  LAT_R(int_num_handles), LON_R(int_num_handles), LANDMASK_I(int_num_handles)
28
29  REAL*8, ALLOCATABLE :: xlat(:,:), xlong(:,:)
30  REAL*8              :: deltax, deltay, dxm(2)
31  REAL*8              :: originx, originy, origin(2)
32  INTEGER, ALLOCATABLE :: mask(:,:)
33  REAL, ALLOCATABLE :: rmask(:,:)
34  DOUBLEPRECISION, ALLOCATABLE :: dmask(:,:)
35
36  CHARACTER*132 last_next_var
37
38  CONTAINS
39
40    LOGICAL FUNCTION int_valid_handle( handle )
41      IMPLICIT NONE
42      INTEGER, INTENT(IN) ::  handle
43      int_valid_handle = ( handle .ge. 8 .and. handle .le. int_num_handles )
44    END FUNCTION int_valid_handle
45
46    SUBROUTINE int_get_fresh_handle( retval )
47!      USE wrf_data, ONLY : wrf_data_handle
48!      USE ext_ncd_support_routines, ONLY : allocHandle
49!      type(wrf_data_handle),pointer     :: DH
50!      INTEGER i, retval, comm, Status
51      INTEGER i, retval
52
53#if 0
54      CALL allocHandle(retval,DH,Comm,Status)
55#endif
56
57      retval = -1
58! dont use first 8 handles
59      DO i = 8, int_num_handles
60        IF ( .NOT. int_handle_in_use(i) )  THEN
61          retval = i
62          GOTO 33
63        ENDIF
64      ENDDO
6533    CONTINUE
66      IF ( retval < 0 )  THEN
67        CALL wrf_error_fatal("external/io_quilt/io_int.F90: int_get_fresh_handle() can not")
68      ENDIF
69      int_handle_in_use(retval) = .TRUE.
70      NULLIFY ( int_local_output_buffer )
71    END SUBROUTINE int_get_fresh_handle
72
73! parse comma separated list of VARIABLE=VALUE strings and return the
74! value for the matching variable if such exists, otherwise return
75! the empty string
76SUBROUTINE get_value ( varname , str , retval )
77  IMPLICIT NONE
78  CHARACTER*(*) ::    varname
79  CHARACTER*(*) ::    str
80  CHARACTER*(*) ::    retval
81
82  CHARACTER (128) varstr, tstr
83  INTEGER i,j,n,varstrn
84  LOGICAL nobreak, nobreakouter
85
86  varstr = TRIM(varname)//"="
87  varstrn = len(TRIM(varstr))
88  n = len(TRIM(str))
89  retval = ""
90  i = 1
91  nobreakouter = .TRUE.
92  DO WHILE ( nobreakouter )
93    j = 1
94    nobreak = .TRUE.
95    tstr = ""
96    DO WHILE ( nobreak )
97      nobreak = .FALSE.
98      IF ( i .LE. n ) THEN
99        IF (str(i:i) .NE. ',' ) THEN
100           tstr(j:j) = str(i:i)
101           nobreak = .TRUE.
102        ENDIF
103      ENDIF
104      j = j + 1
105      i = i + 1
106    ENDDO
107    IF ( i .GT. n ) nobreakouter = .FALSE.
108    IF ( varstr(1:varstrn) .EQ. tstr(1:varstrn) ) THEN
109      retval(1:) = TRIM(tstr(varstrn+1:))
110      nobreakouter = .FALSE.
111    ENDIF
112  ENDDO
113  RETURN
114END SUBROUTINE get_value
115
116
117    !--- ioinit
118    SUBROUTINE init_module_ext_mcel
119      IMPLICIT NONE
120      CALL wrf_sizeof_integer( itypesize )
121      CALL wrf_sizeof_real   ( rtypesize )
122    END SUBROUTINE init_module_ext_mcel
123
124END MODULE module_ext_mcel
125
126 SUBROUTINE copy_field_to_cache_r2r ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
127   USE module_ext_mcel
128   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
129   INTEGER idex, i, j
130   REAL             Field(*)
131   REAL             cache(ips:ipe,jps:jpe)
132   DO j = jps, jpe
133     DO i = ips, ipe
134        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
135        cache(i,j) = Field( idex )
136     ENDDO
137   ENDDO
138 END SUBROUTINE copy_field_to_cache_r2r
139
140 SUBROUTINE copy_field_to_cache_r2d ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
141   USE module_ext_mcel
142   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
143   INTEGER idex, i, j
144   REAL             Field(*)
145   DOUBLE PRECISION cache(ips:ipe,jps:jpe)
146   DO j = jps, jpe
147     DO i = ips, ipe
148        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
149        cache(i,j) = Field( idex )
150     ENDDO
151   ENDDO
152 END SUBROUTINE copy_field_to_cache_r2d
153
154 SUBROUTINE copy_field_to_cache_d2r ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
155   USE module_ext_mcel
156   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
157   INTEGER idex, i, j
158   DOUBLE PRECISION Field(*)
159   REAL             cache(ips:ipe,jps:jpe)
160   DO j = jps, jpe
161     DO i = ips, ipe
162        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
163        cache(i,j) = Field( idex )
164     ENDDO
165   ENDDO
166 END SUBROUTINE copy_field_to_cache_d2r
167
168 SUBROUTINE copy_field_to_cache_d2d ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
169   USE module_ext_mcel
170   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
171   INTEGER idex, i, j
172   DOUBLE PRECISION Field(*)
173   DOUBLE PRECISION cache(ips:ipe,jps:jpe)
174   DO j = jps, jpe
175     DO i = ips, ipe
176        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
177        cache(i,j) = Field( idex )
178     ENDDO
179   ENDDO
180 END SUBROUTINE copy_field_to_cache_d2d
181
182 SUBROUTINE copy_field_to_cache_int ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
183   USE module_ext_mcel
184   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
185   INTEGER idex, i, j
186   INTEGER Field(*)
187   INTEGER cache(ips:ipe,jps:jpe)
188   DO j = jps, jpe
189     DO i = ips, ipe
190        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
191        cache(i,j) = Field( idex )
192     ENDDO
193   ENDDO
194 END SUBROUTINE copy_field_to_cache_int
195
196 SUBROUTINE copy_cache_to_field_r2r ( cache, Field, ips, ipe, jps, jpe, ims, ime, jms, jme )
197   USE module_ext_mcel
198   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
199   INTEGER idex, i, j
200   REAL            cache(ips:ipe,jps:jpe)
201   REAL            Field(*)
202   DO j = jps, jpe
203     DO i = ips, ipe
204        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
205        Field( idex ) = cache(i,j)
206     ENDDO
207   ENDDO
208 END SUBROUTINE copy_cache_to_field_r2r
209
210 SUBROUTINE copy_cache_to_field_r2d ( cache, Field, ips, ipe, jps, jpe, ims, ime, jms, jme )
211   USE module_ext_mcel
212   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
213   INTEGER idex, i, j
214   REAL             cache(ips:ipe,jps:jpe)
215   DOUBLEPRECISION  Field(*)
216   DO j = jps, jpe
217     DO i = ips, ipe
218        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
219        Field( idex ) = cache(i,j)
220     ENDDO
221   ENDDO
222 END SUBROUTINE copy_cache_to_field_r2d
223
224 SUBROUTINE copy_cache_to_field_d2r ( cache, Field, ips, ipe, jps, jpe, ims, ime, jms, jme )
225   USE module_ext_mcel
226   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
227   INTEGER idex, i, j
228   DOUBLEPRECISION  cache(ips:ipe,jps:jpe)
229   REAL             Field(*)
230   DO j = jps, jpe
231     DO i = ips, ipe
232        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
233        Field( idex ) = cache(i,j)
234     ENDDO
235   ENDDO
236 END SUBROUTINE copy_cache_to_field_d2r
237
238 SUBROUTINE copy_cache_to_field_d2d ( cache, Field, ips, ipe, jps, jpe, ims, ime, jms, jme )
239   USE module_ext_mcel
240   INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
241   INTEGER idex, i, j
242   DOUBLEPRECISION  cache(ips:ipe,jps:jpe)
243   DOUBLEPRECISION  Field(*)
244   DO j = jps, jpe
245     DO i = ips, ipe
246        idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
247        Field( idex ) = cache(i,j)
248     ENDDO
249   ENDDO
250 END SUBROUTINE copy_cache_to_field_d2d
251
252!--------------
253
254SUBROUTINE ext_mcel_ioinit( SysDepInfo, Status )
255  USE module_ext_mcel
256  IMPLICIT NONE
257  CHARACTER*(*), INTENT(IN) :: SysDepInfo
258  INTEGER Status
259  CALL init_module_ext_mcel
260  Status = 0
261END SUBROUTINE ext_mcel_ioinit
262
263!--- open_for_read
264SUBROUTINE ext_mcel_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
265                               DataHandle , Status )
266  USE module_ext_mcel
267  IMPLICIT NONE
268  CHARACTER*(*) :: FileName
269  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
270  CHARACTER*(*) :: SysDepInfo
271  INTEGER ,       INTENT(OUT) :: DataHandle
272  INTEGER ,       INTENT(OUT) :: Status
273  INTEGER i
274
275  CALL int_get_fresh_handle(i)
276  okay_to_write(i) = .false.
277  DataHandle = i
278  CurrentDateInFile(i) = ""
279  Status = WRF_WARN_NOTSUPPORTED
280
281  RETURN 
282END SUBROUTINE ext_mcel_open_for_read
283
284
285!--- inquire_opened
286SUBROUTINE ext_mcel_inquire_opened ( DataHandle, FileName , FileStatus, Status )
287  USE module_ext_mcel
288  IMPLICIT NONE
289  INTEGER ,       INTENT(IN)  :: DataHandle
290  CHARACTER*(*) :: FileName
291  INTEGER ,       INTENT(OUT) :: FileStatus
292  INTEGER ,       INTENT(OUT) :: Status
293
294  Status = 0
295
296  FileStatus = WRF_FILE_NOT_OPENED
297  IF ( DataHandle .GE. 1 .AND. DataHandle .LE. int_num_handles ) THEN
298    IF      ( int_handle_in_use( DataHandle ) .AND. opened_for_read ( DataHandle ) ) THEN
299      IF ( okay_to_read ( DataHandle ) ) THEN
300        FileStatus = WRF_FILE_OPENED_FOR_READ
301      ELSE
302        FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
303      ENDIF
304    ELSE IF ( int_handle_in_use( DataHandle ) .AND. opened_for_write ( DataHandle ) ) THEN
305      IF ( okay_to_write ( DataHandle ) ) THEN
306        FileStatus = WRF_FILE_OPENED_FOR_WRITE
307      ELSE
308        FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
309      ENDIF
310    ENDIF
311  ENDIF
312  Status = 0
313 
314  RETURN
315END SUBROUTINE ext_mcel_inquire_opened
316
317!--- inquire_filename
318SUBROUTINE ext_mcel_inquire_filename ( DataHandle, FileName , FileStatus, Status )
319  USE module_ext_mcel
320  IMPLICIT NONE
321  INTEGER ,       INTENT(IN)  :: DataHandle
322  CHARACTER*(*) :: FileName
323  INTEGER ,       INTENT(OUT) :: FileStatus
324  INTEGER ,       INTENT(OUT) :: Status
325  CHARACTER *80   SysDepInfo
326  Status = 0
327  FileStatus = WRF_FILE_NOT_OPENED
328  IF ( int_valid_handle( DataHandle ) ) THEN
329    IF ( int_handle_in_use( DataHandle ) ) THEN
330      IF ( opened_for_read ( DataHandle ) ) THEN
331        IF ( okay_to_read( DataHandle ) ) THEN
332           FileStatus = WRF_FILE_OPENED_FOR_READ
333        ELSE
334           FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
335        ENDIF
336      ELSE IF ( opened_for_write( DataHandle ) ) THEN
337        IF ( okay_to_write( DataHandle ) ) THEN
338           FileStatus = WRF_FILE_OPENED_FOR_WRITE
339        ELSE
340           FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
341        ENDIF
342      ELSE
343        FileStatus = WRF_FILE_NOT_OPENED
344      ENDIF
345    ENDIF
346  ENDIF
347  Status = 0
348END SUBROUTINE ext_mcel_inquire_filename
349
350!--- sync
351SUBROUTINE ext_mcel_iosync ( DataHandle, Status )
352  USE module_ext_mcel
353  IMPLICIT NONE
354  INTEGER ,       INTENT(IN)  :: DataHandle
355  INTEGER ,       INTENT(OUT) :: Status
356
357  Status = 0
358  RETURN
359END SUBROUTINE ext_mcel_iosync
360
361!--- close
362SUBROUTINE ext_mcel_ioclose ( DataHandle, Status )
363  USE module_ext_mcel
364  IMPLICIT NONE
365  INTEGER DataHandle, Status
366
367  IF ( int_valid_handle (DataHandle) ) THEN
368    IF ( int_handle_in_use( DataHandle ) ) THEN
369      CLOSE ( DataHandle )
370    ENDIF
371  ENDIF
372
373  Status = 0
374
375  RETURN
376END SUBROUTINE ext_mcel_ioclose
377
378!--- ioexit
379SUBROUTINE ext_mcel_ioexit( Status )
380
381  USE module_ext_mcel
382  IMPLICIT NONE
383  INTEGER ,       INTENT(OUT) :: Status
384  INTEGER                     :: DataHandle
385  INTEGER i,ierr
386  REAL dummy
387
388  RETURN 
389END SUBROUTINE ext_mcel_ioexit
390
391!--- get_next_time
392SUBROUTINE ext_mcel_get_next_time ( DataHandle, DateStr, Status )
393  USE module_ext_mcel
394  IMPLICIT NONE
395  INTEGER ,       INTENT(IN)  :: DataHandle
396  CHARACTER*(*) :: DateStr
397  INTEGER ,       INTENT(OUT) :: Status
398  INTEGER         code
399  CHARACTER*132   locElement, dummyvar
400  INTEGER istat
401
402!local
403  INTEGER                        :: locDataHandle
404  CHARACTER*132                  :: locDateStr
405  CHARACTER*132                  :: locVarName
406  integer                        :: locFieldType
407  integer                        :: locComm
408  integer                        :: locIOComm
409  integer                        :: locDomainDesc
410  character*132                  :: locMemoryOrder
411  character*132                  :: locStagger
412  character*132 , dimension (3)  :: locDimNames
413  integer ,dimension(3)          :: locDomainStart, locDomainEnd
414  integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
415  integer ,dimension(3)          :: locPatchStart,  locPatchEnd
416
417  character*132 mess
418  integer ii,jj,kk,myrank
419  INTEGER inttypesize, realtypesize
420  REAL, DIMENSION( 1 ) :: Field
421
422  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
423    CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_next_time: invalid data handle" )
424  ENDIF
425  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
426    CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_next_time: DataHandle not opened" )
427  ENDIF
428  inttypesize = itypesize
429  realtypesize = rtypesize
430
431  Status = WRF_WARN_NOTSUPPORTED
432
433  RETURN
434END SUBROUTINE ext_mcel_get_next_time
435
436!--- set_time
437SUBROUTINE ext_mcel_set_time ( DataHandle, DateStr, Status )
438  USE module_ext_mcel
439  IMPLICIT NONE
440  INTEGER ,       INTENT(IN)  :: DataHandle
441  CHARACTER*(*) :: DateStr
442  INTEGER ,       INTENT(OUT) :: Status
443
444  Status = WRF_WARN_NOTSUPPORTED
445  RETURN
446END SUBROUTINE ext_mcel_set_time
447
448!--- get_var_info
449SUBROUTINE ext_mcel_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , Stagger , &
450                              DomainStart , DomainEnd , WrfType, Status )
451  USE module_ext_mcel
452  IMPLICIT NONE
453  integer               ,intent(in)     :: DataHandle
454  character*(*)         ,intent(in)     :: VarName
455  integer               ,intent(out)    :: NDim
456  character*(*)         ,intent(out)    :: MemoryOrder
457  character*(*)         ,intent(out)    :: Stagger
458  integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
459  integer               ,intent(out)    :: WrfType
460  integer               ,intent(out)    :: Status
461
462!local
463  INTEGER                        :: locDataHandle
464  CHARACTER*132                  :: locDateStr
465  CHARACTER*132                  :: locVarName
466  integer                        :: locFieldType
467  integer                        :: locComm
468  integer                        :: locIOComm
469  integer                        :: locDomainDesc
470  character*132                  :: locMemoryOrder
471  character*132                  :: locStagger
472  character*132 , dimension (3)  :: locDimNames
473  integer ,dimension(3)          :: locDomainStart, locDomainEnd
474  integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
475  integer ,dimension(3)          :: locPatchStart,  locPatchEnd
476
477  character*132 mess
478  integer ii,jj,kk,myrank
479  INTEGER inttypesize, realtypesize, istat, code
480  REAL, DIMENSION( 1 ) :: Field
481
482  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
483    CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_var_info: invalid data handle" )
484  ENDIF
485  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
486    CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_var_info: DataHandle not opened" )
487  ENDIF
488  inttypesize = itypesize
489  realtypesize = rtypesize
490  Status = 0
491
492RETURN
493END SUBROUTINE ext_mcel_get_var_info
494
495!--- get_next_var  (not defined for IntIO)
496SUBROUTINE ext_mcel_get_next_var ( DataHandle, VarName, Status )
497  USE module_ext_mcel
498  IMPLICIT NONE
499  INTEGER ,       INTENT(IN)  :: DataHandle
500  CHARACTER*(*) :: VarName
501  INTEGER ,       INTENT(OUT) :: Status
502
503!local
504  INTEGER                        :: locDataHandle
505  CHARACTER*132                  :: locDateStr
506  CHARACTER*132                  :: locVarName
507  integer                        :: locFieldType
508  integer                        :: locComm
509  integer                        :: locIOComm
510  integer                        :: locDomainDesc
511  character*132                  :: locMemoryOrder
512  character*132                  :: locStagger
513  character*132 , dimension (3)  :: locDimNames
514  integer ,dimension(3)          :: locDomainStart, locDomainEnd
515  integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
516  integer ,dimension(3)          :: locPatchStart,  locPatchEnd
517
518character*128 locElement, strData, dumstr
519integer loccode, loccount
520integer idata(128)
521real    rdata(128)
522
523  character*132 mess
524  integer ii,jj,kk,myrank
525  INTEGER inttypesize, realtypesize, istat, code
526  REAL, DIMENSION( 1 ) :: Field
527
528  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
529    CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_next_var: invalid data handle" )
530  ENDIF
531  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
532    CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_next_var: DataHandle not opened" )
533  ENDIF
534  inttypesize = itypesize
535  realtypesize = rtypesize
536
537  Status = 0
538
539  RETURN
540END SUBROUTINE ext_mcel_get_next_var
541
542!--- get_dom_ti_real
543SUBROUTINE ext_mcel_get_dom_ti_real ( DataHandle,Element,   Data, Count, Outcount, Status )
544  USE module_ext_mcel
545  IMPLICIT NONE
546  INTEGER ,       INTENT(IN)  :: DataHandle
547  CHARACTER*(*) :: Element
548  real ,            INTENT(IN) :: Data(*)
549  INTEGER ,       INTENT(IN)  :: Count
550  INTEGER ,       INTENT(OUT) :: Outcount
551  INTEGER ,       INTENT(OUT) :: Status
552  INTEGER loccount, code, istat, locDataHandle
553  CHARACTER*132                :: locElement, mess
554  LOGICAL keepgoing
555
556  Status = 0
557
558RETURN
559END SUBROUTINE ext_mcel_get_dom_ti_real
560
561!--- put_dom_ti_real
562SUBROUTINE ext_mcel_put_dom_ti_real ( DataHandle,Element,   Data, Count,  Status )
563  USE module_ext_mcel
564  IMPLICIT NONE
565  INTEGER ,       INTENT(IN)  :: DataHandle
566  CHARACTER*(*) :: Element
567  real ,            INTENT(IN) :: Data(*)
568  INTEGER ,       INTENT(IN)  :: Count
569  INTEGER ,       INTENT(OUT) :: Status
570  REAL dummy
571!
572
573  Status = 0
574RETURN
575END SUBROUTINE ext_mcel_put_dom_ti_real
576
577!--- get_dom_ti_double
578SUBROUTINE ext_mcel_get_dom_ti_double ( DataHandle,Element,   Data, Count, Outcount, Status )
579  IMPLICIT NONE
580  INTEGER ,       INTENT(IN)  :: DataHandle
581  CHARACTER*(*) :: Element
582  real*8 ,            INTENT(OUT) :: Data(*)
583  INTEGER ,       INTENT(IN)  :: Count
584  INTEGER ,       INTENT(OUT)  :: OutCount
585  INTEGER ,       INTENT(OUT) :: Status
586  CALL wrf_message('ext_mcel_get_dom_ti_double not supported yet')
587RETURN
588END SUBROUTINE ext_mcel_get_dom_ti_double
589
590!--- put_dom_ti_double
591SUBROUTINE ext_mcel_put_dom_ti_double ( DataHandle,Element,   Data, Count,  Status )
592  IMPLICIT NONE
593  INTEGER ,       INTENT(IN)  :: DataHandle
594  CHARACTER*(*) :: Element
595  real*8 ,            INTENT(IN) :: Data(*)
596  INTEGER ,       INTENT(IN)  :: Count
597  INTEGER ,       INTENT(OUT) :: Status
598  CALL wrf_message('ext_mcel_put_dom_ti_double not supported yet')
599RETURN
600END SUBROUTINE ext_mcel_put_dom_ti_double
601
602!--- get_dom_ti_integer
603SUBROUTINE ext_mcel_get_dom_ti_integer ( DataHandle,Element,   Data, Count, Outcount, Status )
604  USE module_ext_mcel
605  IMPLICIT NONE
606  INTEGER ,       INTENT(IN)  :: DataHandle
607  CHARACTER*(*) :: Element
608  integer ,            INTENT(OUT) :: Data(*)
609  INTEGER ,       INTENT(IN)  :: Count
610  INTEGER ,       INTENT(OUT)  :: OutCount
611  INTEGER ,       INTENT(OUT) :: Status
612  INTEGER loccount, code, istat, locDataHandle
613  CHARACTER*132   locElement, mess
614  LOGICAL keepgoing
615
616  Status = 0
617RETURN
618END SUBROUTINE ext_mcel_get_dom_ti_integer
619
620!--- put_dom_ti_integer
621SUBROUTINE ext_mcel_put_dom_ti_integer ( DataHandle,Element,   Data, Count,  Status )
622  USE module_ext_mcel
623  IMPLICIT NONE
624  INTEGER ,       INTENT(IN)  :: DataHandle
625  CHARACTER*(*) :: Element
626  INTEGER ,       INTENT(IN) :: Data(*)
627  INTEGER ,       INTENT(IN)  :: Count
628  INTEGER ,       INTENT(OUT) :: Status
629  REAL dummy
630!
631  Status = 0
632RETURN
633END SUBROUTINE ext_mcel_put_dom_ti_integer
634
635!--- get_dom_ti_logical
636SUBROUTINE ext_mcel_get_dom_ti_logical ( DataHandle,Element,   Data, Count, Outcount, Status )
637  IMPLICIT NONE
638  INTEGER ,       INTENT(IN)  :: DataHandle
639  CHARACTER*(*) :: Element
640  logical ,            INTENT(OUT) :: Data(*)
641  INTEGER ,       INTENT(IN)  :: Count
642  INTEGER ,       INTENT(OUT)  :: OutCount
643  INTEGER ,       INTENT(OUT) :: Status
644  CALL wrf_message('ext_mcel_get_dom_ti_logical not supported yet')
645RETURN
646END SUBROUTINE ext_mcel_get_dom_ti_logical
647
648!--- put_dom_ti_logical
649SUBROUTINE ext_mcel_put_dom_ti_logical ( DataHandle,Element,   Data, Count,  Status )
650  IMPLICIT NONE
651  INTEGER ,       INTENT(IN)  :: DataHandle
652  CHARACTER*(*) :: Element
653  logical ,            INTENT(IN) :: Data(*)
654  INTEGER ,       INTENT(IN)  :: Count
655  INTEGER ,       INTENT(OUT) :: Status
656  CALL wrf_message('ext_mcel_put_dom_ti_logical not supported yet')
657RETURN
658END SUBROUTINE ext_mcel_put_dom_ti_logical
659
660!--- get_dom_ti_char
661SUBROUTINE ext_mcel_get_dom_ti_char ( DataHandle,Element,   Data,  Status )
662  USE module_ext_mcel
663  IMPLICIT NONE
664  INTEGER ,       INTENT(IN)  :: DataHandle
665  CHARACTER*(*) :: Element
666  CHARACTER*(*) :: Data
667  INTEGER ,       INTENT(OUT) :: Status
668  INTEGER istat, code, i
669  CHARACTER*79 dumstr, locElement
670  INTEGER locDataHandle
671  LOGICAL keepgoing
672
673  Status = 0
674RETURN
675END SUBROUTINE ext_mcel_get_dom_ti_char
676
677!--- put_dom_ti_char
678SUBROUTINE ext_mcel_put_dom_ti_char ( DataHandle, Element,  Data,  Status )
679  USE module_ext_mcel
680  IMPLICIT NONE
681  INTEGER ,       INTENT(IN)  :: DataHandle
682  CHARACTER*(*) :: Element
683  CHARACTER*(*) :: Data
684  INTEGER ,       INTENT(OUT) :: Status
685  INTEGER i
686  REAL dummy
687  INTEGER                 :: Count
688
689! TBH:  Not sure what this is doing here.  2004_11_15
690! JGM:  You are right. It does not belong here.  2006_09_28
691!  IF ( int_valid_handle ( Datahandle ) ) THEN
692!    IF ( int_handle_in_use( DataHandle ) ) THEN
693!      CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize,  &
694!                                   DataHandle, Element, "", Data, int_dom_ti_char )
695!      WRITE( unit=DataHandle ) hdrbuf
696!    ENDIF
697!  ENDIF
698  Status = 0
699RETURN
700END SUBROUTINE ext_mcel_put_dom_ti_char
701
702!--- get_dom_td_real
703SUBROUTINE ext_mcel_get_dom_td_real ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
704  IMPLICIT NONE
705  INTEGER ,       INTENT(IN)  :: DataHandle
706  CHARACTER*(*) :: Element
707  CHARACTER*(*) :: DateStr
708  real ,            INTENT(OUT) :: Data(*)
709  INTEGER ,       INTENT(IN)  :: Count
710  INTEGER ,       INTENT(OUT)  :: OutCount
711  INTEGER ,       INTENT(OUT) :: Status
712RETURN
713END SUBROUTINE ext_mcel_get_dom_td_real
714
715!--- put_dom_td_real
716SUBROUTINE ext_mcel_put_dom_td_real ( DataHandle,Element, DateStr,  Data, Count,  Status )
717  IMPLICIT NONE
718  INTEGER ,       INTENT(IN)  :: DataHandle
719  CHARACTER*(*) :: Element
720  CHARACTER*(*) :: DateStr
721  real ,            INTENT(IN) :: Data(*)
722  INTEGER ,       INTENT(IN)  :: Count
723  INTEGER ,       INTENT(OUT) :: Status
724RETURN
725END SUBROUTINE ext_mcel_put_dom_td_real
726
727!--- get_dom_td_double
728SUBROUTINE ext_mcel_get_dom_td_double ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
729  IMPLICIT NONE
730  INTEGER ,       INTENT(IN)  :: DataHandle
731  CHARACTER*(*) :: Element
732  CHARACTER*(*) :: DateStr
733  real*8 ,            INTENT(OUT) :: Data(*)
734  INTEGER ,       INTENT(IN)  :: Count
735  INTEGER ,       INTENT(OUT)  :: OutCount
736  INTEGER ,       INTENT(OUT) :: Status
737RETURN
738END SUBROUTINE ext_mcel_get_dom_td_double
739
740!--- put_dom_td_double
741SUBROUTINE ext_mcel_put_dom_td_double ( DataHandle,Element, DateStr,  Data, Count,  Status )
742  IMPLICIT NONE
743  INTEGER ,       INTENT(IN)  :: DataHandle
744  CHARACTER*(*) :: Element
745  CHARACTER*(*) :: DateStr
746  real*8 ,            INTENT(IN) :: Data(*)
747  INTEGER ,       INTENT(IN)  :: Count
748  INTEGER ,       INTENT(OUT) :: Status
749RETURN
750END SUBROUTINE ext_mcel_put_dom_td_double
751
752!--- get_dom_td_integer
753SUBROUTINE ext_mcel_get_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
754  IMPLICIT NONE
755  INTEGER ,       INTENT(IN)  :: DataHandle
756  CHARACTER*(*) :: Element
757  CHARACTER*(*) :: DateStr
758  integer ,            INTENT(OUT) :: Data(*)
759  INTEGER ,       INTENT(IN)  :: Count
760  INTEGER ,       INTENT(OUT)  :: OutCount
761  INTEGER ,       INTENT(OUT) :: Status
762RETURN
763END SUBROUTINE ext_mcel_get_dom_td_integer
764
765!--- put_dom_td_integer
766SUBROUTINE ext_mcel_put_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count,  Status )
767  IMPLICIT NONE
768  INTEGER ,       INTENT(IN)  :: DataHandle
769  CHARACTER*(*) :: Element
770  CHARACTER*(*) :: DateStr
771  integer ,            INTENT(IN) :: Data(*)
772  INTEGER ,       INTENT(IN)  :: Count
773  INTEGER ,       INTENT(OUT) :: Status
774RETURN
775END SUBROUTINE ext_mcel_put_dom_td_integer
776
777!--- get_dom_td_logical
778SUBROUTINE ext_mcel_get_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
779  IMPLICIT NONE
780  INTEGER ,       INTENT(IN)  :: DataHandle
781  CHARACTER*(*) :: Element
782  CHARACTER*(*) :: DateStr
783  logical ,            INTENT(OUT) :: Data(*)
784  INTEGER ,       INTENT(IN)  :: Count
785  INTEGER ,       INTENT(OUT)  :: OutCount
786  INTEGER ,       INTENT(OUT) :: Status
787RETURN
788END SUBROUTINE ext_mcel_get_dom_td_logical
789
790!--- put_dom_td_logical
791SUBROUTINE ext_mcel_put_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count,  Status )
792  IMPLICIT NONE
793  INTEGER ,       INTENT(IN)  :: DataHandle
794  CHARACTER*(*) :: Element
795  CHARACTER*(*) :: DateStr
796  logical ,            INTENT(IN) :: Data(*)
797  INTEGER ,       INTENT(IN)  :: Count
798  INTEGER ,       INTENT(OUT) :: Status
799RETURN
800END SUBROUTINE ext_mcel_put_dom_td_logical
801
802!--- get_dom_td_char
803SUBROUTINE ext_mcel_get_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
804  IMPLICIT NONE
805  INTEGER ,       INTENT(IN)  :: DataHandle
806  CHARACTER*(*) :: Element
807  CHARACTER*(*) :: DateStr
808  CHARACTER*(*) :: Data
809  INTEGER ,       INTENT(OUT) :: Status
810RETURN
811END SUBROUTINE ext_mcel_get_dom_td_char
812
813!--- put_dom_td_char
814SUBROUTINE ext_mcel_put_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
815  IMPLICIT NONE
816  INTEGER ,       INTENT(IN)  :: DataHandle
817  CHARACTER*(*) :: Element
818  CHARACTER*(*) :: DateStr
819  CHARACTER*(*) :: Data
820  INTEGER ,       INTENT(OUT) :: Status
821RETURN
822END SUBROUTINE ext_mcel_put_dom_td_char
823
824!--- get_var_ti_real
825SUBROUTINE ext_mcel_get_var_ti_real ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
826  IMPLICIT NONE
827  INTEGER ,       INTENT(IN)  :: DataHandle
828  CHARACTER*(*) :: Element
829  CHARACTER*(*) :: VarName
830  real ,            INTENT(OUT) :: Data(*)
831  INTEGER ,       INTENT(IN)  :: Count
832  INTEGER ,       INTENT(OUT)  :: OutCount
833  INTEGER ,       INTENT(OUT) :: Status
834RETURN
835END SUBROUTINE ext_mcel_get_var_ti_real
836
837!--- put_var_ti_real
838SUBROUTINE ext_mcel_put_var_ti_real ( DataHandle,Element,  Varname, Data, Count,  Status )
839  IMPLICIT NONE
840  INTEGER ,       INTENT(IN)  :: DataHandle
841  CHARACTER*(*) :: Element
842  CHARACTER*(*) :: VarName
843  real ,            INTENT(IN) :: Data(*)
844  INTEGER ,       INTENT(IN)  :: Count
845  INTEGER ,       INTENT(OUT) :: Status
846RETURN
847END SUBROUTINE ext_mcel_put_var_ti_real
848
849!--- get_var_ti_double
850SUBROUTINE ext_mcel_get_var_ti_double ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
851  IMPLICIT NONE
852  INTEGER ,       INTENT(IN)  :: DataHandle
853  CHARACTER*(*) :: Element
854  CHARACTER*(*) :: VarName
855  real*8 ,            INTENT(OUT) :: Data(*)
856  INTEGER ,       INTENT(IN)  :: Count
857  INTEGER ,       INTENT(OUT)  :: OutCount
858  INTEGER ,       INTENT(OUT) :: Status
859RETURN
860END SUBROUTINE ext_mcel_get_var_ti_double
861
862!--- put_var_ti_double
863SUBROUTINE ext_mcel_put_var_ti_double ( DataHandle,Element,  Varname, Data, Count,  Status )
864  IMPLICIT NONE
865  INTEGER ,       INTENT(IN)  :: DataHandle
866  CHARACTER*(*) :: Element
867  CHARACTER*(*) :: VarName
868  real*8 ,            INTENT(IN) :: Data(*)
869  INTEGER ,       INTENT(IN)  :: Count
870  INTEGER ,       INTENT(OUT) :: Status
871RETURN
872END SUBROUTINE ext_mcel_put_var_ti_double
873
874!--- get_var_ti_integer
875SUBROUTINE ext_mcel_get_var_ti_integer ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
876  IMPLICIT NONE
877  INTEGER ,       INTENT(IN)  :: DataHandle
878  CHARACTER*(*) :: Element
879  CHARACTER*(*) :: VarName
880  integer ,            INTENT(OUT) :: Data(*)
881  INTEGER ,       INTENT(IN)  :: Count
882  INTEGER ,       INTENT(OUT)  :: OutCount
883  INTEGER ,       INTENT(OUT) :: Status
884RETURN
885END SUBROUTINE ext_mcel_get_var_ti_integer
886
887!--- put_var_ti_integer
888SUBROUTINE ext_mcel_put_var_ti_integer ( DataHandle,Element,  Varname, Data, Count,  Status )
889  IMPLICIT NONE
890  INTEGER ,       INTENT(IN)  :: DataHandle
891  CHARACTER*(*) :: Element
892  CHARACTER*(*) :: VarName
893  integer ,            INTENT(IN) :: Data(*)
894  INTEGER ,       INTENT(IN)  :: Count
895  INTEGER ,       INTENT(OUT) :: Status
896RETURN
897END SUBROUTINE ext_mcel_put_var_ti_integer
898
899!--- get_var_ti_logical
900SUBROUTINE ext_mcel_get_var_ti_logical ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
901  IMPLICIT NONE
902  INTEGER ,       INTENT(IN)  :: DataHandle
903  CHARACTER*(*) :: Element
904  CHARACTER*(*) :: VarName
905  logical ,            INTENT(OUT) :: Data(*)
906  INTEGER ,       INTENT(IN)  :: Count
907  INTEGER ,       INTENT(OUT)  :: OutCount
908  INTEGER ,       INTENT(OUT) :: Status
909RETURN
910END SUBROUTINE ext_mcel_get_var_ti_logical
911
912!--- put_var_ti_logical
913SUBROUTINE ext_mcel_put_var_ti_logical ( DataHandle,Element,  Varname, Data, Count,  Status )
914  IMPLICIT NONE
915  INTEGER ,       INTENT(IN)  :: DataHandle
916  CHARACTER*(*) :: Element
917  CHARACTER*(*) :: VarName
918  logical ,            INTENT(IN) :: Data(*)
919  INTEGER ,       INTENT(IN)  :: Count
920  INTEGER ,       INTENT(OUT) :: Status
921RETURN
922END SUBROUTINE ext_mcel_put_var_ti_logical
923
924!--- get_var_ti_char
925SUBROUTINE ext_mcel_get_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
926  USE module_ext_mcel
927  IMPLICIT NONE
928  INTEGER ,       INTENT(IN)  :: DataHandle
929  CHARACTER*(*) :: Element
930  CHARACTER*(*) :: VarName
931  CHARACTER*(*) :: Data
932  INTEGER ,       INTENT(OUT) :: Status
933  INTEGER locDataHandle, code
934  CHARACTER*132 locElement, locVarName
935  Status = 0
936RETURN
937END SUBROUTINE ext_mcel_get_var_ti_char
938
939!--- put_var_ti_char
940SUBROUTINE ext_mcel_put_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
941  USE module_ext_mcel
942  IMPLICIT NONE
943  INTEGER ,       INTENT(IN)  :: DataHandle
944  CHARACTER*(*) :: Element
945  CHARACTER*(*) :: VarName
946  CHARACTER*(*) :: Data
947  INTEGER ,       INTENT(OUT) :: Status
948  REAL dummy
949  INTEGER                 :: Count
950  Status = 0
951RETURN
952END SUBROUTINE ext_mcel_put_var_ti_char
953
954!--- get_var_td_real
955SUBROUTINE ext_mcel_get_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
956  IMPLICIT NONE
957  INTEGER ,       INTENT(IN)  :: DataHandle
958  CHARACTER*(*) :: Element
959  CHARACTER*(*) :: DateStr
960  CHARACTER*(*) :: VarName
961  real ,            INTENT(OUT) :: Data(*)
962  INTEGER ,       INTENT(IN)  :: Count
963  INTEGER ,       INTENT(OUT)  :: OutCount
964  INTEGER ,       INTENT(OUT) :: Status
965RETURN
966END SUBROUTINE ext_mcel_get_var_td_real
967
968!--- put_var_td_real
969SUBROUTINE ext_mcel_put_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
970  IMPLICIT NONE
971  INTEGER ,       INTENT(IN)  :: DataHandle
972  CHARACTER*(*) :: Element
973  CHARACTER*(*) :: DateStr
974  CHARACTER*(*) :: VarName
975  real ,            INTENT(IN) :: Data(*)
976  INTEGER ,       INTENT(IN)  :: Count
977  INTEGER ,       INTENT(OUT) :: Status
978RETURN
979END SUBROUTINE ext_mcel_put_var_td_real
980
981!--- get_var_td_double
982SUBROUTINE ext_mcel_get_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
983  IMPLICIT NONE
984  INTEGER ,       INTENT(IN)  :: DataHandle
985  CHARACTER*(*) :: Element
986  CHARACTER*(*) :: DateStr
987  CHARACTER*(*) :: VarName
988  real*8 ,            INTENT(OUT) :: Data(*)
989  INTEGER ,       INTENT(IN)  :: Count
990  INTEGER ,       INTENT(OUT)  :: OutCount
991  INTEGER ,       INTENT(OUT) :: Status
992RETURN
993END SUBROUTINE ext_mcel_get_var_td_double
994
995!--- put_var_td_double
996SUBROUTINE ext_mcel_put_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
997  IMPLICIT NONE
998  INTEGER ,       INTENT(IN)  :: DataHandle
999  CHARACTER*(*) :: Element
1000  CHARACTER*(*) :: DateStr
1001  CHARACTER*(*) :: VarName
1002  real*8 ,            INTENT(IN) :: Data(*)
1003  INTEGER ,       INTENT(IN)  :: Count
1004  INTEGER ,       INTENT(OUT) :: Status
1005RETURN
1006END SUBROUTINE ext_mcel_put_var_td_double
1007
1008!--- get_var_td_integer
1009SUBROUTINE ext_mcel_get_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
1010  IMPLICIT NONE
1011  INTEGER ,       INTENT(IN)  :: DataHandle
1012  CHARACTER*(*) :: Element
1013  CHARACTER*(*) :: DateStr
1014  CHARACTER*(*) :: VarName
1015  integer ,            INTENT(OUT) :: Data(*)
1016  INTEGER ,       INTENT(IN)  :: Count
1017  INTEGER ,       INTENT(OUT)  :: OutCount
1018  INTEGER ,       INTENT(OUT) :: Status
1019RETURN
1020END SUBROUTINE ext_mcel_get_var_td_integer
1021
1022!--- put_var_td_integer
1023SUBROUTINE ext_mcel_put_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
1024  IMPLICIT NONE
1025  INTEGER ,       INTENT(IN)  :: DataHandle
1026  CHARACTER*(*) :: Element
1027  CHARACTER*(*) :: DateStr
1028  CHARACTER*(*) :: VarName
1029  integer ,            INTENT(IN) :: Data(*)
1030  INTEGER ,       INTENT(IN)  :: Count
1031  INTEGER ,       INTENT(OUT) :: Status
1032RETURN
1033END SUBROUTINE ext_mcel_put_var_td_integer
1034
1035!--- get_var_td_logical
1036SUBROUTINE ext_mcel_get_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
1037  IMPLICIT NONE
1038  INTEGER ,       INTENT(IN)  :: DataHandle
1039  CHARACTER*(*) :: Element
1040  CHARACTER*(*) :: DateStr
1041  CHARACTER*(*) :: VarName
1042  logical ,            INTENT(OUT) :: Data(*)
1043  INTEGER ,       INTENT(IN)  :: Count
1044  INTEGER ,       INTENT(OUT)  :: OutCount
1045  INTEGER ,       INTENT(OUT) :: Status
1046RETURN
1047END SUBROUTINE ext_mcel_get_var_td_logical
1048
1049!--- put_var_td_logical
1050SUBROUTINE ext_mcel_put_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
1051  IMPLICIT NONE
1052  INTEGER ,       INTENT(IN)  :: DataHandle
1053  CHARACTER*(*) :: Element
1054  CHARACTER*(*) :: DateStr
1055  CHARACTER*(*) :: VarName
1056  logical ,            INTENT(IN) :: Data(*)
1057  INTEGER ,       INTENT(IN)  :: Count
1058  INTEGER ,       INTENT(OUT) :: Status
1059RETURN
1060END SUBROUTINE ext_mcel_put_var_td_logical
1061
1062!--- get_var_td_char
1063SUBROUTINE ext_mcel_get_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
1064  IMPLICIT NONE
1065  INTEGER ,       INTENT(IN)  :: DataHandle
1066  CHARACTER*(*) :: Element
1067  CHARACTER*(*) :: DateStr
1068  CHARACTER*(*) :: VarName
1069  CHARACTER*(*) :: Data
1070  INTEGER ,       INTENT(OUT) :: Status
1071RETURN
1072END SUBROUTINE ext_mcel_get_var_td_char
1073
1074!--- put_var_td_char
1075SUBROUTINE ext_mcel_put_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
1076  IMPLICIT NONE
1077  INTEGER ,       INTENT(IN)  :: DataHandle
1078  CHARACTER*(*) :: Element
1079  CHARACTER*(*) :: DateStr
1080  CHARACTER*(*) :: VarName
1081  CHARACTER*(*) :: Data
1082  INTEGER ,       INTENT(OUT) :: Status
1083RETURN
1084END SUBROUTINE ext_mcel_put_var_td_char
1085
1086SUBROUTINE ext_mcel_georegister( DataHandle, inlon, inlat,                                    &
1087                                 MemoryStart , MemoryEnd ,                                    &
1088                                 PatchStart , PatchEnd ,                                      &
1089                                 Status )
1090  USE module_ext_mcel
1091  IMPLICIT NONE
1092  integer                       ,intent(in)    :: DataHandle
1093  integer                       ,intent(inout) :: Status
1094  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
1095  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
1096  REAL , DIMENSION(MemoryStart(1):MemoryEnd(1),MemoryStart(2):MemoryEnd(2)), INTENT(IN) :: inlon, inlat
1097  integer ips,ipe,jps,jpe
1098  integer ims,ime,jms,jme
1099  integer idex,ierr,i,j
1100
1101  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
1102    CALL wrf_error_fatal("ext_mcel_georegister: invalid data handle" )
1103  ENDIF
1104  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
1105    CALL wrf_error_fatal("ext_mcel_georegister: DataHandle not opened" )
1106  ENDIF
1107  IF ( mcel_finalized( DataHandle ) ) THEN
1108    CALL wrf_error_fatal( "ext_mcel_georegister: called after first read/write operation" ) ;
1109  ENDIF
1110
1111  ips = PatchStart(1) ; ipe = PatchEnd(1)
1112  jps = PatchStart(2) ; jpe = PatchEnd(2)
1113  ims = MemoryStart(1) ; ime = MemoryEnd(1)
1114  jms = MemoryStart(2) ; jme = MemoryEnd(2)
1115
1116  IF ( ALLOCATED(xlat) ) THEN
1117    DEALLOCATE(xlat)
1118  ENDIF
1119  IF ( ALLOCATED(xlong) ) THEN
1120    DEALLOCATE(xlong)
1121  ENDIF
1122  ALLOCATE(xlat(ips:ipe,jps:jpe))
1123  DO j = jps, jpe
1124    DO i = ips, ipe
1125      idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
1126      xlat(i,j) = inlat( i,j)  ! idex )
1127    ENDDO
1128  ENDDO
1129  ALLOCATE(xlong(ips:ipe,jps:jpe))
1130  DO j = jps, jpe
1131    DO i = ips, ipe
1132      idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
1133      xlong(i,j) = inlon( i,j ) ! idex )
1134    ENDDO
1135  ENDDO
1136  RETURN
1137END SUBROUTINE ext_mcel_georegister
1138
1139SUBROUTINE ext_mcel_mask ( DataHandle, inmask,                                          &
1140                           MemoryStart , MemoryEnd ,                                    &
1141                           PatchStart , PatchEnd ,                                      &
1142                           Status )
1143  USE module_ext_mcel
1144  IMPLICIT NONE
1145  integer                       ,intent(in)    :: DataHandle
1146  integer                       ,intent(inout) :: Status
1147  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
1148  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
1149  INTEGER , DIMENSION(MemoryStart(1):MemoryEnd(1),MemoryStart(2):MemoryEnd(2)), INTENT(IN) :: inmask
1150  integer ips,ipe,jps,jpe
1151  integer ims,ime,jms,jme
1152  integer idex,ierr,i,j
1153
1154  ips = PatchStart(1) ; ipe = PatchEnd(1)
1155  jps = PatchStart(2) ; jpe = PatchEnd(2)
1156  ims = MemoryStart(1) ; ime = MemoryEnd(1)
1157  jms = MemoryStart(2) ; jme = MemoryEnd(2)
1158
1159  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
1160    CALL wrf_error_fatal("ext_mcel_mask: invalid data handle" )
1161  ENDIF
1162  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
1163    CALL wrf_error_fatal("ext_mcel_mask: DataHandle not opened" )
1164  ENDIF
1165  IF ( mcel_finalized( DataHandle ) ) THEN
1166    CALL wrf_error_fatal( "ext_mcel_mask: called after first read/write operation" ) ;
1167  ENDIF
1168
1169  IF ( ALLOCATED(mask) ) THEN
1170    DEALLOCATE(mask)
1171  ENDIF
1172  ALLOCATE(mask(ips:ipe,jps:jpe))
1173  DO j = jps, jpe
1174    DO i = ips, ipe
1175      idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
1176      mask(i,j) = inmask( i,j ) ! idex )
1177    ENDDO
1178  ENDDO
1179  RETURN
1180END SUBROUTINE ext_mcel_mask
1181
1182INTEGER FUNCTION cast_to_int( a )
1183  INTEGER a
1184  cast_to_int = a
1185  RETURN
1186END FUNCTION cast_to_int
1187
Note: See TracBrowser for help on using the repository browser.