PageRenderTime 60ms CodeModel.GetById 15ms RepoModel.GetById 0ms app.codeStats 1ms

/wrfv2_fire/frame/module_io.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 4109 lines | 2594 code | 288 blank | 1227 comment | 5 complexity | 9a0c386588802cefdf14e6b9e8dcc79a MD5 | raw file
Possible License(s): AGPL-1.0

Large files files are truncated, but you can click here to view the full file

    

  1. !WRF:DRIVER_LAYER:IO
    2. 

  2. !
    3. 

  3. #define DEBUG_LVL 500
    4. 

  4. 

  5. MODULE module_io
    6. 

  6. !<DESCRIPTION>
    7. 

  7. !<PRE>
    8. 

  8. ! WRF-specific package-independent interface to package-dependent WRF-specific
    9. 

  9. ! I/O packages.
    10. 

  10. !
    11. 

  11. ! These routines have the same names as those specified in the WRF I/O API 
    12. 

  12. ! except that:
    13. 

  13. ! - Routines defined in this file and called by users of this module have 
    14. 

  14. !   the "wrf_" prefix.  
    15. 

  15. ! - Routines defined in the I/O packages and called from routines in this 
    16. 

  16. !   file have the "ext_" prefix.  
    17. 

  17. ! - Routines called from routines in this file to initiate communication 
    18. 

  18. !   with I/O quilt servers have the "wrf_quilt_" prefix.  
    19. 

  19. !
    20. 

  20. ! See http://www.mmm.ucar.edu/wrf/WG2/software_2.0/IOAPI.doc for the latest 
    21. 

  21. ! version of the WRF I/O API.  This document includes detailed descriptions 
    22. 

  22. ! of subroutines and their arguments that are not duplicated in this file.  
    23. 

  23. !
    24. 

  24. ! We wish to be able to link to different packages depending on whether
    25. 

  25. ! the I/O is restart, initial, history, or boundary.  
    26. 

  26. !</PRE>
    27. 

  27. !</DESCRIPTION>
    28. 

  28. 

  29.   USE module_configure
    30. 

  30. 

  31.   LOGICAL :: is_inited = .FALSE.
    32. 

  32.   INTEGER, PARAMETER, PRIVATE :: MAX_WRF_IO_HANDLE = 1000
    33. 

  33.   INTEGER :: wrf_io_handles(MAX_WRF_IO_HANDLE), how_opened(MAX_WRF_IO_HANDLE) 
    34. 

  34.   LOGICAL :: for_output(MAX_WRF_IO_HANDLE), first_operation(MAX_WRF_IO_HANDLE)
    35. 

  35.   INTEGER :: filtno = 0
    36. 

  36.   LOGICAL, PRIVATE :: bdy_dist_flag = .TRUE.   ! false is old style undecomposed boundary data structs,
    37. 

  37.                                                 ! true is new style decomposed boundary data structs
    38. 

  38.                                                 ! are_bdys_distributed, bdys_are_distributed and
    39. 

  39.                                                 ! bdys_not_distributed routines access this flag
    40. 

  40.   CHARACTER*256 extradims
    41. 

  41. 

  42. !<DESCRIPTION>
    43. 

  43. !<PRE>
    44. 

  44. !
    45. 

  45. ! include the file generated from md_calls.m4 using the m4 preprocessor
    46. 

  46. ! note that this file also includes the CONTAINS declaration for the module
    47. 

  47. !
    48. 

  48. !</PRE>
    49. 

  49. !</DESCRIPTION>
    50. 

  50. #include "md_calls.inc"
    51. 

  51. 

  52. !--- registry-generated routine that gets the io format being used for a dataset
    53. 

  53. 

  54.   INTEGER FUNCTION io_form_for_dataset ( DataSet )
    55. 

  55.     IMPLICIT NONE
    56. 

  56.     CHARACTER*(*), INTENT(IN)  :: DataSet
    57. 

  57.     INTEGER                    :: io_form 
    58. 

  58. #include "io_form_for_dataset.inc"
    59. 

  59.     io_form_for_dataset = io_form
    60. 

  60.     RETURN
    61. 

  61.   END FUNCTION io_form_for_dataset
    62. 

  62. 

  63.   INTEGER FUNCTION io_form_for_stream ( stream )
    64. 

  64.     USE module_streams
    65. 

  65.     IMPLICIT NONE
    66. 

  66.     INTEGER,       INTENT(IN)  :: stream
    67. 

  67.     INTEGER                    :: io_form 
    68. 

  68. #include "io_form_for_stream.inc"
    69. 

  69.     io_form_for_stream = io_form
    70. 

  70.     RETURN
    71. 

  71.   END FUNCTION io_form_for_stream
    72. 

  72. 

  73. !--- ioinit
    74. 

  74. 

  75. SUBROUTINE wrf_ioinit( Status )
    76. 

  76. !<DESCRIPTION>
    77. 

  77. !<PRE>
    78. 

  78. ! Initialize the WRF I/O system.
    79. 

  79. !</PRE>
    80. 

  80. !</DESCRIPTION>
    81. 

  81.   IMPLICIT NONE
    82. 

  82.   INTEGER, INTENT(INOUT) :: Status
    83. 

  83. !Local
    84. 

  84.   CHARACTER(len=80) :: SysDepInfo
    85. 

  85.   INTEGER :: ierr(10), minerr, maxerr
    86. 

  86. !
    87. 

  87.   Status = 0
    88. 

  88.   ierr = 0
    89. 

  89.   SysDepInfo = " "
    90. 

  90.   CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_ioinit' )
    91. 

  91.   CALL init_io_handles    ! defined below
    92. 

  92. #ifdef NETCDF
    93. 

  93.   CALL ext_ncd_ioinit(   SysDepInfo, ierr(1) )
    94. 

  94. #endif
    95. 

  95. #ifdef INTIO
    96. 

  96.   CALL ext_int_ioinit(   SysDepInfo, ierr(2) )
    97. 

  97. #endif
    98. 

  98. #ifdef PHDF5
    99. 

  99.   CALL ext_phdf5_ioinit( SysDepInfo, ierr(3) )
    100. 

  100. #endif
    101. 

  101. #ifdef PNETCDF
    102. 

  102.   CALL ext_pnc_ioinit( SysDepInfo, ierr(3) )
    103. 

  103. #endif
    104. 

  104. #ifdef MCELIO
    105. 

  105.   CALL ext_mcel_ioinit(  SysDepInfo, ierr(4) )
    106. 

  106. #endif
    107. 

  107. #ifdef XXX
    108. 

  108.   CALL ext_xxx_ioinit(   SysDepInfo, ierr(5) )
    109. 

  109. #endif
    110. 

  110. #ifdef YYY
    111. 

  111.   CALL ext_yyy_ioinit(   SysDepInfo, ierr(6) )
    112. 

  112. #endif
    113. 

  113. #ifdef ZZZ
    114. 

  114.   CALL ext_zzz_ioinit(   SysDepInfo, ierr(7) )
    115. 

  115. #endif
    116. 

  116. #ifdef ESMFIO
    117. 

  117.   CALL ext_esmf_ioinit(  SysDepInfo, ierr(8) )
    118. 

  118. #endif
    119. 

  119. #ifdef GRIB1
    120. 

  120.   CALL ext_gr1_ioinit(   SysDepInfo, ierr(9) )
    121. 

  121. #endif
    122. 

  122. #ifdef GRIB2
    123. 

  123.   CALL ext_gr2_ioinit(   SysDepInfo, ierr(10) )
    124. 

  124. #endif
    125. 

  125.   minerr = MINVAL(ierr)
    126. 

  126.   maxerr = MAXVAL(ierr)
    127. 

  127.   IF ( minerr < 0 ) THEN
    128. 

  128.     Status = minerr
    129. 

  129.   ELSE IF ( maxerr > 0 ) THEN
    130. 

  130.     Status = maxerr
    131. 

  131.   ELSE
    132. 

  132.     Status = 0
    133. 

  133.   ENDIF
    134. 

  134. END SUBROUTINE wrf_ioinit
    135. 

  135. 

  136. !--- ioexit
    137. 

  137. 

  138. SUBROUTINE wrf_ioexit( Status )
    139. 

  139. !<DESCRIPTION>
    140. 

  140. !<PRE>
    141. 

  141. ! Shut down the WRF I/O system.  
    142. 

  142. !</PRE>
    143. 

  143. !</DESCRIPTION>
    144. 

  144.   IMPLICIT NONE
    145. 

  145.   INTEGER, INTENT(INOUT) :: Status
    146. 

  146. !Local
    147. 

  147.   LOGICAL, EXTERNAL :: use_output_servers
    148. 

  148.   INTEGER :: ierr(11), minerr, maxerr
    149. 

  149. !
    150. 

  150.   Status = 0
    151. 

  151.   ierr = 0
    152. 

  152.   CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_ioexit' )
    153. 

  153. #ifdef NETCDF
    154. 

  154.   CALL ext_ncd_ioexit(  ierr(1) )
    155. 

  155. #endif
    156. 

  156. #ifdef INTIO
    157. 

  157.   CALL ext_int_ioexit(  ierr(2) )
    158. 

  158. #endif
    159. 

  159. #ifdef PHDF5
    160. 

  160.   CALL ext_phdf5_ioexit(ierr(3) )
    161. 

  161. #endif
    162. 

  162. #ifdef PNETCDF
    163. 

  163.   CALL ext_pnc_ioexit(ierr(3) )
    164. 

  164. #endif
    165. 

  165. #ifdef MCELIO
    166. 

  166.   CALL ext_mcel_ioexit( ierr(4) )
    167. 

  167. #endif
    168. 

  168. #ifdef XXX
    169. 

  169.   CALL ext_xxx_ioexit(  ierr(5) )
    170. 

  170. #endif
    171. 

  171. #ifdef YYY
    172. 

  172.   CALL ext_yyy_ioexit(  ierr(6) )
    173. 

  173. #endif
    174. 

  174. #ifdef ZZZ
    175. 

  175.   CALL ext_zzz_ioexit(  ierr(7) )
    176. 

  176. #endif
    177. 

  177. #ifdef ESMFIO
    178. 

  178.   CALL ext_esmf_ioexit( ierr(8) )
    179. 

  179. #endif
    180. 

  180. #ifdef GRIB1
    181. 

  181.   CALL ext_gr1_ioexit(  ierr(9) )
    182. 

  182. #endif
    183. 

  183. #ifdef GRIB2
    184. 

  184.   CALL ext_gr2_ioexit(  ierr(10) )
    185. 

  185. #endif
    186. 

  186.  
    187. 

  187.   IF ( use_output_servers() ) CALL wrf_quilt_ioexit( ierr(11) )
    188. 

  188.   minerr = MINVAL(ierr)
    189. 

  189.   maxerr = MAXVAL(ierr)
    190. 

  190.   IF ( minerr < 0 ) THEN
    191. 

  191.     Status = minerr
    192. 

  192.   ELSE IF ( maxerr > 0 ) THEN
    193. 

  193.     Status = maxerr
    194. 

  194.   ELSE
    195. 

  195.     Status = 0
    196. 

  196.   ENDIF
    197. 

  197. END SUBROUTINE wrf_ioexit
    198. 

  198. 

  199. !--- open_for_write_begin
    200. 

  200. 

  201. SUBROUTINE wrf_open_for_write_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
    202. 

  202.                                      DataHandle , Status )
    203. 

  203. !<DESCRIPTION>
    204. 

  204. !<PRE>
    205. 

  205. ! Begin data definition ("training") phase for writing to WRF dataset 
    206. 

  206. ! FileName.  
    207. 

  207. !</PRE>
    208. 

  208. !</DESCRIPTION>
    209. 

  209.   USE module_state_description
    210. 

  210. #ifdef DM_PARALLEL
    211. 

  211.   USE module_dm, ONLY :  ntasks_x, mytask_x, local_communicator_x
    212. 

  212. #endif
    213. 

  213.   IMPLICIT NONE
    214. 

  214. #include "wrf_io_flags.h"
    215. 

  215.   CHARACTER*(*) :: FileName
    216. 

  216.   INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
    217. 

  217.   CHARACTER*(*), INTENT(INOUT):: SysDepInfo
    218. 

  218.   INTEGER ,       INTENT(OUT) :: DataHandle
    219. 

  219.   INTEGER ,       INTENT(OUT) :: Status
    220. 

  220.  !Local 
    221. 

  221.   CHARACTER*128               :: DataSet
    222. 

  222.   INTEGER                     :: io_form
    223. 

  223.   INTEGER                     :: Hndl
    224. 

  224.   INTEGER, EXTERNAL           :: use_package
    225. 

  225.   LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
    226. 

  226.   CHARACTER*128     :: LocFilename   ! for appending the process ID if necessary
    227. 

  227.   INTEGER           :: myproc
    228. 

  228.   CHARACTER*128     :: mess
    229. 

  229.   CHARACTER*1028    :: tstr, t1
    230. 

  230.   INTEGER i,j
    231. 

  231. 

  232.   WRITE(mess,*) 'module_io.F: in wrf_open_for_write_begin, FileName = ',TRIM(FileName)
    233. 

  233.   CALL wrf_debug( DEBUG_LVL, mess )
    234. 

  234. 

  235.   CALL get_value_from_pairs ( "DATASET" , SysDepInfo , DataSet )
    236. 

  236. 

  237.   io_form = io_form_for_dataset( DataSet )
    238. 

  238. 

  239.   Status = 0
    240. 

  240.   Hndl = -1
    241. 

  241.   IF ( multi_files( io_form ) .OR. .NOT. use_output_servers() ) THEN
    242. 

  242.     SELECT CASE ( use_package(io_form) )
    243. 

  243. #ifdef NETCDF
    244. 

  244.       CASE ( IO_NETCDF   )
    245. 

  245.         IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
    246. 

  246.           IF ( multi_files(io_form) ) THEN
    247. 

  247.             CALL wrf_get_myproc ( myproc )
    248. 

  248.             CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
    249. 

  249.           ELSE
    250. 

  250.             LocFilename = FileName
    251. 

  251.           ENDIF
    252. 

  252.           CALL ext_ncd_open_for_write_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
    253. 

  253.                                               Hndl , Status )
    254. 

  254.         ENDIF
    255. 

  255.         IF ( .NOT. multi_files(io_form) ) THEN
    256. 

  256.           CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    257. 

  257.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    258. 

  258.         ENDIF
    259. 

  259. #endif
    260. 

  260. #ifdef PHDF5
    261. 

  261.       CASE (IO_PHDF5  )
    262. 

  262.         CALL ext_phdf5_open_for_write_begin( FileName, Comm_compute, Comm_io, SysDepInfo, &
    263. 

  263.                                             Hndl, Status)
    264. 

  264. #endif
    265. 

  265. #ifdef PNETCDF
    266. 

  266.       CASE (IO_PNETCDF  )
    267. 

  267.         WRITE(tstr,"(A,',NTASKS_X=',i10,',MYTASK_X=',i10,',LOCAL_COMMUNICATOR_X=',i10)") TRIM(SysDepInfo),ntasks_x,mytask_x,local_communicator_x
    268. 

  268.         j=1
    269. 

  269.         t1 = " "
    270. 

  270.         DO i=1,len(TRIM(tstr))
    271. 

  271.           IF ( tstr(i:i) .NE. ' ' ) THEN
    272. 

  272.             t1(j:j) = tstr(i:i)
    273. 

  273.             j = j + 1
    274. 

  274.           ENDIF
    275. 

  275.         ENDDO
    276. 

  276.         tstr = t1
    277. 

  277.         CALL ext_pnc_open_for_write_begin( FileName, Comm_compute, Comm_io, tstr, &
    278. 

  278.                                             Hndl, Status)
    279. 

  279. #endif
    280. 

  280. #ifdef XXX
    281. 

  281.       CASE ( IO_XXX   )
    282. 

  282.         CALL ext_xxx_open_for_write_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
    283. 

  283.                                             Hndl , Status )
    284. 

  284. #endif
    285. 

  285. #ifdef YYY
    286. 

  286.       CASE ( IO_YYY   )
    287. 

  287.         IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
    288. 

  288.           IF ( multi_files(io_form) ) THEN
    289. 

  289.             CALL wrf_get_myproc ( myproc )
    290. 

  290.             CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
    291. 

  291.           ELSE
    292. 

  292.             LocFilename = FileName
    293. 

  293.           ENDIF
    294. 

  294.           CALL ext_yyy_open_for_write_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
    295. 

  295.                                               Hndl , Status )
    296. 

  296.         ENDIF
    297. 

  297.         IF ( .NOT. multi_files(io_form) ) THEN
    298. 

  298.           CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    299. 

  299.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    300. 

  300.         ENDIF
    301. 

  301. #endif
    302. 

  302. #ifdef ZZZ
    303. 

  303.       CASE ( IO_ZZZ   )
    304. 

  304.         CALL ext_zzz_open_for_write_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
    305. 

  305.                                             Hndl , Status )
    306. 

  306. #endif
    307. 

  307. #ifdef GRIB1
    308. 

  308.       CASE ( IO_GRIB1   )
    309. 

  309.         IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
    310. 

  310.           IF ( multi_files(io_form) ) THEN
    311. 

  311.             CALL wrf_get_myproc ( myproc )
    312. 

  312.             CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
    313. 

  313.           ELSE
    314. 

  314.             LocFilename = FileName
    315. 

  315.           ENDIF
    316. 

  316.           CALL ext_gr1_open_for_write_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
    317. 

  317.                                               Hndl , Status )
    318. 

  318.         ENDIF
    319. 

  319.         IF ( .NOT. multi_files(io_form) ) THEN
    320. 

  320.           CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    321. 

  321.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    322. 

  322.         ENDIF
    323. 

  323. #endif
    324. 

  324. #ifdef GRIB2
    325. 

  325.       CASE ( IO_GRIB2   )
    326. 

  326.         IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
    327. 

  327.           IF ( multi_files(io_form) ) THEN
    328. 

  328.             CALL wrf_get_myproc ( myproc )
    329. 

  329.             CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
    330. 

  330.           ELSE
    331. 

  331.             LocFilename = FileName
    332. 

  332.           ENDIF
    333. 

  333.           CALL ext_gr2_open_for_write_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
    334. 

  334.                                               Hndl , Status )
    335. 

  335.         ENDIF
    336. 

  336.         IF ( .NOT. multi_files(io_form) ) THEN
    337. 

  337.           CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    338. 

  338.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    339. 

  339.         ENDIF
    340. 

  340. #endif
    341. 

  341. #ifdef MCELIO
    342. 

  342.       CASE ( IO_MCEL )
    343. 

  343.         IF ( wrf_dm_on_monitor() ) THEN
    344. 

  344.           tstr = TRIM(SysDepInfo) // ',' // 'LAT_R=XLAT,LON_R=XLONG,LANDMASK_I=LU_MASK'
    345. 

  345.           CALL ext_mcel_open_for_write_begin ( FileName , Comm_compute, Comm_io, tstr, &
    346. 

  346.                                                Hndl , Status )
    347. 

  347.         ENDIF
    348. 

  348.         CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    349. 

  349.         CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    350. 

  350. #endif
    351. 

  351. #ifdef ESMFIO
    352. 

  352.       CASE ( IO_ESMF )
    353. 

  353.         CALL ext_esmf_open_for_write_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
    354. 

  354.                                              Hndl , Status )
    355. 

  355. #endif
    356. 

  356. #ifdef INTIO
    357. 

  357.       CASE ( IO_INTIO   )
    358. 

  358.         IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
    359. 

  359.           IF ( multi_files(io_form) ) THEN
    360. 

  360.             CALL wrf_get_myproc ( myproc )
    361. 

  361.             CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
    362. 

  362.           ELSE
    363. 

  363.             LocFilename = FileName
    364. 

  364.           ENDIF
    365. 

  365.           CALL ext_int_open_for_write_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
    366. 

  366.                                               Hndl , Status )
    367. 

  367.         ENDIF
    368. 

  368.         IF ( .NOT. multi_files(io_form) ) THEN
    369. 

  369.           CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    370. 

  370.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    371. 

  371.         ENDIF
    372. 

  372. #endif
    373. 

  373.       CASE DEFAULT
    374. 

  374.         IF ( io_form .NE. 0 ) THEN
    375. 

  375.           WRITE(mess,*)'Tried to open ',FileName,' writing: no valid io_form (',io_form,')'
    376. 

  376.           CALL wrf_debug(1, mess)
    377. 

  377.           Status = WRF_FILE_NOT_OPENED
    378. 

  378.         ENDIF
    379. 

  379.     END SELECT
    380. 

  380.   ELSE IF ( use_output_servers() ) THEN
    381. 

  381.     IF ( io_form .GT. 0 ) THEN
    382. 

  382.       CALL wrf_quilt_open_for_write_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
    383. 

  383.                                             Hndl , io_form, Status )
    384. 

  384.     ENDIF
    385. 

  385.   ELSE
    386. 

  386.     Status = 0
    387. 

  387.   ENDIF
    388. 

  388.   CALL add_new_handle( Hndl, io_form, .TRUE., DataHandle )
    389. 

  389. END SUBROUTINE wrf_open_for_write_begin
    390. 

  390. 

  391. !--- open_for_write_commit
    392. 

  392. 

  393. SUBROUTINE wrf_open_for_write_commit( DataHandle , Status )
    394. 

  394. !<DESCRIPTION>
    395. 

  395. !<PRE>
    396. 

  396. ! This routine switches an internal flag to enable output for the data set 
    397. 

  397. ! referenced by DataHandle. The call to wrf_open_for_write_commit() must be 
    398. 

  398. ! paired with a call to wrf_open_for_write_begin().
    399. 

  399. !</PRE>
    400. 

  400. !</DESCRIPTION>
    401. 

  401.   USE module_state_description
    402. 

  402.   IMPLICIT NONE
    403. 

  403.   INTEGER ,       INTENT(IN ) :: DataHandle
    404. 

  404.   INTEGER ,       INTENT(OUT) :: Status
    405. 

  405.  
    406. 

  406.   CHARACTER (128)             :: DataSet
    407. 

  407.   INTEGER                     :: io_form
    408. 

  408.   INTEGER                     :: Hndl
    409. 

  409.   LOGICAL                     :: for_out
    410. 

  410.   INTEGER, EXTERNAL           :: use_package
    411. 

  411.   LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
    412. 

  412. #include "wrf_io_flags.h"
    413. 

  413. 

  414.   CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_open_for_write_commit' )
    415. 

  415. 

  416.   Status = 0
    417. 

  417.   CALL get_handle ( Hndl, io_form , for_out, DataHandle )
    418. 

  418.   CALL set_first_operation( DataHandle )
    419. 

  419.   IF ( Hndl .GT. -1 ) THEN
    420. 

  420.     IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
    421. 

  421.       SELECT CASE ( use_package(io_form) )
    422. 

  422. #ifdef NETCDF
    423. 

  423.         CASE ( IO_NETCDF   )
    424. 

  424.           IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
    425. 

  425.             CALL ext_ncd_open_for_write_commit ( Hndl , Status )
    426. 

  426.           ENDIF
    427. 

  427.           IF ( .NOT. multi_files(io_form) ) CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    428. 

  428. #endif
    429. 

  429. #ifdef MCELIO
    430. 

  430.         CASE ( IO_MCEL   )
    431. 

  431.           IF ( wrf_dm_on_monitor() ) THEN
    432. 

  432.             CALL ext_mcel_open_for_write_commit ( Hndl , Status )
    433. 

  433.           ENDIF
    434. 

  434.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    435. 

  435. #endif
    436. 

  436. #ifdef ESMFIO
    437. 

  437.         CASE ( IO_ESMF )
    438. 

  438.           CALL ext_esmf_open_for_write_commit ( Hndl , Status )
    439. 

  439. #endif
    440. 

  440. #ifdef PHDF5
    441. 

  441.       CASE ( IO_PHDF5  )
    442. 

  442.         CALL ext_phdf5_open_for_write_commit ( Hndl , Status )
    443. 

  443. #endif
    444. 

  444. #ifdef PNETCDF
    445. 

  445.       CASE ( IO_PNETCDF  )
    446. 

  446.         CALL ext_pnc_open_for_write_commit ( Hndl , Status )
    447. 

  447. #endif
    448. 

  448. #ifdef XXX
    449. 

  449.       CASE ( IO_XXX   )
    450. 

  450.         CALL ext_xxx_open_for_write_commit ( Hndl , Status )
    451. 

  451. #endif
    452. 

  452. #ifdef YYY
    453. 

  453.       CASE ( IO_YYY   )
    454. 

  454.          IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
    455. 

  455.             CALL ext_yyy_open_for_write_commit ( Hndl , Status )
    456. 

  456.          ENDIF
    457. 

  457.          IF ( .NOT. multi_files(io_form) ) CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    458. 

  458. #endif
    459. 

  459. #ifdef ZZZ
    460. 

  460.       CASE ( IO_ZZZ   )
    461. 

  461.         CALL ext_zzz_open_for_write_commit ( Hndl , Status )
    462. 

  462. #endif
    463. 

  463. #ifdef GRIB1
    464. 

  464.       CASE ( IO_GRIB1   )
    465. 

  465.          IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
    466. 

  466.             CALL ext_gr1_open_for_write_commit ( Hndl , Status )
    467. 

  467.          ENDIF
    468. 

  468.          IF ( .NOT. multi_files(io_form) ) CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    469. 

  469. #endif
    470. 

  470. #ifdef GRIB2
    471. 

  471.       CASE ( IO_GRIB2   )
    472. 

  472.          IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
    473. 

  473.             CALL ext_gr2_open_for_write_commit ( Hndl , Status )
    474. 

  474.          ENDIF
    475. 

  475.          IF ( .NOT. multi_files(io_form) ) CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    476. 

  476. #endif
    477. 

  477. #ifdef INTIO
    478. 

  478.       CASE ( IO_INTIO   )
    479. 

  479.         CALL ext_int_open_for_write_commit ( Hndl , Status )
    480. 

  480. #endif
    481. 

  481.         CASE DEFAULT
    482. 

  482.           Status = 0
    483. 

  483.       END SELECT
    484. 

  484.     ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
    485. 

  485.       CALL wrf_quilt_open_for_write_commit ( Hndl , Status )
    486. 

  486.     ELSE
    487. 

  487.       Status = 0
    488. 

  488.     ENDIF
    489. 

  489.   ELSE
    490. 

  490.     Status = 0
    491. 

  491.   ENDIF
    492. 

  492.   RETURN
    493. 

  493. END SUBROUTINE wrf_open_for_write_commit
    494. 

  494. 

  495. !--- open_for_read_begin
    496. 

  496. 

  497. SUBROUTINE wrf_open_for_read_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
    498. 

  498.                                      DataHandle , Status )
    499. 

  499. !<DESCRIPTION>
    500. 

  500. !<PRE>
    501. 

  501. ! Begin data definition ("training") phase for reading from WRF dataset 
    502. 

  502. ! FileName.  
    503. 

  503. !</PRE>
    504. 

  504. !</DESCRIPTION>
    505. 

  505.   USE module_state_description
    506. 

  506.   IMPLICIT NONE
    507. 

  507. #include "wrf_io_flags.h"
    508. 

  508.   CHARACTER*(*) :: FileName
    509. 

  509.   INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
    510. 

  510.   CHARACTER*(*) :: SysDepInfo
    511. 

  511.   INTEGER ,       INTENT(OUT) :: DataHandle
    512. 

  512.   INTEGER ,       INTENT(OUT) :: Status
    513. 

  513.   
    514. 

  514.   CHARACTER*128               :: DataSet
    515. 

  515.   INTEGER                     :: io_form
    516. 

  516.   INTEGER                     :: Hndl
    517. 

  517.   LOGICAL                     :: also_for_out
    518. 

  518.   INTEGER, EXTERNAL           :: use_package
    519. 

  519.   LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
    520. 

  520. 

  521.   CHARACTER*128     :: LocFilename   ! for appending the process ID if necessary
    522. 

  522.   INTEGER     myproc
    523. 

  523.   CHARACTER*128     :: mess, fhand
    524. 

  524.   CHARACTER*1028    :: tstr
    525. 

  525. 

  526.   CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_open_for_read_begin' )
    527. 

  527. 

  528.   CALL get_value_from_pairs ( "DATASET" , SysDepInfo , DataSet )
    529. 

  529. 

  530.   io_form = io_form_for_dataset( DataSet )
    531. 

  531. 

  532.   Status = 0
    533. 

  533.   Hndl = -1
    534. 

  534.   also_for_out = .FALSE.
    535. 

  535. !  IF ( .NOT. use_output_servers() ) THEN
    536. 

  536.     SELECT CASE ( use_package(io_form) )
    537. 

  537. #ifdef NETCDF
    538. 

  538.       CASE ( IO_NETCDF   )
    539. 

  539.         IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
    540. 

  540.           IF ( multi_files(io_form) ) THEN
    541. 

  541.               CALL wrf_get_myproc ( myproc )
    542. 

  542.               CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
    543. 

  543.           ELSE
    544. 

  544.               LocFilename = FileName
    545. 

  545.           ENDIF
    546. 

  546.           CALL ext_ncd_open_for_read_begin ( LocFilename , Comm_compute, Comm_io, SysDepInfo, &
    547. 

  547.                                        Hndl , Status )
    548. 

  548.         ENDIF
    549. 

  549.         IF ( .NOT. multi_files(io_form) ) THEN
    550. 

  550.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    551. 

  551.           CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    552. 

  552.         ENDIF
    553. 

  553. #endif
    554. 

  554. #ifdef PNETCDF
    555. 

  555.       CASE ( IO_PNETCDF   )
    556. 

  556.         CALL ext_pnc_open_for_read_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
    557. 

  557.                                             Hndl , Status )
    558. 

  558. #endif
    559. 

  559. #ifdef XXX
    560. 

  560.       CASE ( IO_XXX   )
    561. 

  561.         CALL ext_xxx_open_for_read_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
    562. 

  562.                                             Hndl , Status )
    563. 

  563. #endif
    564. 

  564. #ifdef YYY
    565. 

  565.       CASE ( IO_YYY   )
    566. 

  566.         CALL ext_yyy_open_for_read_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
    567. 

  567.                                             Hndl , Status )
    568. 

  568. #endif
    569. 

  569. #ifdef ZZZ
    570. 

  570.       CASE ( IO_ZZZ   )
    571. 

  571.         CALL ext_zzz_open_for_read_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
    572. 

  572.                                             Hndl , Status )
    573. 

  573. #endif
    574. 

  574. #ifdef MCELIO
    575. 

  575.       CASE ( IO_MCEL )
    576. 

  576.         also_for_out = .TRUE.
    577. 

  577.         IF ( wrf_dm_on_monitor() ) THEN
    578. 

  578.           
    579. 

  579.         WRITE(fhand,'(a,i0)')"filter_",filtno
    580. 

  580.         filtno = filtno + 1
    581. 

  581. tstr = TRIM(SysDepInfo) // ',' // 'READ_MODE=UPDATE,LAT_R=XLAT,LON_R=XLONG,LANDMASK_I=LU_MASK,FILTER_HANDLE=' // TRIM(fhand)
    582. 

  582.           CALL ext_mcel_open_for_read_begin ( FileName , Comm_compute, Comm_io, tstr, &
    583. 

  583.                                                Hndl , Status )
    584. 

  584.         ENDIF
    585. 

  585.         CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    586. 

  586.         CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    587. 

  587. #endif
    588. 

  588. #ifdef ESMFIO
    589. 

  589.       CASE ( IO_ESMF )
    590. 

  590.         also_for_out = .TRUE.
    591. 

  591.         CALL ext_esmf_open_for_read_begin ( FileName , Comm_compute, Comm_io, SysDepInfo, &
    592. 

  592.                                             Hndl , Status )
    593. 

  593. #endif
    594. 

  594. #ifdef GRIB1
    595. 

  595.       CASE ( IO_GRIB1   )
    596. 

  596.         IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
    597. 

  597.           IF ( multi_files(io_form) ) THEN
    598. 

  598.               CALL wrf_get_myproc ( myproc )
    599. 

  599.               CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
    600. 

  600.           ELSE
    601. 

  601.               LocFilename = FileName
    602. 

  602.           ENDIF
    603. 

  603.           CALL ext_gr1_open_for_read_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
    604. 

  604.                Hndl , Status )
    605. 

  605.         ENDIF
    606. 

  606.         IF ( .NOT. multi_files(io_form) ) THEN
    607. 

  607.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    608. 

  608.           CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    609. 

  609.         ENDIF
    610. 

  610. #endif
    611. 

  611. #ifdef GRIB2
    612. 

  612.       CASE ( IO_GRIB2   )
    613. 

  613.         IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
    614. 

  614.           IF ( multi_files(io_form) ) THEN
    615. 

  615.               CALL wrf_get_myproc ( myproc )
    616. 

  616.               CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
    617. 

  617.           ELSE
    618. 

  618.               LocFilename = FileName
    619. 

  619.           ENDIF
    620. 

  620.           CALL ext_gr2_open_for_read_begin ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
    621. 

  621.                Hndl , Status )
    622. 

  622.         ENDIF
    623. 

  623.         IF ( .NOT. multi_files(io_form) ) THEN
    624. 

  624.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    625. 

  625.           CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    626. 

  626.         ENDIF
    627. 

  627. #endif
    628. 

  628. #ifdef INTIO
    629. 

  629.       CASE ( IO_INTIO   )
    630. 

  630. #endif
    631. 

  631.       CASE DEFAULT
    632. 

  632.         IF ( io_form .NE. 0 ) THEN
    633. 

  633.           WRITE(mess,*)'Tried to open ',FileName,' reading: no valid io_form (',io_form,')'
    634. 

  634.           CALL wrf_message(mess)
    635. 

  635.         ENDIF
    636. 

  636.         Status = WRF_FILE_NOT_OPENED
    637. 

  637.     END SELECT
    638. 

  638. !  ELSE
    639. 

  639. !    Status = 0
    640. 

  640. !  ENDIF
    641. 

  641.   CALL add_new_handle( Hndl, io_form, also_for_out, DataHandle )
    642. 

  642. END SUBROUTINE wrf_open_for_read_begin
    643. 

  643. 

  644. !--- open_for_read_commit
    645. 

  645. 

  646. SUBROUTINE wrf_open_for_read_commit( DataHandle , Status )
    647. 

  647. !<DESCRIPTION>
    648. 

  648. !<PRE>
    649. 

  649. ! End "training" phase for WRF dataset FileName.  The call to 
    650. 

  650. ! wrf_open_for_read_commit() must be paired with a call to 
    651. 

  651. ! wrf_open_for_read_begin().
    652. 

  652. !</PRE>
    653. 

  653. !</DESCRIPTION>
    654. 

  654.   USE module_state_description
    655. 

  655.   IMPLICIT NONE
    656. 

  656.   INTEGER ,       INTENT(IN ) :: DataHandle
    657. 

  657.   INTEGER ,       INTENT(OUT) :: Status
    658. 

  658.  
    659. 

  659.   CHARACTER (128)             :: DataSet
    660. 

  660.   INTEGER                     :: io_form
    661. 

  661.   INTEGER                     :: Hndl
    662. 

  662.   LOGICAL                     :: for_out
    663. 

  663.   INTEGER, EXTERNAL           :: use_package
    664. 

  664.   LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
    665. 

  665. #include "wrf_io_flags.h"
    666. 

  666. 

  667.   CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_open_for_read_commit' )
    668. 

  668. 

  669.   Status = 0
    670. 

  670.   CALL get_handle ( Hndl, io_form , for_out, DataHandle )
    671. 

  671.   CALL set_first_operation( DataHandle )
    672. 

  672.   IF ( Hndl .GT. -1 ) THEN
    673. 

  673.     IF ( .NOT. (for_out .AND. use_output_servers()) ) THEN
    674. 

  674.       SELECT CASE ( use_package(io_form) )
    675. 

  675. #ifdef NETCDF
    676. 

  676.         CASE ( IO_NETCDF   )
    677. 

  677.           IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) THEN
    678. 

  678.             CALL ext_ncd_open_for_read_commit ( Hndl , Status )
    679. 

  679.           ENDIF
    680. 

  680.           IF ( .NOT. multi_files(io_form) ) CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    681. 

  681. #endif
    682. 

  682. #ifdef MCELIO
    683. 

  683.         CASE ( IO_MCEL   )
    684. 

  684.           IF ( wrf_dm_on_monitor() ) THEN
    685. 

  685.             CALL ext_mcel_open_for_read_commit ( Hndl , Status )
    686. 

  686.           ENDIF
    687. 

  687.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    688. 

  688. #endif
    689. 

  689. #ifdef ESMFIO
    690. 

  690.         CASE ( IO_ESMF )
    691. 

  691.           CALL ext_esmf_open_for_read_commit ( Hndl , Status )
    692. 

  692. #endif
    693. 

  693. #ifdef PNETCDF
    694. 

  694.         CASE ( IO_PNETCDF )
    695. 

  695.           CALL ext_pnc_open_for_read_commit ( Hndl , Status )
    696. 

  696. #endif
    697. 

  697. #ifdef XXX
    698. 

  698.       CASE ( IO_XXX   )
    699. 

  699.         CALL ext_xxx_open_for_read_commit ( Hndl , Status )
    700. 

  700. #endif
    701. 

  701. #ifdef YYY
    702. 

  702.       CASE ( IO_YYY   )
    703. 

  703.         CALL ext_yyy_open_for_read_commit ( Hndl , Status )
    704. 

  704. #endif
    705. 

  705. #ifdef ZZZ
    706. 

  706.       CASE ( IO_ZZZ   )
    707. 

  707.         CALL ext_zzz_open_for_read_commit ( Hndl , Status )
    708. 

  708. #endif
    709. 

  709. #ifdef GRIB1
    710. 

  710.       CASE ( IO_GRIB1   )
    711. 

  711.         CALL ext_gr1_open_for_read_commit ( Hndl , Status )
    712. 

  712. #endif
    713. 

  713. #ifdef GRIB2
    714. 

  714.       CASE ( IO_GRIB2   )
    715. 

  715.         CALL ext_gr2_open_for_read_commit ( Hndl , Status )
    716. 

  716. #endif
    717. 

  717. #ifdef INTIO
    718. 

  718.       CASE ( IO_INTIO   )
    719. 

  719. #endif
    720. 

  720.         CASE DEFAULT
    721. 

  721.           Status = 0
    722. 

  722.       END SELECT
    723. 

  723.     ELSE
    724. 

  724.       Status = 0
    725. 

  725.     ENDIF
    726. 

  726.   ELSE
    727. 

  727.     Status = WRF_FILE_NOT_OPENED
    728. 

  728.   ENDIF
    729. 

  729.   RETURN
    730. 

  730. END SUBROUTINE wrf_open_for_read_commit
    731. 

  731. 

  732. !--- open_for_read 
    733. 

  733. 

  734. SUBROUTINE wrf_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
    735. 

  735.                                DataHandle , Status )
    736. 

  736. !<DESCRIPTION>
    737. 

  737. !<PRE>
    738. 

  738. ! Opens a WRF dataset for reading.  
    739. 

  739. !</PRE>
    740. 

  740. !</DESCRIPTION>
    741. 

  741.   USE module_state_description
    742. 

  742.   IMPLICIT NONE
    743. 

  743.   CHARACTER*(*) :: FileName
    744. 

  744.   INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
    745. 

  745.   CHARACTER*(*) :: SysDepInfo
    746. 

  746.   INTEGER ,       INTENT(OUT) :: DataHandle
    747. 

  747.   INTEGER ,       INTENT(OUT) :: Status
    748. 

  748. 

  749.   CHARACTER (128)             :: DataSet, LocFileName
    750. 

  750.   INTEGER                     :: io_form, myproc
    751. 

  751.   INTEGER                     :: Hndl
    752. 

  752.   INTEGER, EXTERNAL           :: use_package
    753. 

  753.   LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
    754. 

  754. 

  755.   CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_open_for_read' )
    756. 

  756. 

  757.   CALL get_value_from_pairs ( "DATASET" , SysDepInfo , DataSet )
    758. 

  758. 

  759.   io_form = io_form_for_dataset( DataSet )
    760. 

  760. 

  761.   Hndl = -1
    762. 

  762.   Status = 0
    763. 

  763.   SELECT CASE ( use_package(io_form) )
    764. 

  764. #ifdef NETCDF
    765. 

  765.     CASE ( IO_NETCDF   )
    766. 

  766.       IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
    767. 

  767.         IF ( multi_files(io_form) ) THEN
    768. 

  768.             CALL wrf_get_myproc ( myproc )
    769. 

  769.             CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
    770. 

  770.         ELSE
    771. 

  771.             LocFilename = FileName
    772. 

  772.         ENDIF
    773. 

  773. 

  774.         CALL ext_ncd_open_for_read ( LocFilename , Comm_compute, Comm_io, SysDepInfo, &
    775. 

  775.                                      Hndl , Status )
    776. 

  776.       ENDIF
    777. 

  777.       IF ( .NOT. multi_files(io_form) ) THEN
    778. 

  778.         CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    779. 

  779.         CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    780. 

  780.       ENDIF
    781. 

  781. #endif
    782. 

  782. #ifdef PNETCDF
    783. 

  783.     CASE ( IO_PNETCDF  )
    784. 

  784.       CALL ext_pnc_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
    785. 

  785.                                Hndl , Status )
    786. 

  786. #endif
    787. 

  787. #ifdef PHDF5
    788. 

  788.     CASE ( IO_PHDF5  )
    789. 

  789.       CALL ext_phdf5_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
    790. 

  790.                                Hndl , Status )
    791. 

  791. #endif
    792. 

  792. #ifdef XXX
    793. 

  793.     CASE ( IO_XXX   )
    794. 

  794.       CALL ext_xxx_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
    795. 

  795.                                Hndl , Status )
    796. 

  796. #endif
    797. 

  797. #ifdef YYY
    798. 

  798.     CASE ( IO_YYY   )
    799. 

  799.       IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
    800. 

  800.         IF ( multi_files(io_form) ) THEN
    801. 

  801.             CALL wrf_get_myproc ( myproc )
    802. 

  802.             CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
    803. 

  803.         ELSE
    804. 

  804.             LocFilename = FileName
    805. 

  805.         ENDIF
    806. 

  806. 

  807.         CALL ext_yyy_open_for_read ( LocFilename , Comm_compute, Comm_io, SysDepInfo, &
    808. 

  808.                                      Hndl , Status )
    809. 

  809.       ENDIF
    810. 

  810.       IF ( .NOT. multi_files(io_form) ) THEN
    811. 

  811.         CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    812. 

  812.         CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    813. 

  813.       ENDIF
    814. 

  814. #endif
    815. 

  815. #ifdef ZZZ
    816. 

  816.     CASE ( IO_ZZZ   )
    817. 

  817.       CALL ext_zzz_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
    818. 

  818.                                Hndl , Status )
    819. 

  819. #endif
    820. 

  820. #ifdef GRIB1
    821. 

  821.     CASE ( IO_GRIB1   )
    822. 

  822.       IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
    823. 

  823.         IF ( multi_files(io_form) ) THEN
    824. 

  824.             CALL wrf_get_myproc ( myproc )
    825. 

  825.             CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
    826. 

  826.         ELSE
    827. 

  827.             LocFilename = FileName
    828. 

  828.         ENDIF
    829. 

  829. 

  830.         CALL ext_gr1_open_for_read ( LocFilename , Comm_compute, Comm_io, SysDepInfo, &
    831. 

  831.                                      Hndl , Status )
    832. 

  832.       ENDIF
    833. 

  833.       IF ( .NOT. multi_files(io_form) ) THEN
    834. 

  834.         CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    835. 

  835.         CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    836. 

  836.       ENDIF
    837. 

  837. #endif
    838. 

  838. #ifdef GRIB2
    839. 

  839.     CASE ( IO_GRIB2   )
    840. 

  840.       IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
    841. 

  841.         IF ( multi_files(io_form) ) THEN
    842. 

  842.             CALL wrf_get_myproc ( myproc )
    843. 

  843.             CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
    844. 

  844.         ELSE
    845. 

  845.             LocFilename = FileName
    846. 

  846.         ENDIF
    847. 

  847. 

  848.         CALL ext_gr2_open_for_read ( LocFilename , Comm_compute, Comm_io, SysDepInfo, &
    849. 

  849.                                      Hndl , Status )
    850. 

  850.       ENDIF
    851. 

  851.       IF ( .NOT. multi_files(io_form) ) THEN
    852. 

  852.         CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    853. 

  853.         CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    854. 

  854.       ENDIF
    855. 

  855. #endif
    856. 

  856. #ifdef INTIO
    857. 

  857.     CASE ( IO_INTIO   )
    858. 

  858.       IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) THEN
    859. 

  859.         IF ( multi_files(io_form) ) THEN
    860. 

  860.             CALL wrf_get_myproc ( myproc )
    861. 

  861.             CALL append_to_filename ( LocFilename , FileName , myproc, 4 )
    862. 

  862.         ELSE
    863. 

  863.             LocFilename = FileName
    864. 

  864.         ENDIF
    865. 

  865.         CALL ext_int_open_for_read ( LocFileName , Comm_compute, Comm_io, SysDepInfo, &
    866. 

  866.                                      Hndl , Status )
    867. 

  867.       ENDIF
    868. 

  868.       IF ( .NOT. multi_files(io_form) ) THEN
    869. 

  869.         CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    870. 

  870.         CALL wrf_dm_bcast_bytes( Hndl, IWORDSIZE )
    871. 

  871.       ENDIF
    872. 

  872. #endif
    873. 

  873.     CASE DEFAULT
    874. 

  874.         Status = 0
    875. 

  875.   END SELECT
    876. 

  876.   CALL add_new_handle( Hndl, io_form, .FALSE., DataHandle )
    877. 

  877.   RETURN  
    878. 

  878. END SUBROUTINE wrf_open_for_read
    879. 

  879. 

  880. !--- inquire_opened
    881. 

  881. 

  882. SUBROUTINE wrf_inquire_opened ( DataHandle, FileName , FileStatus, Status )
    883. 

  883. !<DESCRIPTION>
    884. 

  884. !<PRE>
    885. 

  885. ! Inquire if the dataset referenced by DataHandle is open.  
    886. 

  886. !</PRE>
    887. 

  887. !</DESCRIPTION>
    888. 

  888.   USE module_state_description
    889. 

  889.   IMPLICIT NONE
    890. 

  890.   INTEGER ,       INTENT(IN)  :: DataHandle
    891. 

  891.   CHARACTER*(*) :: FileName
    892. 

  892.   INTEGER ,       INTENT(OUT) :: FileStatus
    893. 

  893.   INTEGER ,       INTENT(OUT) :: Status
    894. 

  894.   LOGICAL                     :: for_out
    895. 

  895.   INTEGER, EXTERNAL           :: use_package
    896. 

  896.   LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
    897. 

  897. #include "wrf_io_flags.h"
    898. 

  898. #include "wrf_status_codes.h"
    899. 

  899. 

  900.   INTEGER io_form , Hndl
    901. 

  901. 

  902.   CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_inquire_opened' )
    903. 

  903. 

  904.   Status = 0
    905. 

  905.   CALL get_handle ( Hndl, io_form , for_out, DataHandle )
    906. 

  906.   IF ( Hndl .GT. -1 ) THEN
    907. 

  907.     IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
    908. 

  908.       SELECT CASE ( use_package(io_form) )
    909. 

  909. #ifdef NETCDF
    910. 

  910.         CASE ( IO_NETCDF   )
    911. 

  911.           IF (wrf_dm_on_monitor()) CALL ext_ncd_inquire_opened ( Hndl, FileName , FileStatus, Status )
    912. 

  912.           CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
    913. 

  913.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    914. 

  914. #endif
    915. 

  915. #ifdef PHDF5
    916. 

  916.       CASE ( IO_PHDF5   )
    917. 

  917.           CALL ext_phdf5_inquire_opened ( Hndl, FileName , FileStatus, Status )
    918. 

  918. #endif
    919. 

  919. #ifdef PNETCDF
    920. 

  920.       CASE ( IO_PNETCDF   )
    921. 

  921.           CALL ext_pnc_inquire_opened ( Hndl, FileName , FileStatus, Status )
    922. 

  922. #endif
    923. 

  923. #ifdef XXX
    924. 

  924.       CASE ( IO_XXX   )
    925. 

  925.           CALL ext_xxx_inquire_opened ( Hndl, FileName , FileStatus, Status )
    926. 

  926. #endif
    927. 

  927. #ifdef YYY
    928. 

  928.       CASE ( IO_YYY   )
    929. 

  929.           IF (wrf_dm_on_monitor()) CALL ext_yyy_inquire_opened ( Hndl, FileName , FileStatus, Status )
    930. 

  930.           CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
    931. 

  931.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    932. 

  932. #endif
    933. 

  933. #ifdef ZZZ
    934. 

  934.       CASE ( IO_ZZZ   )
    935. 

  935.           CALL ext_zzz_inquire_opened ( Hndl, FileName , FileStatus, Status )
    936. 

  936. #endif
    937. 

  937. #ifdef GRIB1
    938. 

  938.       CASE ( IO_GRIB1   )
    939. 

  939.           IF (wrf_dm_on_monitor()) CALL ext_gr1_inquire_opened ( Hndl, FileName , FileStatus, Status )
    940. 

  940.           CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
    941. 

  941.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    942. 

  942. #endif
    943. 

  943. #ifdef GRIB2
    944. 

  944.       CASE ( IO_GRIB2   )
    945. 

  945.           IF (wrf_dm_on_monitor()) CALL ext_gr2_inquire_opened ( Hndl, FileName , FileStatus, Status )
    946. 

  946.           CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
    947. 

  947.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    948. 

  948. #endif
    949. 

  949. #ifdef INTIO
    950. 

  950.       CASE ( IO_INTIO   )
    951. 

  951.           IF (wrf_dm_on_monitor()) CALL ext_int_inquire_opened ( Hndl, FileName , FileStatus, Status )
    952. 

  952.           CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
    953. 

  953.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    954. 

  954. #endif
    955. 

  955.         CASE DEFAULT
    956. 

  956.           FileStatus = WRF_FILE_NOT_OPENED
    957. 

  957.           Status = 0
    958. 

  958.       END SELECT
    959. 

  959.     ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
    960. 

  960.       CALL wrf_quilt_inquire_opened ( Hndl, FileName , FileStatus, Status )
    961. 

  961.     ENDIF
    962. 

  962.   ELSE
    963. 

  963.     FileStatus = WRF_FILE_NOT_OPENED
    964. 

  964.     Status = 0
    965. 

  965.   ENDIF
    966. 

  966.   RETURN
    967. 

  967. END SUBROUTINE wrf_inquire_opened
    968. 

  968. 

  969. !--- inquire_filename
    970. 

  970. 

  971. 

  972. SUBROUTINE wrf_inquire_filename ( DataHandle, FileName , FileStatus, Status )
    973. 

  973. !<DESCRIPTION>
    974. 

  974. !<PRE>
    975. 

  975. ! Returns the Filename and FileStatus associated with DataHandle.  
    976. 

  976. !</PRE>
    977. 

  977. !</DESCRIPTION>
    978. 

  978.   USE module_state_description
    979. 

  979.   IMPLICIT NONE
    980. 

  980.   INTEGER ,       INTENT(IN)  :: DataHandle
    981. 

  981.   CHARACTER*(*) :: FileName
    982. 

  982.   INTEGER ,       INTENT(OUT) :: FileStatus
    983. 

  983.   INTEGER ,       INTENT(OUT) :: Status
    984. 

  984. #include "wrf_status_codes.h"
    985. 

  985.   INTEGER, EXTERNAL           :: use_package
    986. 

  986.   LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
    987. 

  987.   LOGICAL                     :: for_out
    988. 

  988. 

  989.   INTEGER io_form , Hndl
    990. 

  990.   INTEGER                     :: str_length , str_count
    991. 

  991. 

  992.   CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_inquire_filename' )
    993. 

  993. 

  994.   Status = 0
    995. 

  995.   CALL get_handle ( Hndl, io_form , for_out, DataHandle )
    996. 

  996.   IF ( Hndl .GT. -1 ) THEN
    997. 

  997.     IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
    998. 

  998.       SELECT CASE ( use_package( io_form ) )
    999. 

  999. #ifdef NETCDF
    1000. 

  1000.         CASE ( IO_NETCDF   )
    1001. 

  1001.           str_length = LEN ( FileName )
    1002. 

  1002.           DO str_count = 1 , str_length
    1003. 

  1003.             FileName(str_count:str_count) = ' '
    1004. 

  1004.           END DO
    1005. 

  1005.           IF (wrf_dm_on_monitor()) CALL ext_ncd_inquire_filename ( Hndl, FileName , FileStatus, Status )
    1006. 

  1006.           CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
    1007. 

  1007.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    1008. 

  1008. #endif
    1009. 

  1009. #ifdef PHDF5
    1010. 

  1010.         CASE ( IO_PHDF5   )
    1011. 

  1011.           CALL ext_phdf5_inquire_filename ( Hndl, FileName , FileStatus, Status )
    1012. 

  1012. #endif
    1013. 

  1013. #ifdef PNETCDF
    1014. 

  1014.         CASE ( IO_PNETCDF   )
    1015. 

  1015.           CALL ext_pnc_inquire_filename ( Hndl, FileName , FileStatus, Status )
    1016. 

  1016. #endif
    1017. 

  1017. #ifdef XXX
    1018. 

  1018.         CASE ( IO_XXX   )
    1019. 

  1019.           CALL ext_xxx_inquire_filename ( Hndl, FileName , FileStatus, Status )
    1020. 

  1020. #endif
    1021. 

  1021. #ifdef YYY
    1022. 

  1022.         CASE ( IO_YYY   )
    1023. 

  1023.           IF (wrf_dm_on_monitor()) CALL ext_yyy_inquire_filename ( Hndl, FileName , FileStatus, Status )
    1024. 

  1024.           CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
    1025. 

  1025.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    1026. 

  1026. #endif
    1027. 

  1027. #ifdef ZZZ
    1028. 

  1028.         CASE ( IO_ZZZ   )
    1029. 

  1029.             CALL ext_zzz_inquire_filename ( Hndl, FileName , FileStatus, Status )
    1030. 

  1030. #endif
    1031. 

  1031. #ifdef GRIB1
    1032. 

  1032.         CASE ( IO_GRIB1   )
    1033. 

  1033.           IF (wrf_dm_on_monitor()) CALL ext_gr1_inquire_filename ( Hndl, FileName , FileStatus, Status )
    1034. 

  1034.           CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
    1035. 

  1035.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    1036. 

  1036. #endif
    1037. 

  1037. #ifdef GRIB2
    1038. 

  1038.         CASE ( IO_GRIB2   )
    1039. 

  1039.           IF (wrf_dm_on_monitor()) CALL ext_gr2_inquire_filename ( Hndl, FileName , FileStatus, Status )
    1040. 

  1040.           CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
    1041. 

  1041.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    1042. 

  1042. #endif
    1043. 

  1043. #ifdef INTIO
    1044. 

  1044.         CASE ( IO_INTIO   )
    1045. 

  1045.           IF (wrf_dm_on_monitor()) CALL ext_int_inquire_filename ( Hndl, FileName , FileStatus, Status )
    1046. 

  1046.           CALL wrf_dm_bcast_bytes( FileStatus, IWORDSIZE )
    1047. 

  1047.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    1048. 

  1048. #endif
    1049. 

  1049.         CASE DEFAULT
    1050. 

  1050.           Status = 0
    1051. 

  1051.       END SELECT
    1052. 

  1052.     ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
    1053. 

  1053.       CALL wrf_quilt_inquire_filename ( Hndl, FileName , FileStatus, Status )
    1054. 

  1054.     ENDIF
    1055. 

  1055.   ELSE
    1056. 

  1056.     FileName = ""
    1057. 

  1057.     Status = 0
    1058. 

  1058.   ENDIF
    1059. 

  1059.   RETURN
    1060. 

  1060. END SUBROUTINE wrf_inquire_filename
    1061. 

  1061. 

  1062. !--- sync
    1063. 

  1063. 

  1064. SUBROUTINE wrf_iosync ( DataHandle, Status )
    1065. 

  1065. !<DESCRIPTION>
    1066. 

  1066. !<PRE>
    1067. 

  1067. ! Synchronize the disk copy of a dataset with memory buffers.  
    1068. 

  1068. !</PRE>
    1069. 

  1069. !</DESCRIPTION>
    1070. 

  1070.   USE module_state_description
    1071. 

  1071.   IMPLICIT NONE
    1072. 

  1072.   INTEGER ,       INTENT(IN)  :: DataHandle
    1073. 

  1073.   INTEGER ,       INTENT(OUT) :: Status
    1074. 

  1074. #include "wrf_status_codes.h"
    1075. 

  1075.   INTEGER, EXTERNAL           :: use_package
    1076. 

  1076.   LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
    1077. 

  1077.   LOGICAL                     :: for_out
    1078. 

  1078. 

  1079.   INTEGER io_form , Hndl
    1080. 

  1080. 

  1081.   CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_iosync' )
    1082. 

  1082. 

  1083.   Status = 0
    1084. 

  1084.   CALL get_handle ( Hndl, io_form , for_out, DataHandle )
    1085. 

  1085.   IF ( Hndl .GT. -1 ) THEN
    1086. 

  1086.     IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
    1087. 

  1087.       SELECT CASE ( use_package(io_form) )
    1088. 

  1088. #ifdef NETCDF
    1089. 

  1089.         CASE ( IO_NETCDF   )
    1090. 

  1090.           IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) CALL ext_ncd_iosync( Hndl, Status )
    1091. 

  1091.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    1092. 

  1092. #endif
    1093. 

  1093. #ifdef XXX
    1094. 

  1094.         CASE ( IO_XXX   )
    1095. 

  1095.           CALL ext_xxx_iosync( Hndl, Status )
    1096. 

  1096. #endif
    1097. 

  1097. #ifdef YYY
    1098. 

  1098.         CASE ( IO_YYY   )
    1099. 

  1099.           IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) CALL ext_yyy_iosync( Hndl, Status )
    1100. 

  1100.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    1101. 

  1101. #endif
    1102. 

  1102. #ifdef GRIB1
    1103. 

  1103.         CASE ( IO_GRIB1   )
    1104. 

  1104.           IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) CALL ext_gr1_iosync( Hndl, Status )
    1105. 

  1105.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    1106. 

  1106. #endif
    1107. 

  1107. #ifdef GRIB2
    1108. 

  1108.         CASE ( IO_GRIB2   )
    1109. 

  1109.           IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) CALL ext_gr2_iosync( Hndl, Status )
    1110. 

  1110.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    1111. 

  1111. #endif
    1112. 

  1112. #ifdef ZZZ
    1113. 

  1113.         CASE ( IO_ZZZ   )
    1114. 

  1114.           CALL ext_zzz_iosync( Hndl, Status )
    1115. 

  1115. #endif
    1116. 

  1116. #ifdef INTIO
    1117. 

  1117.         CASE ( IO_INTIO   )
    1118. 

  1118.           IF ( multi_files(io_form) .OR. wrf_dm_on_monitor() ) CALL ext_int_iosync( Hndl, Status )
    1119. 

  1119.           CALL wrf_dm_bcast_bytes( Status    , IWORDSIZE )
    1120. 

  1120. #endif
    1121. 

  1121.         CASE DEFAULT
    1122. 

  1122.           Status = 0
    1123. 

  1123.       END SELECT
    1124. 

  1124.     ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
    1125. 

  1125.       CALL wrf_quilt_iosync( Hndl, Status )
    1126. 

  1126.     ELSE
    1127. 

  1127.       Status = 0
    1128. 

  1128.     ENDIF
    1129. 

  1129.   ELSE
    1130. 

  1130.     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
    1131. 

  1131.   ENDIF
    1132. 

  1132.   RETURN
    1133. 

  1133. END SUBROUTINE wrf_iosync
    1134. 

  1134. 

  1135. !--- close
    1136. 

  1136. 

  1137. SUBROUTINE wrf_ioclose ( DataHandle, Status )
    1138. 

  1138. !<DESCRIPTION>
    1139. 

  1139. !<PRE>
    1140. 

  1140. ! Close the dataset referenced by DataHandle.  
    1141. 

  1141. !</PRE>
    1142. 

  1142. !</DESCRIPTION>
    1143. 

  1143.   USE module_state_description
    1144. 

  1144.   IMPLICIT NONE
    1145. 

  1145.   INTEGER ,       INTENT(IN)  :: DataHandle
    1146. 

  1146.   INTEGER ,       INTENT(OUT) :: Status
    1147. 

  1147. #include "wrf_status_codes.h"
    1148. 

  1148.   INTEGER, EXTERNAL           :: use_package
    1149. 

  1149.   LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
    1150. 

  1150.   INTEGER io_form , Hndl
    1151. 

  1151.   LOGICAL                     :: for_out
    1152. 

  1152. 

  1153.   CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_ioclose' )
    1154. 

  1154. 

  1155.   Status = 0
    1156. 

  1156.   CALL get_handle ( Hndl, io_form , for_out, DataHandle )
    1157. 

  1157.   IF ( Hndl .GT. -1 ) THEN
    1158. 

  1158.     IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
    1159. 

  1159.       SELECT CASE ( use_package(io_form) )
    1160. 

  1160. #ifdef NETCDF
    1161. 

  1161.         CASE ( IO_NETCDF   )
    1162. 

  1162.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_ncd_ioclose( Hndl, Status )
    1163. 

  1163.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1164. 

  1164. #endif
    1165. 

  1165. #ifdef PHDF5
    1166. 

  1166.         CASE ( IO_PHDF5  )
    1167. 

  1167.           CALL ext_phdf5_ioclose( Hndl, Status )
    1168. 

  1168. #endif
    1169. 

  1169. #ifdef PNETCDF
    1170. 

  1170.         CASE ( IO_PNETCDF  )
    1171. 

  1171.           CALL ext_pnc_ioclose( Hndl, Status )
    1172. 

  1172. #endif
    1173. 

  1173. #ifdef XXX
    1174. 

  1174.         CASE ( IO_XXX   )
    1175. 

  1175.           CALL ext_xxx_ioclose( Hndl, Status )
    1176. 

  1176. #endif
    1177. 

  1177. #ifdef YYY
    1178. 

  1178.         CASE ( IO_YYY   )
    1179. 

  1179.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_yyy_ioclose( Hndl, Status )
    1180. 

  1180.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1181. 

  1181. #endif
    1182. 

  1182. #ifdef ZZZ
    1183. 

  1183.         CASE ( IO_ZZZ   )
    1184. 

  1184.           CALL ext_zzz_ioclose( Hndl, Status )
    1185. 

  1185. #endif
    1186. 

  1186. #ifdef GRIB1
    1187. 

  1187.         CASE ( IO_GRIB1   )
    1188. 

  1188.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr1_ioclose( Hndl, Status )
    1189. 

  1189.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1190. 

  1190. #endif
    1191. 

  1191. #ifdef GRIB2
    1192. 

  1192.         CASE ( IO_GRIB2   )
    1193. 

  1193.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr2_ioclose( Hndl, Status )
    1194. 

  1194.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1195. 

  1195. #endif
    1196. 

  1196. #ifdef MCELIO
    1197. 

  1197.         CASE ( IO_MCEL   )
    1198. 

  1198.           CALL ext_mcel_ioclose( Hndl, Status )
    1199. 

  1199. #endif
    1200. 

  1200. #ifdef ESMFIO
    1201. 

  1201.         CASE ( IO_ESMF )
    1202. 

  1202.           CALL ext_esmf_ioclose( Hndl, Status )
    1203. 

  1203. #endif
    1204. 

  1204. #ifdef INTIO
    1205. 

  1205.         CASE ( IO_INTIO   )
    1206. 

  1206.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_int_ioclose( Hndl, Status )
    1207. 

  1207.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1208. 

  1208. #endif
    1209. 

  1209.         CASE DEFAULT
    1210. 

  1210.           Status = 0
    1211. 

  1211.       END SELECT
    1212. 

  1212.     ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
    1213. 

  1213.       CALL wrf_quilt_ioclose( Hndl, Status )
    1214. 

  1214.     ELSE
    1215. 

  1215.       Status = 0
    1216. 

  1216.     ENDIF
    1217. 

  1217.     CALL free_handle( DataHandle )
    1218. 

  1218.   ELSE
    1219. 

  1219.     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
    1220. 

  1220.   ENDIF
    1221. 

  1221.   RETURN
    1222. 

  1222. END SUBROUTINE wrf_ioclose
    1223. 

  1223. 

  1224. !--- get_next_time (not defined for IntIO )
    1225. 

  1225. 

  1226. SUBROUTINE wrf_get_next_time ( DataHandle, DateStr, Status )
    1227. 

  1227. !<DESCRIPTION>
    1228. 

  1228. !<PRE>
    1229. 

  1229. ! Returns the next time stamp.  
    1230. 

  1230. !</PRE>
    1231. 

  1231. !</DESCRIPTION>
    1232. 

  1232.   USE module_state_description
    1233. 

  1233.   IMPLICIT NONE
    1234. 

  1234.   INTEGER ,       INTENT(IN)  :: DataHandle
    1235. 

  1235.   CHARACTER*(*) :: DateStr
    1236. 

  1236.   INTEGER ,       INTENT(OUT) :: Status
    1237. 

  1237. #include "wrf_status_codes.h"
    1238. 

  1238. 

  1239.   INTEGER, EXTERNAL           :: use_package
    1240. 

  1240.   LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
    1241. 

  1241.   INTEGER io_form , Hndl, len_of_str
    1242. 

  1242.   LOGICAL                     :: for_out
    1243. 

  1243. 

  1244.   CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_get_next_time' )
    1245. 

  1245. 

  1246.   Status = 0
    1247. 

  1247.   CALL get_handle ( Hndl, io_form , for_out, DataHandle )
    1248. 

  1248.   IF ( Hndl .GT. -1 ) THEN
    1249. 

  1249.     IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
    1250. 

  1250.       SELECT CASE ( use_package(io_form) )
    1251. 

  1251. #ifdef NETCDF
    1252. 

  1252.         CASE ( IO_NETCDF   )
    1253. 

  1253.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_ncd_get_next_time( Hndl, DateStr, Status )
    1254. 

  1254.           IF ( .NOT. multi_files(io_form) ) THEN
    1255. 

  1255.             CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1256. 

  1256.             len_of_str = LEN(DateStr)
    1257. 

  1257.             CALL wrf_dm_bcast_string ( DateStr , len_of_str )
    1258. 

  1258.           ENDIF
    1259. 

  1259. #endif
    1260. 

  1260. #ifdef PHDF5
    1261. 

  1261.         CASE ( IO_PHDF5   )
    1262. 

  1262.           CALL ext_phdf5_get_next_time( Hndl, DateStr, Status )
    1263. 

  1263. #endif
    1264. 

  1264. #ifdef PNETCDF
    1265. 

  1265.         CASE ( IO_PNETCDF   )
    1266. 

  1266.           CALL ext_pnc_get_next_time( Hndl, DateStr, Status )
    1267. 

  1267. #endif
    1268. 

  1268. #ifdef XXX
    1269. 

  1269.         CASE ( IO_XXX   )
    1270. 

  1270.           CALL ext_xxx_get_next_time( Hndl, DateStr, Status )
    1271. 

  1271. #endif
    1272. 

  1272. #ifdef YYY
    1273. 

  1273.         CASE ( IO_YYY   )
    1274. 

  1274.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_yyy_get_next_time( Hndl, DateStr, Status )
    1275. 

  1275.           IF ( .NOT. multi_files(io_form) ) THEN
    1276. 

  1276.             CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1277. 

  1277.             len_of_str = LEN(DateStr)
    1278. 

  1278.             CALL wrf_dm_bcast_string ( DateStr , len_of_str )
    1279. 

  1279.           ENDIF
    1280. 

  1280. #endif
    1281. 

  1281. #ifdef ZZZ
    1282. 

  1282.         CASE ( IO_ZZZ   )
    1283. 

  1283.           CALL ext_zzz_get_next_time( Hndl, DateStr, Status )
    1284. 

  1284. #endif
    1285. 

  1285. #ifdef GRIB1
    1286. 

  1286.         CASE ( IO_GRIB1   )
    1287. 

  1287.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr1_get_next_time( Hndl, DateStr, Status )
    1288. 

  1288.           IF ( .NOT. multi_files(io_form) ) THEN
    1289. 

  1289.             CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1290. 

  1290.             len_of_str = LEN(DateStr)
    1291. 

  1291.             CALL wrf_dm_bcast_string ( DateStr , len_of_str )
    1292. 

  1292.           ENDIF
    1293. 

  1293. #endif
    1294. 

  1294. #ifdef GRIB2
    1295. 

  1295.         CASE ( IO_GRIB2   )
    1296. 

  1296.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr2_get_next_time( Hndl, DateStr, Status )
    1297. 

  1297.           IF ( .NOT. multi_files(io_form) ) THEN
    1298. 

  1298.             CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1299. 

  1299.             len_of_str = LEN(DateStr)
    1300. 

  1300.             CALL wrf_dm_bcast_string ( DateStr , len_of_str )
    1301. 

  1301.           ENDIF
    1302. 

  1302. #endif
    1303. 

  1303. #ifdef INTIO
    1304. 

  1304.         CASE ( IO_INTIO   )
    1305. 

  1305.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_int_get_next_time( Hndl, DateStr, Status )
    1306. 

  1306.           IF ( .NOT. multi_files(io_form) ) THEN
    1307. 

  1307.             CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1308. 

  1308.             len_of_str = LEN(DateStr)
    1309. 

  1309.             CALL wrf_dm_bcast_string ( DateStr , len_of_str )
    1310. 

  1310.           ENDIF
    1311. 

  1311. #endif
    1312. 

  1312.         CASE DEFAULT
    1313. 

  1313.           Status = 0
    1314. 

  1314.       END SELECT
    1315. 

  1315.     ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
    1316. 

  1316.       CALL wrf_quilt_get_next_time( Hndl, DateStr, Status )
    1317. 

  1317.     ELSE
    1318. 

  1318.       Status = 0
    1319. 

  1319.     ENDIF
    1320. 

  1320.   ELSE
    1321. 

  1321.     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
    1322. 

  1322.   ENDIF
    1323. 

  1323.   RETURN
    1324. 

  1324. END SUBROUTINE wrf_get_next_time
    1325. 

  1325. 

  1326. !--- get_previous_time (not defined for IntIO )
    1327. 

  1327. 

  1328. SUBROUTINE wrf_get_previous_time ( DataHandle, DateStr, Status )
    1329. 

  1329. !<DESCRIPTION>
    1330. 

  1330. !<PRE>
    1331. 

  1331. ! Returns the previous time stamp.  
    1332. 

  1332. !</PRE>
    1333. 

  1333. !</DESCRIPTION>
    1334. 

  1334.   USE module_state_description
    1335. 

  1335.   IMPLICIT NONE
    1336. 

  1336.   INTEGER ,       INTENT(IN)  :: DataHandle
    1337. 

  1337.   CHARACTER*(*) :: DateStr
    1338. 

  1338.   INTEGER ,       INTENT(OUT) :: Status
    1339. 

  1339. #include "wrf_status_codes.h"
    1340. 

  1340. 

  1341.   INTEGER, EXTERNAL           :: use_package
    1342. 

  1342.   LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
    1343. 

  1343.   INTEGER io_form , Hndl, len_of_str
    1344. 

  1344.   LOGICAL                     :: for_out
    1345. 

  1345. 

  1346.   CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_get_previous_time' )
    1347. 

  1347. 

  1348.   Status = 0
    1349. 

  1349.   CALL get_handle ( Hndl, io_form , for_out, DataHandle )
    1350. 

  1350.   IF ( Hndl .GT. -1 ) THEN
    1351. 

  1351.     IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
    1352. 

  1352.       SELECT CASE ( use_package(io_form) )
    1353. 

  1353. #ifdef NETCDF
    1354. 

  1354.         CASE ( IO_NETCDF   )
    1355. 

  1355.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_ncd_get_previous_time( Hndl, DateStr, Status )
    1356. 

  1356.           IF ( .NOT. multi_files(io_form) ) THEN
    1357. 

  1357.             CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1358. 

  1358.             len_of_str = LEN(DateStr)
    1359. 

  1359.             CALL wrf_dm_bcast_string ( DateStr , len_of_str )
    1360. 

  1360.           ENDIF
    1361. 

  1361. #endif
    1362. 

  1362. #ifdef PHDF5
    1363. 

  1363.         CASE ( IO_PHDF5   )
    1364. 

  1364.           CALL ext_phdf5_get_previous_time( Hndl, DateStr, Status )
    1365. 

  1365. #endif
    1366. 

  1366. #ifdef PNETCDF
    1367. 

  1367.         CASE ( IO_PNETCDF   )
    1368. 

  1368.           CALL ext_pnc_get_previous_time( Hndl, DateStr, Status )
    1369. 

  1369. #endif
    1370. 

  1370. #ifdef XXX
    1371. 

  1371.         CASE ( IO_XXX   )
    1372. 

  1372.           CALL ext_xxx_get_previous_time( Hndl, DateStr, Status )
    1373. 

  1373. #endif
    1374. 

  1374. #ifdef YYY
    1375. 

  1375.         CASE ( IO_YYY   )
    1376. 

  1376.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_yyy_get_previous_time( Hndl, DateStr, Status )
    1377. 

  1377.           IF ( .NOT. multi_files(io_form) ) THEN
    1378. 

  1378.             CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1379. 

  1379.             len_of_str = LEN(DateStr)
    1380. 

  1380.             CALL wrf_dm_bcast_string ( DateStr , len_of_str )
    1381. 

  1381.          ENDIF
    1382. 

  1382. #endif
    1383. 

  1383. #ifdef ZZZ
    1384. 

  1384.         CASE ( IO_ZZZ   )
    1385. 

  1385.           CALL ext_zzz_get_previous_time( Hndl, DateStr, Status )
    1386. 

  1386. #endif
    1387. 

  1387. #ifdef GRIB1
    1388. 

  1388.         CASE ( IO_GRIB1   )
    1389. 

  1389.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr1_get_previous_time( Hndl, DateStr, Status )
    1390. 

  1390.           IF ( .NOT. multi_files(io_form) ) THEN
    1391. 

  1391.             CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1392. 

  1392.             len_of_str = LEN(DateStr)
    1393. 

  1393.             CALL wrf_dm_bcast_string ( DateStr , len_of_str )
    1394. 

  1394.          ENDIF
    1395. 

  1395. #endif
    1396. 

  1396. #ifdef GRIB2
    1397. 

  1397.         CASE ( IO_GRIB2   )
    1398. 

  1398.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr2_get_previous_time( Hndl, DateStr, Status )
    1399. 

  1399.           IF ( .NOT. multi_files(io_form) ) THEN
    1400. 

  1400.             CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1401. 

  1401.             len_of_str = LEN(DateStr)
    1402. 

  1402.             CALL wrf_dm_bcast_string ( DateStr , len_of_str )
    1403. 

  1403.          ENDIF
    1404. 

  1404. #endif
    1405. 

  1405. #ifdef INTIO
    1406. 

  1406. #endif
    1407. 

  1407.         CASE DEFAULT
    1408. 

  1408.           Status = 0
    1409. 

  1409.       END SELECT
    1410. 

  1410.     ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
    1411. 

  1411.       CALL wrf_quilt_get_previous_time( Hndl, DateStr, Status )
    1412. 

  1412.     ELSE
    1413. 

  1413.       Status = 0
    1414. 

  1414.     ENDIF
    1415. 

  1415.   ELSE
    1416. 

  1416.     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
    1417. 

  1417.   ENDIF
    1418. 

  1418.   RETURN
    1419. 

  1419. END SUBROUTINE wrf_get_previous_time
    1420. 

  1420. 

  1421. !--- set_time
    1422. 

  1422. 

  1423. SUBROUTINE wrf_set_time ( DataHandle, DateStr, Status )
    1424. 

  1424. !<DESCRIPTION>
    1425. 

  1425. !<PRE>
    1426. 

  1426. ! Sets the time stamp.  
    1427. 

  1427. !</PRE>
    1428. 

  1428. !</DESCRIPTION>
    1429. 

  1429.   USE module_state_description
    1430. 

  1430.   IMPLICIT NONE
    1431. 

  1431.   INTEGER ,       INTENT(IN)  :: DataHandle
    1432. 

  1432.   CHARACTER*(*) :: DateStr
    1433. 

  1433.   INTEGER ,       INTENT(OUT) :: Status
    1434. 

  1434. #include "wrf_status_codes.h"
    1435. 

  1435. 

  1436.   INTEGER, EXTERNAL           :: use_package
    1437. 

  1437.   LOGICAL, EXTERNAL           :: wrf_dm_on_monitor, multi_files, use_output_servers
    1438. 

  1438.   INTEGER io_form , Hndl
    1439. 

  1439.   LOGICAL                     :: for_out
    1440. 

  1440. 

  1441.   CALL wrf_debug( DEBUG_LVL, 'module_io.F: in wrf_set_time' )
    1442. 

  1442. 

  1443.   Status = 0
    1444. 

  1444.   CALL get_handle ( Hndl, io_form , for_out, DataHandle )
    1445. 

  1445.   IF ( Hndl .GT. -1 ) THEN
    1446. 

  1446.     IF ( multi_files( io_form ) .OR. .NOT. (for_out .AND. use_output_servers()) ) THEN
    1447. 

  1447.       SELECT CASE ( use_package( io_form ) )
    1448. 

  1448. #ifdef NETCDF
    1449. 

  1449.         CASE ( IO_NETCDF   )
    1450. 

  1450.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_ncd_set_time( Hndl, DateStr, Status )
    1451. 

  1451.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1452. 

  1452. #endif
    1453. 

  1453. #ifdef PHDF5
    1454. 

  1454.         CASE ( IO_PHDF5  )
    1455. 

  1455.           CALL ext_phdf5_set_time( Hndl, DateStr, Status )
    1456. 

  1456. #endif
    1457. 

  1457. #ifdef PNETCDF
    1458. 

  1458.         CASE ( IO_PNETCDF  )
    1459. 

  1459.           CALL ext_pnc_set_time( Hndl, DateStr, Status )
    1460. 

  1460. #endif
    1461. 

  1461. #ifdef XXX
    1462. 

  1462.         CASE ( IO_XXX   )
    1463. 

  1463.           CALL ext_xxx_set_time( Hndl, DateStr, Status )
    1464. 

  1464. #endif
    1465. 

  1465. #ifdef YYY
    1466. 

  1466.         CASE ( IO_YYY   )
    1467. 

  1467.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_yyy_set_time( Hndl, DateStr, Status )
    1468. 

  1468.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1469. 

  1469. #endif
    1470. 

  1470. #ifdef ZZZ
    1471. 

  1471.         CASE ( IO_ZZZ   )
    1472. 

  1472.           CALL ext_zzz_set_time( Hndl, DateStr, Status )
    1473. 

  1473. #endif
    1474. 

  1474. #ifdef GRIB1
    1475. 

  1475.         CASE ( IO_GRIB1   )
    1476. 

  1476.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr1_set_time( Hndl, DateStr, Status )
    1477. 

  1477.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1478. 

  1478. #endif
    1479. 

  1479. #ifdef GRIB2
    1480. 

  1480.         CASE ( IO_GRIB2   )
    1481. 

  1481.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_gr2_set_time( Hndl, DateStr, Status )
    1482. 

  1482.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1483. 

  1483. #endif
    1484. 

  1484. #ifdef INTIO
    1485. 

  1485.         CASE ( IO_INTIO   )
    1486. 

  1486.           IF ( multi_files(io_form) .OR.  wrf_dm_on_monitor() ) CALL ext_int_set_time( Hndl, DateStr, Status )
    1487. 

  1487.           CALL wrf_dm_bcast_bytes( Status, IWORDSIZE )
    1488. 

  1488. #endif
    1489. 

  1489.         CASE DEFAULT
    1490. 

  1490.           Status = 0
    1491. 

  1491.       END SELECT
    1492. 

  1492.     ELSE IF ( io_form .GT. 0 .AND. for_out .AND. use_output_servers() ) THEN
    1493. 

  1493.       CALL wrf_quilt_set_time( Hndl, DateStr, Status )
    1494. 

  1494.     ELSE
    1495. 

  1495.       Status = 0
    1496. 

  1496.     ENDIF
    1497. 

  1497.   ELSE
    1498. 

  1498.     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
    1499. 

  1499.   ENDIF
    1500. 

  1500.   RETURN
    1501. 

  1501. END SUBROUTINE wrf_set_time
    1502. 

  1502. 

  1503. !--- get_next_var  (not defined for IntIO)
    1504. 

  1504. 

  1505. SUBROUTINE wrf_get_next_var ( DataHandle, VarName, Status )
    1506. 

  1506. !<DESCRIPTION>
    1507. 

  1507. !<PRE>
    1508. 

  1508. ! On reading, this rou…
    1509.

Large files files are truncated, but you can click here to view the full file