PageRenderTime 42ms CodeModel.GetById 17ms RepoModel.GetById 1ms app.codeStats 0ms

/wrfv2_fire/dyn_nmm/module_si_io_nmm.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 3107 lines | 2044 code | 419 blank | 644 comment | 65 complexity | 0cb16b601e95d14369c5ac03cb4466f9 MD5 | raw file
Possible License(s): AGPL-1.0 
    

  1. MODULE module_si_io_nmm
    2. 

  2. 

  3.    USE module_optional_input
    4. 

  4. 

  5.    IMPLICIT NONE
    6. 

  6. !! FROM MODULE_KINDS
    7. 

  7. 

  8. !   The numerical data types defined in this module are:
    9. 

  9. !      i_byte    - specification kind for byte (1-byte) integer variable
    10. 

  10. !      i_short   - specification kind for short (2-byte) integer variable
    11. 

  11. !      i_long    - specification kind for long (4-byte) integer variable
    12. 

  12. !      i_llong   - specification kind for double long (8-byte) integer variable
    13. 

  13. !      r_single  - specification kind for single precision (4-byte) real variable
    14. 

  14. !      r_double  - specification kind for double precision (8-byte) real variable
    15. 

  15. !      r_quad    - specification kind for quad precision (16-byte) real variable
    16. 

  16. !
    17. 

  17. !      i_kind    - generic specification kind for default integer
    18. 

  18. !      r_kind    - generic specification kind for default floating point
    19. 

  19. !
    20. 

  20. !
    21. 

  21. ! Integer type definitions below
    22. 

  22. 

  23. ! Integer types
    24. 

  24.   integer, parameter, public  :: i_byte  = selected_int_kind(1)      ! byte  integer
    25. 

  25.   integer, parameter, public  :: i_short = selected_int_kind(4)      ! short integer
    26. 

  26.   integer, parameter, public  :: i_long  = selected_int_kind(8)      ! long  integer
    27. 

  27.   integer, parameter, private :: llong_t = selected_int_kind(16)     ! llong integer
    28. 

  28.   integer, parameter, public  :: i_llong = max( llong_t, i_long )
    29. 

  29. 

  30. ! Expected 8-bit byte sizes of the integer kinds
    31. 

  31.   integer, parameter, public :: num_bytes_for_i_byte  = 1
    32. 

  32.   integer, parameter, public :: num_bytes_for_i_short = 2
    33. 

  33.   integer, parameter, public :: num_bytes_for_i_long  = 4
    34. 

  34.   integer, parameter, public :: num_bytes_for_i_llong = 8
    35. 

  35. 

  36. ! Define arrays for default definition
    37. 

  37.   integer, parameter, private :: num_i_kinds = 4
    38. 

  38.   integer, parameter, dimension( num_i_kinds ), private :: integer_types = (/ &
    39. 

  39.        i_byte, i_short, i_long,  i_llong  /)
    40. 

  40.   integer, parameter, dimension( num_i_kinds ), private :: integer_byte_sizes = (/ &
    41. 

  41.        num_bytes_for_i_byte, num_bytes_for_i_short, &
    42. 

  42.        num_bytes_for_i_long, num_bytes_for_i_llong  /)
    43. 

  43. 

  44. ! Default values
    45. 

  45. ! **** CHANGE THE FOLLOWING TO CHANGE THE DEFAULT INTEGER TYPE KIND ***
    46. 

  46.   integer, parameter, private :: default_integer = 2  ! 1=byte,
    47. 

  47.                                                       ! 2=short,
    48. 

  48.                                                       ! 3=long,
    49. 

  49.                                                       ! 4=llong
    50. 

  50.   integer, parameter, public  :: i_kind = integer_types( default_integer )
    51. 

  51.   integer, parameter, public  :: num_bytes_for_i_kind = &
    52. 

  52.        integer_byte_sizes( default_integer )
    53. 

  53. 

  54. 

  55. ! Real definitions below
    56. 

  56. 

  57. ! Real types
    58. 

  58.   integer, parameter, public  :: r_single = selected_real_kind(6)  ! single precision
    59. 

  59.   integer, parameter, public  :: r_double = selected_real_kind(15) ! double precision
    60. 

  60.   integer, parameter, private :: quad_t   = selected_real_kind(20) ! quad precision
    61. 

  61.   integer, parameter, public  :: r_quad   = max( quad_t, r_double )
    62. 

  62. 

  63. ! Expected 8-bit byte sizes of the real kinds
    64. 

  64.   integer, parameter, public :: num_bytes_for_r_single = 4
    65. 

  65.   integer, parameter, public :: num_bytes_for_r_double = 8
    66. 

  66.   integer, parameter, public :: num_bytes_for_r_quad   = 16
    67. 

  67. 

  68. ! Define arrays for default definition
    69. 

  69.   integer, parameter, private :: num_r_kinds = 3
    70. 

  70.   integer, parameter, dimension( num_r_kinds ), private :: real_kinds = (/ &
    71. 

  71.        r_single, r_double, r_quad    /)
    72. 

  72.   integer, parameter, dimension( num_r_kinds ), private :: real_byte_sizes = (/ &
    73. 

  73.        num_bytes_for_r_single, num_bytes_for_r_double, &
    74. 

  74.        num_bytes_for_r_quad    /)
    75. 

  75. 

  76. ! Default values
    77. 

  77. ! **** CHANGE THE FOLLOWING TO CHANGE THE DEFAULT REAL TYPE KIND ***
    78. 

  78.   integer, parameter, private :: default_real = 2  ! 1=single,
    79. 

  79.                                                    ! 2=double,
    80. 

  80. !! END FROM MODULE_KINDS
    81. 

  81. 

  82.       !  Input 3D meteorological fields.
    83. 

  83. 

  84.       REAL , DIMENSION(:,:,:) , ALLOCATABLE :: u_input , v_input , &
    85. 

  85.                                                q_input , t_input
    86. 

  86. 

  87.       !  Input 3D LSM fields.
    88. 

  88. 

  89.       REAL , DIMENSION(:,:,:) , ALLOCATABLE :: landuse_frac_input , &
    90. 

  90.                                                soil_top_cat_input , &
    91. 

  91.                                                soil_bot_cat_input
    92. 

  92. 

  93.       REAL, ALLOCATABLE:: htm_in(:,:,:),vtm_in(:,:,:)
    94. 

  94. 

  95.       !  Input 2D surface fields.
    96. 

  96. 

  97.       REAL , DIMENSION(:,:)   , ALLOCATABLE,save :: soilt010_input , soilt040_input , &
    98. 

  98.                                                soilt100_input , soilt200_input , &
    99. 

  99.                                                soilm010_input , soilm040_input , &
    100. 

  100.                                                soilm100_input , soilm200_input , &
    101. 

  101.                                                psfc_in,pmsl
    102. 

  102. 

  103.       REAL , DIMENSION(:,:)   , ALLOCATABLE :: lat_wind, lon_wind 
    104. 

  104. 

  105.       REAL , DIMENSION(:)     , ALLOCATABLE :: DETA_in, AETA_in, ETAX_in
    106. 

  106.       REAL , DIMENSION(:)     , ALLOCATABLE :: DETA1_in, AETA1_in, ETA1_in
    107. 

  107.       REAL , DIMENSION(:)     , ALLOCATABLE :: DETA2_in, AETA2_in, ETA2_in, DFL_in
    108. 

  108. 

  109.       REAL , DIMENSION(:,:,:), ALLOCATABLE,save :: st_inputx , sm_inputx, sw_inputx
    110. 

  110. 

  111.       !  Local input arrays
    112. 

  112. 

  113.       REAL,DIMENSION(:,:),ALLOCATABLE :: dum2d
    114. 

  114.       INTEGER,DIMENSION(:,:),ALLOCATABLE :: idum2d
    115. 

  115.       REAL,DIMENSION(:,:,:),ALLOCATABLE :: dum3d
    116. 

  116. 

  117.       LOGICAL , SAVE :: first_time_in = .TRUE.
    118. 

  118. 

  119.       INTEGER :: flag_soilt010 , flag_soilt100 , flag_soilt200 , &
    120. 

  120.         	 flag_soilm010 , flag_soilm100 , flag_soilm200
    121. 

  121. 

  122. !   Some constants to allow simple dimensions in the defined types
    123. 

  123. !   given below.
    124. 

  124. 

  125.       INTEGER, PARAMETER          :: var_maxdims = 5
    126. 

  126.       INTEGER, PARAMETER          :: max_staggers_xy_new = 4
    127. 

  127.       INTEGER, PARAMETER          :: max_staggers_xy_old = 3
    128. 

  128.       INTEGER, PARAMETER          :: max_staggers_z = 2
    129. 

  129.       INTEGER, PARAMETER          :: max_standard_lats = 4
    130. 

  130.       INTEGER, PARAMETER          :: max_standard_lons = 4  
    131. 

  131.       INTEGER, PARAMETER          :: max_fg_variables = 200
    132. 

  132.       INTEGER, PARAMETER          :: max_vertical_levels = 2000
    133. 

  133. 

  134. !   This module defines the items needed for the WRF metadata
    135. 

  135. !   which is broken up into three levels:  
    136. 

  136. !      Global metadata:  Those things which apply to the
    137. 

  137. !                        entire simulation that are 
    138. 

  138. !                        independent of time, domain, or
    139. 

  139. !                        variable
    140. 

  140. !
    141. 

  141. !      Domain metadata:  Those things which apply to 
    142. 

  142. !                        a single domain (this may
    143. 

  143. !                        or may not be time dependent)
    144. 

  144. !
    145. 

  145. !      Variable metadata: Those things which apply to 
    146. 

  146. !                        a specific variable at a 
    147. 

  147. !                        specific time
    148. 

  148. !
    149. 

  149. !      The variable names and definitions can be 
    150. 

  150. !      found in the wrf_metadata spec, which is still
    151. 

  151. !      a living document as coding goes on.   The names
    152. 

  152. !      may not match exactly, but you should be able 
    153. 

  153. !      to figure things out.  
    154. 

  154. !
    155. 

  155. 

  156.       TYPE wrf_var_metadata
    157. 

  157. 	 CHARACTER (LEN=8)         :: name 
    158. 

  158. 	 CHARACTER (LEN=16)        :: units
    159. 

  159. 	 CHARACTER (LEN=80)        :: description
    160. 

  160. 	 INTEGER                   :: domain_id
    161. 

  161. 	 INTEGER                   :: ndim
    162. 

  162. 	 INTEGER                   :: dim_val (var_maxdims)
    163. 

  163. 	 CHARACTER(LEN=4)          :: dim_desc (var_maxdims)
    164. 

  164. 	 INTEGER                   :: start_index(var_maxdims)
    165. 

  165. 	 INTEGER                   :: stop_index(var_maxdims)
    166. 

  166. 	 INTEGER                   :: h_stagger_index
    167. 

  167. 	 INTEGER                   :: v_stagger_index
    168. 

  168. 	 CHARACTER(LEN=8)          :: array_order
    169. 

  169. 	 CHARACTER(LEN=4)          :: field_type
    170. 

  170. 	 CHARACTER(LEN=8)          :: field_source_prog
    171. 

  171. 	 CHARACTER(LEN=80)         :: source_desc
    172. 

  172. 	 CHARACTER(LEN=8)          :: field_time_type
    173. 

  173. 	 INTEGER                   :: vt_date_start
    174. 

  174. 	 REAL                      :: vt_time_start
    175. 

  175. 	 INTEGER                   :: vt_date_stop
    176. 

  176. 	 REAL                      :: vt_time_stop
    177. 

  177.       END TYPE wrf_var_metadata
    178. 

  178. 

  179.       TYPE(wrf_var_metadata)  :: var_meta , var_info
    180. 

  180. 

  181.       TYPE wrf_domain_metadata
    182. 

  182. 	 INTEGER                   :: id
    183. 

  183. 	 INTEGER                   :: parent_id
    184. 

  184. 	 CHARACTER(LEN=8)          :: dyn_init_src
    185. 

  185. 	 CHARACTER(LEN=8)          :: static_init_src 
    186. 

  186. 	 INTEGER                   :: vt_date
    187. 

  187. 	 REAL                      :: vt_time
    188. 

  188. 	 INTEGER                   :: origin_parent_x
    189. 

  189. 	 INTEGER                   :: origin_parent_y
    190. 

  190. 	 INTEGER                   :: ratio_to_parent
    191. 

  191. 	 REAL                      :: delta_x
    192. 

  192. 	 REAL                      :: delta_y
    193. 

  193. 	 REAL                      :: top_level
    194. 

  194. 	 INTEGER                   :: origin_parent_z
    195. 

  195. 	 REAL                      :: corner_lats_new(4,max_staggers_xy_new)
    196. 

  196. 	 REAL                      :: corner_lons_new(4,max_staggers_xy_new)
    197. 

  197. 	 REAL                      :: corner_lats_old(4,max_staggers_xy_old)
    198. 

  198. 	 REAL                      :: corner_lons_old(4,max_staggers_xy_old)
    199. 

  199. 	 INTEGER                   :: xdim
    200. 

  200. 	 INTEGER                   :: ydim
    201. 

  201. 	 INTEGER                   :: zdim
    202. 

  202.       END TYPE wrf_domain_metadata
    203. 

  203.       TYPE(wrf_domain_metadata) :: dom_meta
    204. 

  204. 

  205.       TYPE wrf_global_metadata
    206. 

  206. 	 CHARACTER(LEN=80)         :: simulation_name
    207. 

  207. 	 CHARACTER(LEN=80)         :: user_desc
    208. 

  208. 	 INTEGER                   :: si_version
    209. 

  209. 	 INTEGER                   :: analysis_version  
    210. 

  210. 	 INTEGER                   :: wrf_version
    211. 

  211. 	 INTEGER                   :: post_version
    212. 

  212. 	 CHARACTER(LEN=32)         :: map_projection
    213. 

  213. 	 REAL                      :: moad_known_lat
    214. 

  214. 	 REAL                      :: moad_known_lon
    215. 

  215. 	 CHARACTER(LEN=8)          :: moad_known_loc
    216. 

  216. 	 REAL                      :: moad_stand_lats(max_standard_lats)
    217. 

  217. 	 REAL                      :: moad_stand_lons(max_standard_lons)
    218. 

  218. 	 REAL                      :: moad_delta_x
    219. 

  219. 	 REAL                      :: moad_delta_y
    220. 

  220. 	 CHARACTER(LEN=4)          :: horiz_stagger_type
    221. 

  221. 	 INTEGER                   :: num_stagger_xy
    222. 

  222. 	 REAL                      :: stagger_dir_x_new(max_staggers_xy_new)
    223. 

  223. 	 REAL                      :: stagger_dir_y_new(max_staggers_xy_new)
    224. 

  224. 	 REAL                      :: stagger_dir_x_old(max_staggers_xy_old)
    225. 

  225. 	 REAL                      :: stagger_dir_y_old(max_staggers_xy_old)
    226. 

  226. 	 INTEGER                   :: num_stagger_z    
    227. 

  227. 	 REAL                      :: stagger_dir_z(max_staggers_z)
    228. 

  228. 	 CHARACTER(LEN=8)          :: vertical_coord
    229. 

  229. 	 INTEGER                   :: num_domains
    230. 

  230. 	 INTEGER                   :: init_date
    231. 

  231. 	 REAL                      :: init_time
    232. 

  232. 	 INTEGER                   :: end_date
    233. 

  233. 	 REAL                      :: end_time
    234. 

  234. 	 CHARACTER(LEN=4)          :: lu_source
    235. 

  235. 	 INTEGER                   :: lu_water
    236. 

  236. 	 INTEGER                   :: lu_ice  
    237. 

  237.       END TYPE wrf_global_metadata
    238. 

  238.       TYPE(wrf_global_metadata)   :: global_meta
    239. 

  239. 

  240. CONTAINS
    241. 

  241. 

  242.    SUBROUTINE read_si ( grid, file_date_string )
    243. 

  243. 

  244.       USE module_soil_pre
    245. 

  245.       USE module_domain
    246. 

  246. 

  247.       IMPLICIT NONE
    248. 

  248. 

  249.       TYPE(domain) , INTENT(INOUT)  :: grid
    250. 

  250.       CHARACTER (LEN=19) , INTENT(IN) :: file_date_string
    251. 

  251. 

  252.       INTEGER :: ids,ide,jds,jde,kds,kde           &
    253. 

  253.                 ,ims,ime,jms,jme,kms,kme           &
    254. 

  254.                 ,its,ite,jts,jte,kts,kte
    255. 

  255. 

  256.       INTEGER :: i , j , k , loop, IMAX, JMAX
    257. 

  257. 

  258.       REAL :: dummy
    259. 

  259. 

  260.       CHARACTER (LEN= 8) :: dummy_char
    261. 

  261.       CHARACTER (LEN=256) :: dummy_char_256
    262. 

  262. 

  263.       INTEGER :: ok , map_proj , ok_open
    264. 

  264.       REAL :: pt
    265. 

  265.       INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
    266. 

  266. 

  267.       SELECT CASE ( model_data_order )
    268. 

  268.          CASE ( DATA_ORDER_ZXY )
    269. 

  269.             kds = grid%sd31 ; kde = grid%ed31 ;
    270. 

  270.             ids = grid%sd32 ; ide = grid%ed32 ;
    271. 

  271.             jds = grid%sd33 ; jde = grid%ed33 ;
    272. 

  272. 

  273.             kms = grid%sm31 ; kme = grid%em31 ;
    274. 

  274.             ims = grid%sm32 ; ime = grid%em32 ;
    275. 

  275.             jms = grid%sm33 ; jme = grid%em33 ;
    276. 

  276. 

  277.             kts = grid%sp31 ; kte = grid%ep31 ; ! tile is entire patch
    278. 

  278.             its = grid%sp32 ; ite = grid%ep32 ; ! tile is entire patch
    279. 

  279.             jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
    280. 

  280. 

  281.          CASE ( DATA_ORDER_XYZ )
    282. 

  282.             ids = grid%sd31 ; ide = grid%ed31 ;
    283. 

  283.             jds = grid%sd32 ; jde = grid%ed32 ;
    284. 

  284.             kds = grid%sd33 ; kde = grid%ed33 ;
    285. 

  285. 

  286.             ims = grid%sm31 ; ime = grid%em31 ;
    287. 

  287.             jms = grid%sm32 ; jme = grid%em32 ;
    288. 

  288.             kms = grid%sm33 ; kme = grid%em33 ;
    289. 

  289. 

  290.             its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
    291. 

  291.             jts = grid%sp32 ; jte = grid%ep32 ; ! tile is entire patch
    292. 

  292.             kts = grid%sp33 ; kte = grid%ep33 ; ! tile is entire patch
    293. 

  293. 

  294.          CASE ( DATA_ORDER_XZY )
    295. 

  295.             ids = grid%sd31 ; ide = grid%ed31 ;
    296. 

  296.             kds = grid%sd32 ; kde = grid%ed32 ;
    297. 

  297.             jds = grid%sd33 ; jde = grid%ed33 ;
    298. 

  298. 

  299.             ims = grid%sm31 ; ime = grid%em31 ;
    300. 

  300.             kms = grid%sm32 ; kme = grid%em32 ;
    301. 

  301.             jms = grid%sm33 ; jme = grid%em33 ;
    302. 

  302. 

  303.             its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
    304. 

  304.             kts = grid%sp32 ; kte = grid%ep32 ; ! tile is entire patch
    305. 

  305.             jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
    306. 

  306. 

  307.       END SELECT
    308. 

  308. 

  309.       !  Initialize what soil temperature and moisture is available.
    310. 

  310. 

  311. !      write(0,*) 'dum3d I allocs: ', ids,ide-1
    312. 

  312. !      write(0,*) 'dum3d J allocs: ', jds,jde-1
    313. 

  313. !      write(0,*) 'dum3d K allocs: ', kds,kde-1
    314. 

  314. 

  315.       flag_st000010 = 0
    316. 

  316.       flag_st010040 = 0
    317. 

  317.       flag_st040100 = 0
    318. 

  318.       flag_st100200 = 0
    319. 

  319.       flag_sm000010 = 0 
    320. 

  320.       flag_sm010040 = 0
    321. 

  321.       flag_sm040100 = 0
    322. 

  322.       flag_sm100200 = 0
    323. 

  323.       flag_st010200 = 0
    324. 

  324.       flag_sm010200 = 0
    325. 

  325. 

  326.       flag_soilt010 = 0
    327. 

  327.       flag_soilt040 = 0
    328. 

  328.       flag_soilt100 = 0
    329. 

  329.       flag_soilt200 = 0 
    330. 

  330.       flag_soilm010 = 0 
    331. 

  331.       flag_soilm040 = 0
    332. 

  332.       flag_soilm100 = 0
    333. 

  333.       flag_soilm200 = 0
    334. 

  334. 

  335.       flag_sst      = 0
    336. 

  336.       flag_toposoil = 0
    337. 

  337. 

  338.       !  How many soil levels have we found?  Well, right now, none.
    339. 

  339. 

  340.       num_st_levels_input = 0
    341. 

  341.       num_sm_levels_input = 0
    342. 

  342.       st_levels_input = -1
    343. 

  343.       sm_levels_input = -1
    344. 

  344. 

  345.       !  Get the space for the data if this is the first time here.
    346. 

  346. 

  347.         write(6,*) 'enter read_si...first_time_in:: ', first_time_in
    348. 

  348. 

  349.       IF ( first_time_in ) THEN
    350. 

  350. 

  351.          CLOSE(12)
    352. 

  352.          OPEN ( FILE   = 'real_input_nm.global.metadata' , &
    353. 

  353.                 UNIT   = 12                              , &
    354. 

  354.                 STATUS = 'OLD'                           , &
    355. 

  355.                 ACCESS = 'SEQUENTIAL'                    , &
    356. 

  356.                 FORM   = 'UNFORMATTED'                   , &
    357. 

  357.                 IOSTAT = ok_open                           )
    358. 

  358. 

  359.          IF ( ok_open .NE. 0 ) THEN
    360. 

  360.             PRINT '(A)','You asked for WRF SI data, but no real_input_nm.global.metadata file exists.'
    361. 

  361.             STOP 'No_real_input_nm.global.metadata_exists'
    362. 

  362.          END IF
    363. 

  363. 

  364.          READ(12) global_meta%simulation_name, global_meta%user_desc, &
    365. 

  365.                   global_meta%si_version, global_meta%analysis_version, &
    366. 

  366.                   global_meta%wrf_version, global_meta%post_version
    367. 

  367.    
    368. 

  368.          REWIND (12)
    369. 

  369. 

  370.          IF      ( global_meta%si_version .EQ. 1 ) THEN
    371. 

  371.             READ(12) global_meta%simulation_name, global_meta%user_desc, &
    372. 

  372.                      global_meta%si_version, global_meta%analysis_version, &
    373. 

  373.                      global_meta%wrf_version, global_meta%post_version, &
    374. 

  374.                      global_meta%map_projection, global_meta%moad_known_lat, &
    375. 

  375.                      global_meta%moad_known_lon, global_meta%moad_known_loc, &
    376. 

  376.                      global_meta%moad_stand_lats, global_meta%moad_stand_lons, &
    377. 

  377.                      global_meta%moad_delta_x, global_meta%moad_delta_y, &
    378. 

  378.                      global_meta%horiz_stagger_type, global_meta%num_stagger_xy, &
    379. 

  379.                      global_meta%stagger_dir_x_old, global_meta%stagger_dir_y_old, &
    380. 

  380.                      global_meta%num_stagger_z, global_meta%stagger_dir_z, &
    381. 

  381.                      global_meta%vertical_coord, global_meta%num_domains, &
    382. 

  382.                      global_meta%init_date, global_meta%init_time, &
    383. 

  383.                      global_meta%end_date, global_meta%end_time
    384. 

  384.          ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
    385. 

  385.             READ(12) global_meta%simulation_name, global_meta%user_desc, &
    386. 

  386.                      global_meta%si_version, global_meta%analysis_version, &
    387. 

  387.                      global_meta%wrf_version, global_meta%post_version, &
    388. 

  388.                      global_meta%map_projection, global_meta%moad_known_lat, &
    389. 

  389.                      global_meta%moad_known_lon, global_meta%moad_known_loc, &
    390. 

  390.                      global_meta%moad_stand_lats, global_meta%moad_stand_lons, &
    391. 

  391.                      global_meta%moad_delta_x, global_meta%moad_delta_y, &
    392. 

  392.                      global_meta%horiz_stagger_type, global_meta%num_stagger_xy, &
    393. 

  393.                      global_meta%stagger_dir_x_new, global_meta%stagger_dir_y_new, &
    394. 

  394.                      global_meta%num_stagger_z, global_meta%stagger_dir_z, &
    395. 

  395.                      global_meta%vertical_coord, global_meta%num_domains, &
    396. 

  396.                      global_meta%init_date, global_meta%init_time, &
    397. 

  397.                      global_meta%end_date, global_meta%end_time , &
    398. 

  398.                      global_meta%lu_source, global_meta%lu_water, global_meta%lu_ice
    399. 

  399.          END IF
    400. 

  400.          CLOSE (12)
    401. 

  401.    
    402. 

  402.          print *,'GLOBAL METADATA'
    403. 

  403.          print *,'global_meta%simulation_name', global_meta%simulation_name
    404. 

  404.          print *,'global_meta%user_desc', global_meta%user_desc
    405. 

  405.          print *,'global_meta%user_desc', global_meta%user_desc
    406. 

  406.          print *,'global_meta%si_version', global_meta%si_version
    407. 

  407.          print *,'global_meta%analysis_version', global_meta%analysis_version
    408. 

  408.          print *,'global_meta%wrf_version', global_meta%wrf_version
    409. 

  409.          print *,'global_meta%post_version', global_meta%post_version
    410. 

  410.          print *,'global_meta%map_projection', global_meta%map_projection
    411. 

  411.          print *,'global_meta%moad_known_lat', global_meta%moad_known_lat
    412. 

  412.          print *,'global_meta%moad_known_lon', global_meta%moad_known_lon
    413. 

  413.          print *,'global_meta%moad_known_loc', global_meta%moad_known_loc
    414. 

  414.          print *,'global_meta%moad_stand_lats', global_meta%moad_stand_lats
    415. 

  415.          print *,'global_meta%moad_stand_lons', global_meta%moad_stand_lons
    416. 

  416.          print *,'global_meta%moad_delta_x', global_meta%moad_delta_x
    417. 

  417.          print *,'global_meta%moad_delta_y', global_meta%moad_delta_y
    418. 

  418.          print *,'global_meta%horiz_stagger_type', global_meta%horiz_stagger_type
    419. 

  419.          print *,'global_meta%num_stagger_xy', global_meta%num_stagger_xy
    420. 

  420.          IF      ( global_meta%si_version .EQ. 1 ) THEN
    421. 

  421.             print *,'global_meta%stagger_dir_x', global_meta%stagger_dir_x_old
    422. 

  422.             print *,'global_meta%stagger_dir_y', global_meta%stagger_dir_y_old
    423. 

  423.          ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
    424. 

  424.             print *,'global_meta%stagger_dir_x', global_meta%stagger_dir_x_new
    425. 

  425.             print *,'global_meta%stagger_dir_y', global_meta%stagger_dir_y_new
    426. 

  426.          END IF
    427. 

  427.          print *,'global_meta%num_stagger_z', global_meta%num_stagger_z
    428. 

  428.          print *,'global_meta%stagger_dir_z', global_meta%stagger_dir_z
    429. 

  429.          print *,'global_meta%vertical_coord', global_meta%vertical_coord
    430. 

  430.          print *,'global_meta%num_domains', global_meta%num_domains
    431. 

  431.          print *,'global_meta%init_date', global_meta%init_date
    432. 

  432.          print *,'global_meta%init_time', global_meta%init_time
    433. 

  433.          print *,'global_meta%end_date', global_meta%end_date
    434. 

  434.          print *,'global_meta%end_time', global_meta%end_time
    435. 

  435.          IF ( global_meta%si_version .EQ. 2 ) THEN
    436. 

  436.             print *,'global_meta%lu_source', global_meta%lu_source
    437. 

  437.             print *,'global_meta%lu_water', global_meta%lu_water
    438. 

  438.             print *,'global_meta%lu_ice', global_meta%lu_ice
    439. 

  439.          END IF
    440. 

  440.          print *,' '
    441. 

  441. 

  442.          !  1D - this is the definition of the vertical coordinate.
    443. 

  443. 

  444.         IF (.NOT. ALLOCATED (DETA_in)) ALLOCATE(DETA_in(kds:kde-1))
    445. 

  445.         IF (.NOT. ALLOCATED (AETA_in)) ALLOCATE(AETA_in(kds:kde-1))
    446. 

  446.         IF (.NOT. ALLOCATED (ETAX_in)) ALLOCATE(ETAX_in(kds:kde))
    447. 

  447. 

  448.         IF (.NOT. ALLOCATED (DETA1_in)) ALLOCATE(DETA1_in(kds:kde-1))
    449. 

  449.         IF (.NOT. ALLOCATED (AETA1_in)) ALLOCATE(AETA1_in(kds:kde-1))
    450. 

  450.         IF (.NOT. ALLOCATED (ETA1_in))  ALLOCATE(ETA1_in(kds:kde))
    451. 

  451. 

  452.         IF (.NOT. ALLOCATED (DETA2_in)) ALLOCATE(DETA2_in(kds:kde-1))
    453. 

  453.         IF (.NOT. ALLOCATED (AETA2_in)) ALLOCATE(AETA2_in(kds:kde-1))
    454. 

  454.         IF (.NOT. ALLOCATED (ETA2_in)) ALLOCATE(ETA2_in(kds:kde))
    455. 

  455. 

  456.         IF (.NOT. ALLOCATED (DFL_in)) ALLOCATE(DFL_in(kds:kde))
    457. 

  457. 

  458.          !  3D met
    459. 

  459. 

  460.         IF (.NOT. ALLOCATED (u_input)  ) ALLOCATE ( u_input(its:ite,jts:jte,kts:kte) )
    461. 

  461.         IF (.NOT. ALLOCATED (v_input)  ) ALLOCATE ( v_input(its:ite,jts:jte,kts:kte) )
    462. 

  462.         IF (.NOT. ALLOCATED (q_input)  ) ALLOCATE ( q_input(its:ite,jts:jte,kts:kte) )
    463. 

  463.         IF (.NOT. ALLOCATED (t_input)  ) ALLOCATE ( t_input(its:ite,jts:jte,kts:kte) )
    464. 

  464.         IF (.NOT. ALLOCATED (htm_in)  ) ALLOCATE ( htm_in(its:ite,jts:jte,kts:kte) )
    465. 

  465.         IF (.NOT. ALLOCATED (vtm_in)  ) ALLOCATE ( vtm_in(its:ite,jts:jte,kts:kte) )
    466. 

  466. 

  467.         !  2D pressure fields
    468. 

  468. 

  469.         IF (.NOT. ALLOCATED (pmsl)              ) ALLOCATE ( pmsl(its:ite,jts:jte) )
    470. 

  470.         IF (.NOT. ALLOCATED (psfc_in)           ) ALLOCATE ( psfc_in(its:ite,jts:jte) )
    471. 

  471. 

  472.         !  2D - for LSM, these are computed from the categorical precentage values.
    473. 

  473. 

  474.         !  2D - for LSM, the various soil temperature and moisture levels that are available.
    475. 

  475. 

  476.         IF (.NOT. ALLOCATED (st_inputx)) ALLOCATE (st_inputx(its:ite,jts:jte,num_st_levels_alloc))
    477. 

  477.         IF (.NOT. ALLOCATED (sm_inputx)) ALLOCATE (sm_inputx(its:ite,jts:jte,num_st_levels_alloc))
    478. 

  478.         IF (.NOT. ALLOCATED (sw_inputx)) ALLOCATE (sw_inputx(its:ite,jts:jte,num_st_levels_alloc))
    479. 

  479. 

  480.         IF (.NOT. ALLOCATED (soilt010_input)    ) ALLOCATE ( soilt010_input(its:ite,jts:jte) )
    481. 

  481.         IF (.NOT. ALLOCATED (soilt040_input)    ) ALLOCATE ( soilt040_input(its:ite,jts:jte) )
    482. 

  482.         IF (.NOT. ALLOCATED (soilt100_input)    ) ALLOCATE ( soilt100_input(its:ite,jts:jte) )
    483. 

  483.         IF (.NOT. ALLOCATED (soilt200_input)    ) ALLOCATE ( soilt200_input(its:ite,jts:jte) )
    484. 

  484.         IF (.NOT. ALLOCATED (soilm010_input)    ) ALLOCATE ( soilm010_input(its:ite,jts:jte) )
    485. 

  485.         IF (.NOT. ALLOCATED (soilm040_input)    ) ALLOCATE ( soilm040_input(its:ite,jts:jte) )
    486. 

  486.         IF (.NOT. ALLOCATED (soilm100_input)    ) ALLOCATE ( soilm100_input(its:ite,jts:jte) )
    487. 

  487.         IF (.NOT. ALLOCATED (soilm200_input)    ) ALLOCATE ( soilm200_input(its:ite,jts:jte) )
    488. 

  488. 

  489.         IF (.NOT. ALLOCATED (lat_wind)          ) ALLOCATE (lat_wind(its:ite,jts:jte))
    490. 

  490.         IF (.NOT. ALLOCATED (lon_wind)          ) ALLOCATE (lon_wind(its:ite,jts:jte))
    491. 

  491. 

  492.         !  Local arrays
    493. 

  493.         IF (.NOT. ALLOCATED (dum2d)             ) ALLOCATE (dum2d(IDS:IDE-1,JDS:JDE-1))
    494. 

  494.         IF (.NOT. ALLOCATED (idum2d)            ) ALLOCATE (idum2d(IDS:IDE-1,JDS:JDE-1))
    495. 

  495.         IF (.NOT. ALLOCATED (dum3d)             ) ALLOCATE (dum3d(IDS:IDE-1,JDS:JDE-1,KDS:KDE-1))
    496. 

  496. 

  497. 

  498.       END IF
    499. 

  499. 

  500.       CLOSE(13)
    501. 

  501. 

  502.       write(6,*) 'file_date_string: ', file_date_string
    503. 

  503.       write(6,*) 'opening real_input_nm.d01.'//file_date_string//' as unit 13'
    504. 

  504.       OPEN ( FILE   = 'real_input_nm.d01.'//file_date_string , &
    505. 

  505.              UNIT   = 13                                     , &
    506. 

  506.              STATUS = 'OLD'                                  , &
    507. 

  507.              ACCESS = 'SEQUENTIAL'                           , &
    508. 

  508.              FORM   = 'UNFORMATTED'                            )
    509. 

  509. 

  510.       IF      ( global_meta%si_version .EQ. 1 ) THEN
    511. 

  511.          READ (13) dom_meta%id,dom_meta%parent_id,dom_meta%dyn_init_src,&
    512. 

  512.                    dom_meta%static_init_src, dom_meta%vt_date, dom_meta%vt_time, &
    513. 

  513.                    dom_meta%origin_parent_x, dom_meta%origin_parent_y, &
    514. 

  514.                    dom_meta%ratio_to_parent, dom_meta%delta_x, dom_meta%delta_y, &
    515. 

  515.                    dom_meta%top_level, dom_meta%origin_parent_z, &
    516. 

  516.                    dom_meta%corner_lats_old, dom_meta%corner_lons_old, dom_meta%xdim, &
    517. 

  517.                    dom_meta%ydim, dom_meta%zdim
    518. 

  518.       ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
    519. 

  519.          READ (13) dom_meta%id,dom_meta%parent_id,dom_meta%dyn_init_src,&
    520. 

  520.                    dom_meta%static_init_src, dom_meta%vt_date, dom_meta%vt_time, &
    521. 

  521.                    dom_meta%origin_parent_x, dom_meta%origin_parent_y, &
    522. 

  522.                    dom_meta%ratio_to_parent, dom_meta%delta_x, dom_meta%delta_y, &
    523. 

  523.                    dom_meta%top_level, dom_meta%origin_parent_z, &
    524. 

  524.                    dom_meta%corner_lats_new, dom_meta%corner_lons_new, dom_meta%xdim, &
    525. 

  525.                    dom_meta%ydim, dom_meta%zdim
    526. 

  526.       END IF
    527. 

  527. 

  528.       print *,'DOMAIN METADATA'
    529. 

  529.       print *,'dom_meta%id=', dom_meta%id
    530. 

  530.       print *,'dom_meta%parent_id=', dom_meta%parent_id
    531. 

  531.       print *,'dom_meta%dyn_init_src=', dom_meta%dyn_init_src
    532. 

  532.       print *,'dom_meta%static_init_src=', dom_meta%static_init_src
    533. 

  533.       print *,'dom_meta%vt_date=', dom_meta%vt_date
    534. 

  534.       print *,'dom_meta%vt_time=', dom_meta%vt_time
    535. 

  535.       print *,'dom_meta%origin_parent_x=', dom_meta%origin_parent_x
    536. 

  536.       print *,'dom_meta%origin_parent_y=', dom_meta%origin_parent_y
    537. 

  537.       print *,'dom_meta%ratio_to_parent=', dom_meta%ratio_to_parent
    538. 

  538.       print *,'dom_meta%delta_x=', dom_meta%delta_x
    539. 

  539.       print *,'dom_meta%delta_y=', dom_meta%delta_y
    540. 

  540.       print *,'dom_meta%top_level=', dom_meta%top_level
    541. 

  541.       print *,'dom_meta%origin_parent_z=', dom_meta%origin_parent_z
    542. 

  542.       IF      ( global_meta%si_version .EQ. 1 ) THEN
    543. 

  543.          print *,'dom_meta%corner_lats=', dom_meta%corner_lats_old
    544. 

  544.          print *,'dom_meta%corner_lons=', dom_meta%corner_lons_old
    545. 

  545.       ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
    546. 

  546.          print *,'dom_meta%corner_lats=', dom_meta%corner_lats_new
    547. 

  547.          print *,'dom_meta%corner_lons=', dom_meta%corner_lons_new
    548. 

  548.       END IF
    549. 

  549.       print *,'dom_meta%xdim=', dom_meta%xdim
    550. 

  550.       print *,'dom_meta%ydim=', dom_meta%ydim
    551. 

  551.       print *,'dom_meta%zdim=', dom_meta%zdim
    552. 

  552.       print *,' '
    553. 

  553. 

  554.       !  A simple domain size test.
    555. 

  555.     
    556. 

  556. 

  557. !!        relax constraint, as model namelist has +1 for i and j, while
    558. 

  558. !!        si data has true dimensions
    559. 

  559. 

  560.       IF (  abs(dom_meta%xdim - (ide-1)) .gt. 1 &
    561. 

  561.        .OR. abs(dom_meta%ydim - (jde-1)) .gt. 1 &
    562. 

  562.        .OR. abs(dom_meta%zdim - (kde-1)) .gt. 1) THEN
    563. 

  563.          PRINT '(A)','Namelist does not match the input data.'
    564. 

  564.          PRINT '(A,3I5,A)','Namelist dimensions =',ide-1,jde-1,kde-1,'.'
    565. 

  565.          PRINT '(A,3I5,A)','Input data dimensions =',dom_meta%xdim,dom_meta%ydim,dom_meta%zdim,'.'
    566. 

  566.          STOP 'Wrong_data_size'
    567. 

  567.       END IF
    568. 

  568. 

  569.       ! How about the grid distance?  Is it the same as in the namelist?
    570. 

  570. 

  571.       IF        ( global_meta%si_version .EQ. 1 ) THEN
    572. 

  572.          CALL nl_set_cen_lat ( grid%id , ( dom_meta%corner_lats_old(1,1) + dom_meta%corner_lats_old(2,1) +        &
    573. 

  573.                                         dom_meta%corner_lats_old(3,1) + dom_meta%corner_lats_old(4,1) ) * 0.25 ) 
    574. 

  574.       ELSE IF ( ( global_meta%si_version .EQ. 2 ) .AND. ( global_meta%moad_known_loc(1:6) .EQ. 'CENTER' ) ) THEN
    575. 

  575.          CALL nl_set_cen_lat ( grid%id , global_meta%moad_known_lat )
    576. 

  576.       ELSE IF   ( global_meta%si_version .EQ. 2 ) THEN
    577. 

  577.          CALL nl_set_cen_lat ( grid%id , ( dom_meta%corner_lats_new(1,1) + dom_meta%corner_lats_new(2,1) +        &
    578. 

  578.                                         dom_meta%corner_lats_new(3,1) + dom_meta%corner_lats_new(4,1) ) * 0.25 ) 
    579. 

  579.       END IF
    580. 

  580. 

  581. 

  582. !!!        might be trouble here
    583. 

  583. 

  584.       CALL nl_set_cen_lon ( grid%id , global_meta%moad_stand_lons(1) )
    585. 

  585. !!!!!
    586. 

  586.       write(6,*) 'set_cen_lat... global_meta%moad_stand_lats(1): ', global_meta%moad_stand_lats(1)
    587. 

  587.       CALL nl_set_cen_lat ( grid%id , global_meta%moad_stand_lats(1) )
    588. 

  588. !!!!!
    589. 

  589.       CALL nl_set_truelat1 ( grid%id , global_meta%moad_stand_lats(1) )
    590. 

  590.       CALL nl_set_truelat2 ( grid%id , global_meta%moad_stand_lats(2) )
    591. 

  591. 

  592.       pt = dom_meta%top_level
    593. 

  593. 

  594.       IF      ( global_meta%map_projection(1:17) .EQ. 'LAMBERT CONFORMAL'   ) THEN
    595. 

  595.          map_proj = 1
    596. 

  596.       ELSE IF ( global_meta%map_projection(1:19) .EQ. 'POLAR STEREOGRAPHIC' ) THEN
    597. 

  597.          map_proj = 2
    598. 

  598.       ELSE IF ( global_meta%map_projection(1: 8) .EQ. 'MERCATOR'            ) THEN
    599. 

  599.          map_proj = 3
    600. 

  600.       ELSE IF ( global_meta%map_projection(1:14) .EQ. 'ROTATED LATLON' ) THEN
    601. 

  601.          map_proj = 203 !?
    602. 

  602.       ELSE
    603. 

  603.          PRINT '(A,A,A)','Undefined map projection: ',TRIM(global_meta%map_projection(1:20)),'.'
    604. 

  604.          STOP 'Undefined_map_proj_si'
    605. 

  605.       END IF
    606. 

  606.       CALL nl_set_map_proj ( grid%id , map_proj ) 
    607. 

  607.      
    608. 

  608. !      write(0,*) 'global_meta%si_version: ', global_meta%si_version
    609. 

  609. !      write(0,*) 'global_meta%lu_source: ', global_meta%lu_source
    610. 

  610. !      write(0,*) 'global_meta%lu_water: ', global_meta%lu_water
    611. 

  611.       IF      ( global_meta%si_version .EQ. 1 ) THEN
    612. 

  612.          CALL nl_set_mminlu (grid%id, 'USGS' )
    613. 

  613.          CALL nl_set_iswater (grid%id, 16 )
    614. 

  614.       ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
    615. 

  615.          CALL nl_set_mminlu ( grid%id, global_meta%lu_source )
    616. 

  616.          CALL nl_set_iswater (grid%id, global_meta%lu_water )
    617. 

  617.          CALL nl_set_isice (grid%id, global_meta%lu_ice )
    618. 

  618.       END IF
    619. 

  619. 

  620.       CALL nl_set_gmt (grid%id, dom_meta%vt_time / 3600. )
    621. 

  621.       CALL nl_set_julyr (grid%id, dom_meta%vt_date / 1000 )
    622. 

  622.       CALL nl_set_julday (grid%id, dom_meta%vt_date - ( dom_meta%vt_date / 1000 ) * 1000 )
    623. 

  623. 

  624.       write(6,*) 'start reading from unit 13'
    625. 

  625.       read_all_the_data : DO
    626. 

  626. 

  627.          READ (13,IOSTAT=OK) var_info%name, var_info%units, &
    628. 

  628.                              var_info%description, var_info%domain_id, var_info%ndim, &
    629. 

  629.                              var_info%dim_val, var_info%dim_desc, var_info%start_index, &
    630. 

  630.                              var_info%stop_index, var_info%h_stagger_index, var_info%v_stagger_index,&
    631. 

  631.                              var_info%array_order, var_info%field_type, var_info%field_source_prog, &
    632. 

  632.                              var_info%source_desc, var_info%field_time_type, var_info%vt_date_start, &
    633. 

  633.                              var_info%vt_time_start, var_info%vt_date_stop, var_info%vt_time_stop
    634. 

  634. 

  635.          IF ( OK .NE. 0 ) THEN
    636. 

  636.             PRINT '(A,A,A)','End of file found for real_input_nm.d01.',file_date_string,'.'
    637. 

  637.             EXIT read_all_the_data
    638. 

  638.          END IF
    639. 

  639. 

  640. !        print *,'VARIABLE METADATA'
    641. 

  641.          PRINT '(A,A)','var_info%name=', var_info%name 
    642. 

  642. !        print *,'var_info%units=', var_info%units 
    643. 

  643. !        print *,'var_info%description=', var_info%description 
    644. 

  644. !        print *,'var_info%domain_id=', var_info%domain_id 
    645. 

  645. !        print *,'var_info%ndim=', var_info%ndim 
    646. 

  646. !        print *,'var_info%dim_val=', var_info%dim_val 
    647. 

  647. !        print *,'var_info%dim_desc=', var_info%dim_desc 
    648. 

  648. !        print *,'var_info%start_index=', var_info%start_index 
    649. 

  649. !        print *,'var_info%stop_index=', var_info%stop_index 
    650. 

  650. !        print *,'var_info%h_stagger_index=', var_info%h_stagger_index 
    651. 

  651. !        print *,'var_info%v_stagger_index=', var_info%v_stagger_index
    652. 

  652. !        print *,'var_info%array_order=', var_info%array_order 
    653. 

  653. !        print *,'var_info%field_type=', var_info%field_type 
    654. 

  654. !        print *,'var_info%field_source_prog=', var_info%field_source_prog 
    655. 

  655. !        print *,'var_info%source_desc=', var_info%source_desc 
    656. 

  656. !        print *,'var_info%field_time_type=', var_info%field_time_type 
    657. 

  657. !        print *,'var_info%vt_date_start=', var_info%vt_date_start 
    658. 

  658. !        print *,'var_info%vt_time_start=', var_info%vt_time_start 
    659. 

  659. !        print *,'var_info%vt_date_stop=', var_info%vt_date_stop 
    660. 

  660. !        print *,'var_info%vt_time_stop=', var_info%vt_time_stop
    661. 

  661. 

  662.         JMAX=min(JDE-1,JTE)
    663. 

  663.         IMAX=min(IDE-1,ITE)
    664. 

  664.          !  3D meteorological fields.
    665. 

  665. 

  666. !         write(0,*)' read_si var_info%name=',var_info%name(1:8)
    667. 

  667. 

  668.          IF      ( var_info%name(1:8) .EQ. 'T       ' ) THEN
    669. 

  669.             READ (13) dum3d
    670. 

  670.             do k=kts,kte-1
    671. 

  671.             do j=jts,JMAX
    672. 

  672.             do i=its,IMAX
    673. 

  673.               t_input(i,j,k)=dum3d(i,j,k)
    674. 

  674.             enddo
    675. 

  675.             enddo
    676. 

  676.             enddo
    677. 

  677. 

  678.          ELSE IF      ( var_info%name(1:8) .EQ. 'U       ' ) THEN
    679. 

  679.             READ (13) dum3d
    680. 

  680.             do k=kts,kte-1
    681. 

  681.             do j=jts,JMAX
    682. 

  682.             do i=its,IMAX
    683. 

  683.               u_input(i,j,k)=dum3d(i,j,k)
    684. 

  684.             enddo
    685. 

  685.             enddo
    686. 

  686.             enddo
    687. 

  687. 

  688.          ELSE IF ( var_info%name(1:8) .EQ. 'V       ' ) THEN
    689. 

  689.             READ (13) dum3d
    690. 

  690.             do k=kts,kte-1
    691. 

  691.             do j=jts,JMAX
    692. 

  692.             do i=its,IMAX
    693. 

  693.               v_input(i,j,k)=dum3d(i,j,k)
    694. 

  694.             enddo
    695. 

  695.             enddo
    696. 

  696.             enddo
    697. 

  697. 

  698.          ELSE IF ( var_info%name(1:8) .EQ. 'Q      ' ) THEN
    699. 

  699.             READ (13) dum3d
    700. 

  700.             do k=kts,kte-1
    701. 

  701.             do j=jts,JMAX
    702. 

  702.             do i=its,IMAX
    703. 

  703.               q_input(i,j,k)=dum3d(i,j,k)
    704. 

  704.             enddo
    705. 

  705.             enddo
    706. 

  706.             enddo
    707. 

  707. 

  708.          !  3D LSM fields.  Don't know the 3rd dimension until we read it in.
    709. 

    710. 

  710.          ELSE IF ( var_info%name(1:8) .EQ. 'LANDUSEF' ) THEN
    711. 

  711.             IF ( ( first_time_in ) .AND. ( .NOT. ALLOCATED ( landuse_frac_input) ) ) THEN
    712. 

  712.                ALLOCATE (landuse_frac_input(its:ite,jts:jte,var_info%dim_val(3)) )
    713. 

  713.             END IF
    714. 

  714.             READ (13) (((dum3d(i,j,k),i=ids,ide-1),j=jds,jde-1),k=1,var_info%dim_val(3))
    715. 

  715.             do k=1,var_info%dim_val(3)
    716. 

  716.             do j=jts,JMAX
    717. 

  717.             do i=its,IMAX
    718. 

  718.               landuse_frac_input(i,j,k)=dum3d(i,j,k)
    719. 

  719.             enddo
    720. 

  720.             enddo
    721. 

  721.             enddo
    722. 

  722.          ELSE IF ( var_info%name(1:8) .EQ. 'SOILCTOP' ) THEN
    723. 

  723.             IF ( ( first_time_in ) .AND. ( .NOT. ALLOCATED ( soil_top_cat_input) ) ) THEN
    724. 

  724.                ALLOCATE (soil_top_cat_input(its:ite,jts:jte,var_info%dim_val(3)) )
    725. 

  725.             END IF
    726. 

  726.             READ (13) (((dum3d(i,j,k),i=ids,ide-1),j=jds,jde-1),k=1,var_info%dim_val(3))
    727. 

  727.             do k=1,var_info%dim_val(3)
    728. 

  728.             do j=jts,JMAX
    729. 

  729.             do i=its,IMAX
    730. 

  730.               soil_top_cat_input(i,j,k)=dum3d(i,j,k)
    731. 

  731.             enddo
    732. 

  732.             enddo
    733. 

  733.             enddo
    734. 

  734.          ELSE IF ( var_info%name(1:8) .EQ. 'SOILCBOT' ) THEN
    735. 

  735.             IF ( ( first_time_in ) .AND. ( .NOT. ALLOCATED ( soil_bot_cat_input) ) ) THEN
    736. 

  736.                ALLOCATE (soil_bot_cat_input(its:ite,jts:jte,var_info%dim_val(3)) )
    737. 

  737.             END IF
    738. 

  738.             READ (13) (((dum3d(i,j,k),i=ids,ide-1),j=jds,jde-1),k=1,var_info%dim_val(3))
    739. 

  739.             do k=1,var_info%dim_val(3)
    740. 

  740.             do j=jts,JMAX
    741. 

  741.             do i=its,IMAX
    742. 

  742.               soil_bot_cat_input(i,j,k)=dum3d(i,j,k)
    743. 

  743.             enddo
    744. 

  744.             enddo
    745. 

  745.             enddo
    746. 

  746. 

  747.          !  2D dry pressure minus ptop.
    748. 

  748. 

  749.          ELSE IF ( var_info%name(1:8) .EQ. 'PD      ' ) THEN
    750. 

  750.             READ (13) dum2d
    751. 

  751.             do j=jts,JMAX
    752. 

  752.             do i=its,IMAX
    753. 

  753.               grid%pd(i,j)=dum2d(i,j)
    754. 

  754.             enddo
    755. 

  755.             enddo
    756. 

  756.          ELSE IF ( var_info%name(1:8) .EQ. 'PSFC    ' ) THEN
    757. 

  757.             READ (13) dum2d
    758. 

  758.             do j=jts,JMAX
    759. 

  759.             do i=its,IMAX
    760. 

  760.               psfc_in(i,j)=dum2d(i,j)
    761. 

  761.             enddo
    762. 

  762.             enddo
    763. 

  763.          ELSE IF ( var_info%name(1:8) .EQ. 'PMSL    ' ) THEN
    764. 

  764.             READ (13) dum2d
    765. 

  765.             do j=jts,JMAX
    766. 

  766.             do i=its,IMAX
    767. 

  767.               pmsl(i,j)=dum2d(i,j)
    768. 

  768.             enddo
    769. 

  769.             enddo
    770. 

  770.          ELSE IF ( var_info%name(1:8) .EQ. 'PDTOP   ' ) THEN
    771. 

  771.             READ (13) grid%pdtop
    772. 

  772. 

  773.          ELSE IF ( var_info%name(1:8) .EQ. 'PT      ' ) THEN
    774. 

  774.             READ (13) grid%pt
    775. 

  775. 

  776.          !  2D surface fields.
    777. 

  777. 

  778.         ELSE IF ( var_info%name(1:8) .eq. 'GLAT    ' ) THEN
    779. 

  779.             READ (13) dum2d
    780. 

  780.             do j=jts,JMAX
    781. 

  781.             do i=its,IMAX
    782. 

  782.               grid%glat(i,j)=dum2d(i,j)
    783. 

  783.             enddo
    784. 

  784.             enddo
    785. 

  785.         ELSE IF ( var_info%name(1:8) .eq. 'GLON    ' ) THEN
    786. 

  786.             READ (13) dum2d
    787. 

  787.             do j=jts,JMAX
    788. 

  788.             do i=its,IMAX
    789. 

  789.               grid%glon(i,j)=dum2d(i,j)
    790. 

  790.             enddo
    791. 

  791.             enddo
    792. 

  792.         ELSE IF ( var_info%name(1:8) .eq. 'LAT_V   ' ) THEN
    793. 

  793.             READ (13) dum2d
    794. 

  794.             do j=jts,JMAX
    795. 

  795.             do i=its,IMAX
    796. 

  796.               lat_wind(i,j)=dum2d(i,j)
    797. 

  797.             enddo
    798. 

  798.             enddo
    799. 

  799.         ELSE IF ( var_info%name(1:8) .eq. 'LON_V   ' ) THEN
    800. 

  800.             READ (13) dum2d
    801. 

  801.             do j=jts,JMAX
    802. 

  802.             do i=its,IMAX
    803. 

  803.               lon_wind(i,j)=dum2d(i,j)
    804. 

  804.             enddo
    805. 

  805.             enddo
    806. 

  806. 

  807.          ELSE IF ( var_info%name(1:8) .EQ. 'ST000010' ) THEN
    808. 

  808.             READ (13) dum2d
    809. 

  809.             do j=jts,JMAX
    810. 

  810.             do i=its,IMAX
    811. 

  811.               grid%st000010(i,j)=dum2d(i,j)
    812. 

  812.             enddo
    813. 

  813.             enddo
    814. 

  814.             flag_st000010 = 1
    815. 

  815.             num_st_levels_input = num_st_levels_input + 1
    816. 

  816.             st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
    817. 

  817.             do j=jts,JMAX
    818. 

  818.             do i=its,IMAX
    819. 

  819.               st_inputx(I,J,num_st_levels_input + 1) = grid%st000010(i,j)
    820. 

  820.             enddo
    821. 

  821.             enddo
    822. 

  822. 

  823.          ELSE IF ( var_info%name(1:8) .EQ. 'ST010040' ) THEN
    824. 

  824.             READ (13) dum2d
    825. 

  825.             do j=jts,JMAX
    826. 

  826.             do i=its,IMAX
    827. 

  827.               grid%st010040(i,j)=dum2d(i,j)
    828. 

  828.             enddo
    829. 

  829.             enddo
    830. 

  830.             flag_st010040 = 1
    831. 

  831.             num_st_levels_input = num_st_levels_input + 1
    832. 

  832.             st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
    833. 

  833.             do j=jts,JMAX
    834. 

  834.             do i=its,IMAX
    835. 

  835.               st_inputx(I,J,num_st_levels_input + 1) = grid%st010040(i,j)
    836. 

  836.             enddo
    837. 

  837.             enddo
    838. 

  838. 

  839.          ELSE IF ( var_info%name(1:8) .EQ. 'ST040100' ) THEN
    840. 

  840.             READ (13) dum2d
    841. 

  841.             do j=jts,JMAX
    842. 

  842.             do i=its,IMAX
    843. 

  843.               grid%st040100(i,j)=dum2d(i,j)
    844. 

  844.             enddo
    845. 

  845.             enddo
    846. 

  846.             flag_st040100 = 1
    847. 

  847.             num_st_levels_input = num_st_levels_input + 1
    848. 

  848.             st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
    849. 

  849.             do j=jts,JMAX
    850. 

  850.             do i=its,IMAX
    851. 

  851.               st_inputx(I,J,num_st_levels_input + 1) = grid%st040100(i,j)
    852. 

  852.             enddo
    853. 

  853.             enddo
    854. 

  854. 

  855.          ELSE IF ( var_info%name(1:8) .EQ. 'ST100200' ) THEN
    856. 

  856.             READ (13) dum2d
    857. 

  857.             do j=jts,JMAX
    858. 

  858.             do i=its,IMAX
    859. 

  859.               grid%st100200(i,j)=dum2d(i,j)
    860. 

  860.             enddo
    861. 

  861.             enddo
    862. 

  862.             flag_st100200 = 1
    863. 

  863.             num_st_levels_input = num_st_levels_input + 1
    864. 

  864.             st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
    865. 

  865.             do j=jts,JMAX
    866. 

  866.             do i=its,IMAX
    867. 

  867.               st_inputx(I,J,num_st_levels_input + 1) = grid%st100200(i,j)
    868. 

  868.             enddo
    869. 

  869.             enddo
    870. 

  870. 

  871.          ELSE IF ( var_info%name(1:8) .EQ. 'ST010200' ) THEN
    872. 

  872.             READ (13) dum2d
    873. 

  873.             do j=jts,JMAX
    874. 

  874.             do i=its,IMAX
    875. 

  875.               grid%st010200(i,j)=dum2d(i,j)
    876. 

  876.             enddo
    877. 

  877.             enddo
    878. 

  878.             flag_st010200 = 1
    879. 

  879.             num_st_levels_input = num_st_levels_input + 1
    880. 

  880.             st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
    881. 

  881.             do j=jts,JMAX
    882. 

  882.             do i=its,IMAX
    883. 

  883.               st_inputx(I,J,num_st_levels_input + 1) = grid%st010200(i,j)
    884. 

  884.             enddo
    885. 

  885.             enddo
    886. 

  886. 

  887.         ELSE IF ( var_info%name(1:8) .EQ. 'SM000010' ) THEN
    888. 

  888.             READ (13) dum2d
    889. 

  889.             do j=jts,JMAX
    890. 

  890.             do i=its,IMAX
    891. 

  891.               grid%sm000010(i,j)=dum2d(i,j)
    892. 

  892.             enddo
    893. 

  893.             enddo
    894. 

  894.             flag_sm000010 = 1
    895. 

  895.             num_sm_levels_input = num_sm_levels_input + 1
    896. 

  896.             sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
    897. 

  897.             do j=jts,JMAX
    898. 

  898.             do i=its,IMAX
    899. 

  899.               sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm000010(i,j)
    900. 

  900.             enddo
    901. 

  901.             enddo
    902. 

  902. 

  903.          ELSE IF ( var_info%name(1:8) .EQ. 'SM010040' ) THEN
    904. 

  904.             READ (13) dum2d
    905. 

  905.             do j=jts,JMAX
    906. 

  906.             do i=its,IMAX
    907. 

  907.               grid%sm010040(i,j)=dum2d(i,j)
    908. 

  908.             enddo
    909. 

  909.             enddo
    910. 

  910.             flag_sm010040 = 1
    911. 

  911.             num_sm_levels_input = num_sm_levels_input + 1
    912. 

  912.             sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
    913. 

  913.             do j=jts,JMAX
    914. 

  914.             do i=its,IMAX
    915. 

  915.               sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm010040(i,j)
    916. 

  916.             enddo
    917. 

  917.             enddo
    918. 

  918. 

  919.          ELSE IF ( var_info%name(1:8) .EQ. 'SM040100' ) THEN
    920. 

  920.             READ (13) dum2d
    921. 

  921.             do j=jts,JMAX
    922. 

  922.             do i=its,IMAX
    923. 

  923.               grid%sm040100(i,j)=dum2d(i,j)
    924. 

  924.             enddo
    925. 

  925.             enddo
    926. 

  926.             flag_sm040100 = 1
    927. 

  927.             num_sm_levels_input = num_sm_levels_input + 1
    928. 

  928.             sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
    929. 

  929.             do j=jts,JMAX
    930. 

  930.             do i=its,IMAX
    931. 

  931.               sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm040100(i,j)
    932. 

  932.             enddo
    933. 

  933.             enddo
    934. 

  934. 

  935.          ELSE IF ( var_info%name(1:8) .EQ. 'SM100200' ) THEN
    936. 

  936.             READ (13) dum2d
    937. 

  937.             do j=jts,JMAX
    938. 

  938.             do i=its,IMAX
    939. 

  939.               grid%sm100200(i,j)=dum2d(i,j)
    940. 

  940.             enddo
    941. 

  941.             enddo
    942. 

  942.             flag_sm100200 = 1
    943. 

  943.             num_sm_levels_input = num_sm_levels_input + 1
    944. 

  944.             sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
    945. 

  945.             do j=jts,JMAX
    946. 

  946.             do i=its,IMAX
    947. 

  947.               sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm100200(i,j)
    948. 

  948.             enddo
    949. 

  949.             enddo
    950. 

  950. 

  951.          ELSE IF ( var_info%name(1:8) .EQ. 'SM010200' ) THEN
    952. 

  952.             READ (13) dum2d
    953. 

  953.             do j=jts,JMAX
    954. 

  954.             do i=its,IMAX
    955. 

  955.               grid%sm010200(i,j)=dum2d(i,j)
    956. 

  956.             enddo
    957. 

  957.             enddo
    958. 

  958.             flag_sm010200 = 1
    959. 

  959.             num_sm_levels_input = num_sm_levels_input + 1
    960. 

  960.             sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
    961. 

  961.             do j=jts,JMAX
    962. 

  962.             do i=its,IMAX
    963. 

  963.                sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm010200(i,j)
    964. 

  964.             enddo
    965. 

  965.             enddo
    966. 

  966. 

  967.          ELSE IF ( var_info%name(1:8) .EQ. 'SOILT010' ) THEN
    968. 

  968.             READ (13) dum2d
    969. 

  969.             do j=jts,JMAX
    970. 

  970.             do i=its,IMAX
    971. 

  971.               soilt010_input(i,j)=dum2d(i,j)
    972. 

  972.             enddo
    973. 

  973.             enddo
    974. 

  974.             flag_soilt010 = 1
    975. 

  975.             num_st_levels_input = num_st_levels_input + 1
    976. 

  976.             st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
    977. 

  977. !mp            st_inputx(:,:,num_st_levels_input + 1) = soilt010_input
    978. 

  978.             do j=jts,JMAX
    979. 

  979.             do i=its,IMAX
    980. 

  980.               st_inputx(I,J,num_st_levels_input + 1) = soilt010_input(I,J)
    981. 

  981.             enddo
    982. 

  982.             enddo
    983. 

  983.             write(6,*) 'num_st_levels_input=',num_st_levels_input
    984. 

  984.          ELSE IF ( var_info%name(1:8) .EQ. 'SOILT040' ) THEN
    985. 

  985.             READ (13) dum2d
    986. 

  986.             do j=jts,JMAX
    987. 

  987.             do i=its,IMAX
    988. 

  988.               soilt040_input(i,j)=dum2d(i,j)
    989. 

  989.             enddo
    990. 

  990.             enddo
    991. 

  991.             flag_soilt040 = 1
    992. 

  992.             num_st_levels_input = num_st_levels_input + 1
    993. 

  993.             st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
    994. 

  994. !mp            st_inputx(:,:,num_st_levels_input + 1) = soilt040_input
    995. 

  995.             do j=jts,JMAX
    996. 

  996.             do i=its,IMAX
    997. 

  997.               st_inputx(I,J,num_st_levels_input + 1) = soilt040_input(I,J)
    998. 

  998.             enddo
    999. 

  999.             enddo
    1000. 

  1000.             write(6,*) 'num_st_levels_input=',num_st_levels_input
    1001. 

  1001.          ELSE IF ( var_info%name(1:8) .EQ. 'SOILT100' ) THEN
    1002. 

  1002.             READ (13) dum2d
    1003. 

  1003.             do j=jts,JMAX
    1004. 

  1004.             do i=its,IMAX
    1005. 

  1005.               soilt100_input(i,j)=dum2d(i,j)
    1006. 

  1006.             enddo
    1007. 

  1007.             enddo
    1008. 

  1008.             flag_soilt100 = 1
    1009. 

  1009.             num_st_levels_input = num_st_levels_input + 1
    1010. 

  1010.             st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
    1011. 

  1011. !mp            st_inputx(:,:,num_st_levels_input + 1) = soilt100_input
    1012. 

  1012.             do j=jts,JMAX
    1013. 

  1013.             do i=its,IMAX
    1014. 

  1014.               st_inputx(I,J,num_st_levels_input + 1) = soilt100_input(I,J)
    1015. 

  1015.             enddo
    1016. 

  1016.             enddo
    1017. 

  1017.             write(6,*) 'num_st_levels_input=',num_st_levels_input
    1018. 

  1018.         ELSE IF ( var_info%name(1:8) .EQ. 'SOILT200' ) THEN
    1019. 

  1019.             READ (13) dum2d
    1020. 

  1020.             do j=jts,JMAX
    1021. 

  1021.             do i=its,IMAX
    1022. 

  1022.               soilt200_input(i,j)=dum2d(i,j)
    1023. 

  1023.             enddo
    1024. 

  1024.             enddo
    1025. 

  1025.             flag_soilt200 = 1
    1026. 

  1026.             num_st_levels_input = num_st_levels_input + 1
    1027. 

  1027.             st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
    1028. 

  1028. !mp            st_inputx(:,:,num_st_levels_input + 1) = soilt200_input
    1029. 

  1029.             do j=jts,JMAX
    1030. 

  1030.             do i=its,IMAX
    1031. 

  1031.               st_inputx(I,J,num_st_levels_input + 1) = soilt200_input(I,J)
    1032. 

  1032.             enddo
    1033. 

  1033.             enddo
    1034. 

  1034.             write(6,*) 'num_st_levels_input=',num_st_levels_input
    1035. 

  1035.          ELSE IF ( var_info%name(1:8) .EQ. 'SOILM010' ) THEN
    1036. 

  1036.             READ (13) dum2d
    1037. 

  1037.             do j=jts,JMAX
    1038. 

  1038.             do i=its,IMAX
    1039. 

  1039.               soilm010_input(i,j)=dum2d(i,j)
    1040. 

  1040.             enddo
    1041. 

  1041.             enddo
    1042. 

  1042.             flag_soilm010 = 1
    1043. 

  1043.             num_sm_levels_input = num_sm_levels_input + 1
    1044. 

  1044.             sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
    1045. 

  1045. !mp            sm_inputx(:,:,num_sm_levels_input + 1) = soilm010_input
    1046. 

  1046.             do j=jts,JMAX
    1047. 

  1047.             do i=its,IMAX
    1048. 

  1048.               sm_inputx(I,J,num_sm_levels_input + 1) = soilm010_input(I,J)
    1049. 

  1049.             enddo
    1050. 

  1050.             enddo
    1051. 

  1051. 

  1052.          ELSE IF ( var_info%name(1:8) .EQ. 'SOILM040' ) THEN
    1053. 

  1053.             READ (13) dum2d
    1054. 

  1054.             do j=jts,JMAX
    1055. 

  1055.             do i=its,IMAX
    1056. 

  1056.               soilm040_input(i,j)=dum2d(i,j)
    1057. 

  1057.             enddo
    1058. 

  1058.             enddo
    1059. 

  1059.             flag_soilm040 = 1
    1060. 

  1060.             num_sm_levels_input = num_sm_levels_input + 1
    1061. 

  1061.             sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
    1062. 

  1062. !mp            sm_inputx(:,:,num_sm_levels_input + 1) = soilm040_input
    1063. 

  1063.             do j=jts,JMAX
    1064. 

  1064.             do i=its,IMAX
    1065. 

  1065.               sm_inputx(I,J,num_sm_levels_input + 1) = soilm040_input(I,J)
    1066. 

  1066.             enddo
    1067. 

  1067.             enddo
    1068. 

  1068.          ELSE IF ( var_info%name(1:8) .EQ. 'SOILM100' ) THEN
    1069. 

  1069.             READ (13) dum2d
    1070. 

  1070.             do j=jts,JMAX
    1071. 

  1071.             do i=its,IMAX
    1072. 

  1072.               soilm100_input(i,j)=dum2d(i,j)
    1073. 

  1073.             enddo
    1074. 

  1074.             enddo
    1075. 

  1075.             flag_soilm100 = 1
    1076. 

  1076.             num_sm_levels_input = num_sm_levels_input + 1
    1077. 

  1077.             sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
    1078. 

  1078. !mp            sm_inputx(:,:,num_sm_levels_input + 1) = soilm100_input
    1079. 

  1079.             do j=jts,JMAX
    1080. 

  1080.             do i=its,IMAX
    1081. 

  1081.               sm_inputx(I,J,num_sm_levels_input + 1) = soilm100_input(I,J)
    1082. 

  1082.             enddo
    1083. 

  1083.             enddo
    1084. 

  1084. 

  1085.          ELSE IF ( var_info%name(1:8) .EQ. 'SOILM200' ) THEN
    1086. 

  1086.             READ (13) dum2d
    1087. 

  1087.             do j=jts,JMAX
    1088. 

  1088.             do i=its,IMAX
    1089. 

  1089.               soilm200_input(i,j)=dum2d(i,j)
    1090. 

  1090.             enddo
    1091. 

  1091.             enddo
    1092. 

  1092.             flag_soilm200 = 1
    1093. 

  1093.             num_sm_levels_input = num_sm_levels_input + 1
    1094. 

  1094.             sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
    1095. 

  1095. !mp            sm_inputx(:,:,num_sm_levels_input + 1) = soilm200_input
    1096. 

  1096.             do j=jts,JMAX
    1097. 

  1097.             do i=its,IMAX
    1098. 

  1098.               sm_inputx(I,J,num_sm_levels_input + 1) = soilm200_input(I,J)
    1099. 

  1099.             enddo
    1100. 

  1100.             enddo
    1101. 

  1101. 

  1102.          ELSE IF ( var_info%name(1:8) .EQ. 'SEAICE  ' ) THEN
    1103. 

  1103.             READ (13) dum2d
    1104. 

  1104.             do j=jts,JMAX
    1105. 

  1105.             do i=its,IMAX
    1106. 

  1106.               grid%xice(i,j)=dum2d(i,j)
    1107. 

  1107.             enddo
    1108. 

  1108.             enddo
    1109. 

  1109.          ELSE IF ( var_info%name(1:8) .EQ. 'WEASD   ' ) THEN
    1110. 

  1110.             READ (13) dum2d
    1111. 

  1111.             do j=jts,JMAX
    1112. 

  1112.             do i=its,IMAX
    1113. 

  1113.               grid%weasd(i,j)=dum2d(i,j)
    1114. 

  1114.             enddo
    1115. 

  1115.             enddo
    1116. 

  1116.          ELSE IF ( var_info%name(1:8) .EQ. 'CANWAT  ' ) THEN
    1117. 

  1117.             READ (13) dum2d
    1118. 

  1118.             do j=jts,JMAX
    1119. 

  1119.             do i=its,IMAX
    1120. 

  1120.               grid%canwat(i,j)=dum2d(i,j)
    1121. 

  1121.             enddo
    1122. 

  1122.             enddo
    1123. 

  1123.          ELSE IF ( var_info%name(1:8) .EQ. 'LANDMASK' ) THEN
    1124. 

  1124.             READ (13) dum2d
    1125. 

  1125.             do j=jts,JMAX
    1126. 

  1126.             do i=its,IMAX
    1127. 

  1127.               grid%landmask(i,j)=dum2d(i,j)
    1128. 

  1128.             enddo
    1129. 

  1129.             enddo
    1130. 

  1130.          ELSE IF ( var_info%name(1:8) .EQ. 'SKINTEMP' ) THEN
    1131. 

  1131.             READ (13) dum2d
    1132. 

  1132.             do j=jts,JMAX
    1133. 

  1133.             do i=its,IMAX
    1134. 

  1134.               grid%nmm_tsk(i,j)=dum2d(i,j)
    1135. 

  1135.             enddo
    1136. 

  1136.             enddo
    1137. 

  1137.          ELSE IF ( var_info%name(1:8) .EQ. 'TGROUND ' ) THEN
    1138. 

  1138.             READ (13) dum2d
    1139. 

  1139.             do j=jts,JMAX
    1140. 

  1140.             do i=its,IMAX
    1141. 

  1141.              grid%tg(i,j)=dum2d(i,j)
    1142. 

  1142.             enddo
    1143. 

  1143.             enddo
    1144. 

  1144.          ELSE IF ( var_info%name(1:8) .EQ. 'SOILTB  ' ) THEN
    1145. 

  1145.             READ (13) dum2d
    1146. 

  1146.             do j=jts,JMAX
    1147. 

  1147.             do i=its,IMAX
    1148. 

  1148.              grid%soiltb(i,j)=dum2d(i,j)
    1149. 

  1149.             enddo
    1150. 

  1150.             enddo
    1151. 

  1151.          ELSE IF ( var_info%name(1:8) .EQ. 'SST     ' ) THEN
    1152. 

  1152.             READ (13) dum2d
    1153. 

  1153.             do j=jts,JMAX
    1154. 

  1154.             do i=its,IMAX
    1155. 

  1155.                grid%sst(i,j)=dum2d(i,j)
    1156. 

  1156.             enddo
    1157. 

  1157.             enddo
    1158. 

  1158.             flag_sst = 1
    1159. 

  1159.          ELSE IF ( var_info%name(1:8) .EQ. 'GREENFRC' ) THEN
    1160. 

  1160.             READ (13) dum2d
    1161. 

  1161.             do j=jts,JMAX
    1162. 

  1162.             do i=its,IMAX
    1163. 

  1163.               grid%vegfrc(i,j)=dum2d(i,j)
    1164. 

  1164.             enddo
    1165. 

  1165.             enddo
    1166. 

  1166.          ELSE IF ( var_info%name(1:8) .EQ. 'ISLOPE  ' ) THEN
    1167. 

  1167.             READ (13) dum2d
    1168. 

  1168.             do j=jts,JMAX
    1169. 

  1169.             do i=its,IMAX
    1170. 

  1170.               grid%islope(i,j)=nint(dum2d(i,j))
    1171. 

  1171.             enddo
    1172. 

  1172.             enddo
    1173. 

  1173.          ELSE IF ( var_info%name(1:8) .EQ. 'GREENMAX' ) THEN
    1174. 

  1174.             READ (13) dum2d
    1175. 

  1175.             do j=jts,JMAX
    1176. 

  1176.             do i=its,IMAX
    1177. 

  1177.               grid%greenmax(i,j)=dum2d(i,j)
    1178. 

  1178.             enddo
    1179. 

  1179.             enddo
    1180. 

  1180.          ELSE IF ( var_info%name(1:8) .EQ. 'GREENMIN' ) THEN
    1181. 

  1181.             READ (13) dum2d
    1182. 

  1182.             do j=jts,JMAX
    1183. 

  1183.             do i=its,IMAX
    1184. 

  1184.                grid%greenmin(i,j)=dum2d(i,j)
    1185. 

  1185.             enddo
    1186. 

  1186.             enddo
    1187. 

  1187.          ELSE IF ( var_info%name(1:8) .EQ. 'FIS     ' ) THEN
    1188. 

  1188.             READ (13) dum2d
    1189. 

  1189.             do j=jts,JMAX
    1190. 

  1190.             do i=its,IMAX
    1191. 

  1191.               grid%fis(i,j)=dum2d(i,j)
    1192. 

  1192.             enddo
    1193. 

  1193.             enddo
    1194. 

  1194.         ELSE IF ( var_info%name(1:8) .EQ. 'Z0      ' ) THEN
    1195. 

  1195. !         ELSE IF ( var_info%name(1:8) .EQ. 'STDEV   ' ) THEN
    1196. 

  1196.             READ (13) dum2d
    1197. 

  1197.             do j=jts,JMAX
    1198. 

  1198.             do i=its,IMAX
    1199. 

  1199.               grid%z0(i,j)=dum2d(i,j)
    1200. 

  1200.             enddo
    1201. 

  1201.             enddo
    1202. 

  1202.          ELSE IF ( var_info%name(1:8) .EQ. 'CMC     ' ) THEN
    1203. 

  1203.             READ (13) dum2d
    1204. 

  1204.             do j=jts,JMAX
    1205. 

  1205.             do i=its,IMAX
    1206. 

  1206.               grid%cmc(i,j)=dum2d(i,j)
    1207. 

  1207.             enddo
    1208. 

  1208.             enddo
    1209. 

  1209.          ELSE IF ( var_info%name(1:8) .EQ. 'HTM     ' ) THEN
    1210. 

  1210.             READ (13) dum3d
    1211. 

  1211.             do k=kts,kte-1
    1212. 

  1212.             do j=jts,JMAX
    1213. 

  1213.             do i=its,IMAX
    1214. 

  1214.               htm_in(i,j,k)=dum3d(i,j,k)
    1215. 

  1215.             enddo
    1216. 

  1216.             enddo
    1217. 

  1217.             enddo
    1218. 

  1218.          ELSE IF ( var_info%name(1:8) .EQ. 'VTM     ' ) THEN
    1219. 

  1219.             READ (13) dum3d
    1220. 

  1220.             do k=kts,kte-1
    1221. 

  1221.             do j=jts,JMAX
    1222. 

  1222.             do i=its,IMAX
    1223. 

  1223.               vtm_in(i,j,k)=dum3d(i,j,k)
    1224. 

  1224.             enddo
    1225. 

  1225.             enddo
    1226. 

  1226.             enddo
    1227. 

  1227.          ELSE IF ( var_info%name(1:8) .EQ. 'SM      ' ) THEN
    1228. 

  1228.             READ (13) dum2d
    1229. 

  1229.             do j=jts,JMAX
    1230. 

  1230.             do i=its,IMAX
    1231. 

  1231.               grid%sm(i,j)=dum2d(i,j)
    1232. 

  1232.             enddo
    1233. 

  1233.             enddo
    1234. 

  1234.          ELSE IF ( var_info%name(1:8) .EQ. 'ALBASE  ' ) THEN
    1235. 

  1235.             READ (13) dum2d
    1236. 

  1236.             do j=jts,JMAX
    1237. 

  1237.             do i=its,IMAX
    1238. 

  1238.               grid%albase(i,j)=dum2d(i,j)
    1239. 

  1239.             enddo
    1240. 

  1240.             enddo
    1241. 

  1241.          ELSE IF ( var_info%name(1:8) .EQ. 'MXSNAL  ' ) THEN
    1242. 

  1242.             READ (13) dum2d
    1243. 

  1243.             do j=jts,JMAX
    1244. 

  1244.             do i=its,IMAX
    1245. 

  1245.               grid%mxsnal(i,j)=dum2d(i,j)
    1246. 

  1246.             enddo
    1247. 

  1247.             enddo
    1248. 

  1248. 

  1249.          !  1D vertical coordinate.
    1250. 

  1250. 

  1251.           ELSE IF ( var_info%name(1:8) .EQ. 'DETA    ' ) THEN
    1252. 

  1252.              READ(13) DETA_in
    1253. 

  1253.           ELSE IF ( var_info%name(1:8) .EQ. 'DETA1   ' ) THEN
    1254. 

  1254.              READ(13) DETA1_in
    1255. 

  1255.           ELSE IF ( var_info%name(1:8) .EQ. 'DETA2   ' ) THEN
    1256. 

  1256.              READ(13) DETA2_in
    1257. 

  1257.           ELSE IF ( var_info%name(1:8) .EQ. 'ETAX    ' ) THEN
    1258. 

  1258.              READ(13) ETAX_in
    1259. 

  1259.           ELSE IF ( var_info%name(1:8) .EQ. 'ETA1    ' ) THEN
    1260. 

  1260.              READ(13) ETA1_in
    1261. 

  1261.           ELSE IF ( var_info%name(1:8) .EQ. 'ETA2    ' ) THEN
    1262. 

  1262.              READ(13) ETA2_in
    1263. 

  1263.           ELSE IF ( var_info%name(1:8) .EQ. 'AETA    ' ) THEN
    1264. 

  1264.              READ(13) AETA_in
    1265. 

  1265.           ELSE IF ( var_info%name(1:8) .EQ. 'AETA1   ' ) THEN
    1266. 

  1266.              READ(13) AETA1_in
    1267. 

  1267.           ELSE IF ( var_info%name(1:8) .EQ. 'AETA2   ' ) THEN
    1268. 

  1268.              READ(13) AETA2_in
    1269. 

  1269.           ELSE IF ( var_info%name(1:8) .EQ. 'DFL     ' ) THEN
    1270. 

  1270.              READ(13) DFL_in
    1271. 

  1271. 

  1272. !         ELSE IF ( var_info%name(1:8) .EQ. 'ETAPHALF' ) THEN
    1273. 

  1273. !            READ (13) etahalf
    1274. 

  1274. !         ELSE IF ( var_info%name(1:8) .EQ. 'ETAPFULL' ) THEN
    1275. 

  1275. !            READ (13) etafull
    1276. 

  1276. 

  1277.          !  wrong input data.
    1278. 

  1278. 

  1279.          ELSE IF ( var_info%name(1:8) .EQ. 'ZETAFULL' ) THEN
    1280. 

  1280.             PRINT '(A)','Oops, you put in the height data.'
    1281. 

  1281.             STOP 'this_is_mass_not_height'
    1282. 

  1282.  
    1283. 

  1283. 

  1284.          !  Stuff that we do not want or need is just skipped over.
    1285. 

  1285. 

  1286.          ELSE
    1287. 

  1287. print *,'------------------> skipping ', var_info%name(1:8)
    1288. 

  1288.             READ (13) dummy
    1289. 

  1289.          END IF
    1290. 

  1290. 

  1291.       END DO read_all_the_data
    1292. 

  1292. 

  1293.       CLOSE (13)
    1294. 

  1294. 

  1295.       first_time_in = .FALSE.
    1296. 

  1296. 

  1297. !new
    1298. 

  1298.         sw_inputx=0.
    1299. 

  1299. !new
    1300. 

  1300. 

  1301.       do k=kts,kte-1
    1302. 

  1302.       do j=jts,JMAX
    1303. 

  1303.       do i=its,IMAX
    1304. 

  1304.         grid%U(I,J,K)=U_input(I,J,K)
    1305. 

  1305.         grid%V(I,J,K)=V_input(I,J,K)
    1306. 

  1306.         grid%T(I,J,K)=T_input(I,J,K)
    1307. 

  1307.         grid%Q(I,J,K)=Q_input(I,J,K)
    1308. 

  1308.       enddo
    1309. 

  1309.       enddo
    1310. 

  1310.       enddo
    1311. 

  1311. 

  1312. !      write(0,*) 'size sw_input: ', size(sw_input,dim=1),size(sw_input,dim=2),size(sw_input,dim=3)
    1313. 

  1313. !      write(0,*) 'size sw_inputx: ', size(sw_inputx,dim=1),size(sw_inputx,dim=2),size(sw_inputx,dim=3)
    1314. 

  1314.       sw_input=0.
    1315. 

  1315. 

  1316. !        write(0,*) 'maxval st_inputx(1): ', maxval(st_input(:,:,1))
    1317. 

  1317. !        write(0,*) 'maxval st_inputx(2): ', maxval(st_input(:,:,2))
    1318. 

  1318. !        write(0,*) 'maxval st_inputx(3): ', maxval(st_input(:,:,3))
    1319. 

  1319. !        write(0,*) 'maxval st_inputx(4): ', maxval(st_input(:,:,4))
    1320. 

  1320. 

  1321. 

  1322.         do J=JTS,min(JDE-1,JTE)
    1323. 

  1323.          do K=1,num_st_levels_alloc
    1324. 

  1324.           do I=ITS,min(IDE-1,ITE)
    1325. 

  1325.              st_input(I,K,J)=st_inputx(I,J,K)
    1326. 

  1326.              sm_input(I,K,J)=sm_inputx(I,J,K)
    1327. 

  1327.              sw_input(I,K,J)=sw_inputx(I,J,K)
    1328. 

  1328.           enddo
    1329. 

  1329.          enddo
    1330. 

  1330.         enddo
    1331. 

  1331. 

  1332. !        write(0,*) 'maxval st_input(1): ', maxval(st_input(:,1,:))
    1333. 

  1333. !        write(0,*) 'maxval st_input(2): ', maxval(st_input(:,2,:))
    1334. 

  1334. !        write(0,*) 'maxval st_input(3): ', maxval(st_input(:,3,:))
    1335. 

  1335. !        write(0,*) 'maxval st_input(4): ', maxval(st_input(:,4,:))
    1336. 

  1336. 

  1337. 

  1338.          num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
    1339. 

  1339.          num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
    1340. 

  1340.          num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
    1341. 

  1341. 

  1342.         do J=JTS,min(JDE-1,JTE)
    1343. 

  1343.          do K=1,num_soil_top_cat
    1344. 

  1344.           do I=ITS,min(IDE-1,ITE)
    1345. 

  1345.           grid%SOILCTOP(I,K,J)=soil_top_cat_input(I,J,K)
    1346. 

  1346.           grid%SOILCTOP_gc(I,J,K)=soil_top_cat_input(I,J,K)
    1347. 

  1347.           enddo
    1348. 

  1348.          enddo
    1349. 

  1349.         enddo
    1350. 

  1350. 

  1351.         do J=JTS,min(JDE-1,JTE)
    1352. 

  1352.          do K=1,num_soil_bot_cat
    1353. 

  1353.           do I=ITS,min(IDE-1,ITE)
    1354. 

  1354.           grid%SOILCBOT(I,K,J)=soil_bot_cat_input(I,J,K)
    1355. 

  1355.           grid%SOILCBOT_gc(I,J,K)=soil_bot_cat_input(I,J,K)
    1356. 

  1356.           enddo
    1357. 

  1357.          enddo
    1358. 

  1358.         enddo
    1359. 

  1359. 

  1360.         do J=JTS,min(JDE-1,JTE)
    1361. 

  1361.          do K=1,num_veg_cat
    1362. 

  1362.           do I=ITS,min(IDE-1,ITE)
    1363. 

  1363.           grid%LANDUSEF(I,K,J)=landuse_frac_input(I,J,K)
    1364. 

  1364.           grid%LANDUSEF_gc(I,J,K)=landuse_frac_input(I,J,K)
    1365. 

  1365.           enddo
    1366. 

  1366.          enddo
    1367. 

  1367.         enddo
    1368. 

  1368. 

  1369. 

  1370.       do K=KDS,KDE
    1371. 

  1371.         grid%ETAX(K)=ETAX_in(KDE-K+1)
    1372. 

  1372.         grid%ETA1(K)=ETA1_in(KDE-K+1)
    1373. 

  1373.         grid%ETA2(K)=ETA2_in(KDE-K+1)
    1374. 

  1374.         grid%DFL(K)=DFL_in(KDE-K+1)
    1375. 

  1375.       enddo
    1376. 

  1376. 

  1377.       do K=KDS,KDE-1
    1378. 

  1378.         grid%DETA(K)=DETA_in(KDE-K)
    1379. 

  1379.         grid%DETA1(K)=DETA1_in(KDE-K)
    1380. 

  1380.         grid%DETA2(K)=DETA2_in(KDE-K)
    1381. 

  1381.         grid%AETA(K)=AETA_in(KDE-K)
    1382. 

  1382.         grid%AETA1(K)=AETA1_in(KDE-K)
    1383. 

  1383.         grid%AETA2(K)=AETA2_in(KDE-K)
    1384. 

  1384.       enddo
    1385. 

  1385. 

  1386.    END SUBROUTINE read_si
    1387. 

  1387. 

  1388. ! ------------------------------------------------------------
    1389. 

  1389. ! ------------------------------------------------------------
    1390. 

  1390. ! ------------------------------------------------------------
    1391. 

  1391. ! ------------------------------------------------------------
    1392. 

  1392. ! ------------------------------------------------------------
    1393. 

  1393. ! ------------------------------------------------------------
    1394. 

  1394. 

  1395.    SUBROUTINE read_wps ( grid, filename, file_date_string, num_metgrid_levels )
    1396. 

  1396. 

  1397.       USE module_soil_pre
    1398. 

  1398.       USE module_domain
    1399. 

  1399. 

  1400.       IMPLICIT NONE
    1401. 

  1401. 

  1402.       TYPE(domain) , INTENT(INOUT)  :: grid
    1403. 

  1403.       CHARACTER (LEN=19) , INTENT(IN) :: file_date_string
    1404. 

  1404.       CHARACTER (LEN=19)              :: VarName
    1405. 

  1405.       CHARACTER (LEN=150)             :: chartemp
    1406. 

  1406.       CHARACTER (LEN=256)             :: mminlu_loc, message
    1407. 

  1407.       CHARACTER (*) , INTENT(IN) :: filename
    1408. 

  1408. 

  1409.       INTEGER :: ids,ide,jds,jde,kds,kde           &
    1410. 

  1410.                 ,ims,ime,jms,jme,kms,kme           &
    1411. 

  1411.                 ,its,ite,jts,jte,kts,kte
    1412. 

  1412. 

  1413.       INTEGER :: i , j , k , loop, IMAX, JMAX
    1414. 

  1414.       INTEGER :: DATAHANDLE, num_metgrid_levels
    1415. 

  1415.       INTEGER :: Sysdepinfo, Status, N
    1416. 

  1416.       INTEGER :: istatus,ioutcount,iret,index,ierr
    1417. 

  1417. 

  1418.       integer :: nrecs,iunit, L,hor_size
    1419. 

  1419. 

  1420. !!
    1421. 

  1421.       character*132, allocatable,save :: datestr_all(:)
    1422. 

  1422.       character*132, allocatable,save :: varname_all(:)
    1423. 

  1423.       integer, allocatable,save       :: domainend_all(:,:)
    1424. 

  1424.       integer, allocatable,save       :: start_block(:)
    1425. 

  1425.       integer, allocatable,save       :: end_block(:)
    1426. 

  1426.       integer, allocatable,save       :: start_byte(:)
    1427. 

  1427.       integer, allocatable,save       :: end_byte(:)
    1428. 

  1428.       integer(kind=i_llong), allocatable,save           :: file_offset(:)
    1429. 

  1429. !!
    1430. 

  1430. 

  1431.       REAL :: dummy,tmp,garb
    1432. 

  1432.       REAL, ALLOCATABLE,save :: dumdata(:,:,:)
    1433. 

  1433. 

  1434.       CHARACTER (LEN= 8) :: dummy_char
    1435. 

  1435. 

  1436.       INTEGER :: ok , map_proj , ok_open, igarb
    1437. 

  1437.       REAL :: pt
    1438. 

  1438.       INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
    1439. 

  1439. 

  1440. #if defined(DM_PARALLEL) && !defined(STUBMPI)
    1441. 

  1441.       INCLUDE "mpif.h"
    1442. 

  1442. 

  1443.       SELECT CASE ( model_data_order )
    1444. 

  1444.          CASE ( DATA_ORDER_ZXY )
    1445. 

  1445.             kds = grid%sd31 ; kde = grid%ed31 ;
    1446. 

  1446.             ids = grid%sd32 ; ide = grid%ed32 ;
    1447. 

  1447.             jds = grid%sd33 ; jde = grid%ed33 ;
    1448. 

  1448. 

  1449.             kms = grid%sm31 ; kme = grid%em31 ;
    1450. 

  1450.             ims = grid%sm32 ; ime = grid%em32 ;
    1451. 

  1451.             jms = grid%sm33 ; jme = grid%em33 ;
    1452. 

  1452. 

  1453.             kts = grid%sp31 ; kte = grid%ep31 ; ! tile is entire patch
    1454. 

  1454.             its = grid%sp32 ; ite = grid%ep32 ; ! tile is entire patch
    1455. 

  1455.             jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
    1456. 

  1456. 

  1457.          CASE ( DATA_ORDER_XYZ )
    1458. 

  1458.             ids = grid%sd31 ; ide = grid%ed31 ;
    1459. 

  1459.             jds = grid%sd32 ; jde = grid%ed32 ;
    1460. 

  1460.             kds = grid%sd33 ; kde = grid%ed33 ;
    1461. 

  1461. 

  1462.             ims = grid%sm31 ; ime = grid%em31 ;
    1463. 

  1463.             jms = grid%sm32 ; jme = grid%em32 ;
    1464. 

  1464.             kms = grid%sm33 ; kme = grid%em33 ;
    1465. 

  1465. 

  1466.             its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
    1467. 

  1467.             jts = grid%sp32 ; jte = grid%ep32 ; ! tile is entire patch
    1468. 

  1468.             kts = grid%sp33 ; kte = grid%ep33 ; ! tile is entire patch
    1469. 

  1469. 

  1470.          CASE ( DATA_ORDER_XZY )
    1471. 

  1471.             ids = grid%sd31 ; ide = grid%ed31 ;
    1472. 

  1472.             kds = grid%sd32 ; kde = grid%ed32 ;
    1473. 

  1473.             jds = grid%sd33 ; jde = grid%ed33 ;
    1474. 

  1474. 

  1475.             ims = grid%sm31 ; ime = grid%em31 ;
    1476. 

  1476.             kms = grid%sm32 ; kme = grid%em32 ;
    1477. 

  1477.             jms = grid%sm33 ; jme = grid%em33 ;
    1478. 

  1478. 

  1479.             its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
    1480. 

  1480.             kts = grid%sp32 ; kte = grid%ep32 ; ! tile is entire patch
    1481. 

  1481.             jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
    1482. 

  1482. 

  1483.       END SELECT
    1484. 

  1484. 

  1485.       !  Initialize what soil temperature and moisture is available.
    1486. 

  1486. 

  1487. 

  1488.       flag_st000010 = 0
    1489. 

  1489.       flag_st010040 = 0
    1490. 

  1490.       flag_st040100 = 0
    1491. 

  1491.       flag_st100200 = 0
    1492. 

  1492.       flag_sm000010 = 0
    1493. 

  1493.       flag_sm010040 = 0
    1494. 

  1494.       flag_sm040100 = 0
    1495. 

  1495.       flag_sm100200 = 0
    1496. 

  1496.       flag_st010200 = 0
    1497. 

  1497.       flag_sm010200 = 0
    1498. 

  1498. 

  1499.       flag_soilt010 = 0
    1500. 

  1500.       flag_soilt040 = 0
    1501. 

  1501.       flag_soilt100 = 0
    1502. 

  1502.       flag_soilt200 = 0
    1503. 

  1503.       flag_soilm010 = 0
    1504. 

  1504.       flag_soilm040 = 0
    1505. 

  1505.       flag_soilm100 = 0
    1506. 

  1506.       flag_soilm200 = 0
    1507. 

  1507. 

  1508.       flag_sst      = 0
    1509. 

  1509.       flag_toposoil = 0
    1510. 

  1510. 

  1511.       !  How many soil levels have we found?  Well, right now, none.
    1512. 

  1512. 

  1513.       num_st_levels_input = 0
    1514. 

  1514.       num_sm_levels_input = 0
    1515. 

  1515.       st_levels_input = -1
    1516. 

  1516.       sm_levels_input = -1
    1517. 

  1517. 

  1518. 	mminlu_loc=''
    1519. 

  1519.         mminlu_loc(1:4)='USGS'
    1520. 

  1520. 

  1521.          CALL nl_set_mminlu ( grid%id, mminlu_loc)
    1522. 

  1522.          CALL nl_set_iswater (grid%id, 16 )
    1523. 

  1523.          CALL nl_set_isice (grid%id, 24 )
    1524. 

  1524.          CALL nl_set_islake (grid%id, -1)
    1525. 

  1525. 

  1526. 

  1527.       !  Get the space for the data if this is the first time here.
    1528. 

  1528. 

  1529.         IF (.NOT. ALLOCATED (pmsl)              ) ALLOCATE ( pmsl(its:ite,jts:jte) )
    1530. 

  1530.         IF (.NOT. ALLOCATED (psfc_in)           ) ALLOCATE ( psfc_in(its:ite,jts:jte) )
    1531. 

  1531.         IF (.NOT. ALLOCATED (st_inputx)) ALLOCATE (st_inputx(its:ite,jts:jte,num_st_levels_alloc))
    1532. 

  1532.         IF (.NOT. ALLOCATED (sm_inputx)) ALLOCATE (sm_inputx(its:ite,jts:jte,num_st_levels_alloc))
    1533. 

  1533.         IF (.NOT. ALLOCATED (sw_inputx)) ALLOCATE (sw_inputx(its:ite,jts:jte,num_st_levels_alloc))
    1534. 

  1534.         IF (.NOT. ALLOCATED (soilt010_input)    ) ALLOCATE ( soilt010_input(its:ite,jts:jte) )
    1535. 

  1535.         IF (.NOT. ALLOCATED (soilt040_input)    ) ALLOCATE ( soilt040_input(its:ite,jts:jte) )
    1536. 

  1536.         IF (.NOT. ALLOCATED (soilt100_input)    ) ALLOCATE ( soilt100_input(its:ite,jts:jte) )
    1537. 

  1537.         IF (.NOT. ALLOCATED (soilt200_input)    ) ALLOCATE ( soilt200_input(its:ite,jts:jte) )
    1538. 

  1538.         IF (.NOT. ALLOCATED (soilm010_input)    ) ALLOCATE ( soilm010_input(its:ite,jts:jte) )
    1539. 

  1539.         IF (.NOT. ALLOCATED (soilm040_input)    ) ALLOCATE ( soilm040_input(its:ite,jts:jte) )
    1540. 

  1540.         IF (.NOT. ALLOCATED (soilm100_input)    ) ALLOCATE ( soilm100_input(its:ite,jts:jte) )
    1541. 

  1541.         IF (.NOT. ALLOCATED (soilm200_input)    ) ALLOCATE ( soilm200_input(its:ite,jts:jte) )
    1542. 

  1542. 

  1543.         !  Local arrays
    1544. 

  1544. 

  1545. !!! MPI IO
    1546. 

  1546. 

  1547.       iunit=33
    1548. 

  1548.       call count_recs_wrf_binary_file(iunit, trim(fileName), nrecs)
    1549. 

  1549. 

  1550.       if (.NOT. ALLOCATED (datestr_all)) allocate (datestr_all(nrecs))
    1551. 

  1551.       if (.NOT. ALLOCATED (varname_all)) allocate (varname_all(nrecs))
    1552. 

  1552.       if (.NOT. ALLOCATED (domainend_all)) allocate (domainend_all(3,nrecs))
    1553. 

  1553.       if (.NOT. ALLOCATED (start_block)) allocate (start_block(nrecs))
    1554. 

  1554.       if (.NOT. ALLOCATED (end_block)) allocate (end_block(nrecs))
    1555. 

  1555.       if (.NOT. ALLOCATED (start_byte)) allocate (start_byte(nrecs))
    1556. 

  1556.       if (.NOT. ALLOCATED (end_byte)) allocate (end_byte(nrecs))
    1557. 

  1557.       if (.NOT. ALLOCATED (file_offset)) allocate (file_offset(nrecs))
    1558. 

  1558. 

  1559.       call inventory_wrf_binary_file(iunit, trim(filename), nrecs,  &
    1560. 

  1560.                       datestr_all,varname_all,domainend_all,   &
    1561. 

  1561.                       start_block,end_block,start_byte,end_byte,file_offset)
    1562. 

  1562. 

  1563.         do N=1,NRECS
    1564. 

  1564.          write(message,*) 'N,varname_all(N): ',N, varname_all(N)
    1565. 

  1565.          call wrf_debug(100,message)
    1566. 

  1566.         enddo
    1567. 

  1567. 

  1568.       call mpi_file_open(mpi_comm_world, trim(filename),     &
    1569. 

  1569.                          mpi_mode_rdonly,mpi_info_null, iunit, ierr)
    1570. 

  1570.       if (ierr /= 0) then
    1571. 

  1571.        call wrf_error_fatal("Error opening file with mpi io")
    1572. 

  1572.       end if
    1573. 

  1573. 

  1574.       VarName='CEN_LAT'
    1575. 

  1575.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    1576. 

  1576.       if (iret /= 0) then
    1577. 

  1577.         write(message,*) VarName, ' not found in file'
    1578. 

  1578.         call wrf_message(message)
    1579. 

  1579.       else
    1580. 

  1580. 

  1581.         call mpi_file_read_at(iunit,file_offset(index)+5*4,      &
    1582. 

  1582.                               garb,1,mpi_real4,                  &
    1583. 

  1583.                               mpi_status_ignore, ierr)
    1584. 

  1584. 

  1585.         if (ierr /= 0) then
    1586. 

  1586.           write(message,*) 'Error reading ', VarName,' using MPIIO'
    1587. 

  1587.           call wrf_message(message)
    1588. 

  1588.         else
    1589. 

  1589.           write(message,*) VarName, ' from MPIIO READ= ', garb
    1590. 

  1590.           call wrf_message(message)
    1591. 

  1591.           CALL nl_set_cen_lat ( grid%id , garb )
    1592. 

  1592.         end if
    1593. 

  1593.       end if
    1594. 

  1594. 

  1595.       VarName='CEN_LON'
    1596. 

  1596.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    1597. 

  1597.         call mpi_file_read_at(iunit,file_offset(index)+5*4,      &
    1598. 

  1598.                               garb,1,mpi_real4,                  &
    1599. 

  1599.                               mpi_status_ignore, ierr)
    1600. 

  1600.           CALL nl_set_cen_lon ( grid%id , garb )
    1601. 

  1601.           CALL nl_set_stand_lon ( grid%id , garb )
    1602. 

  1602. 

  1603.       VarName='TRUELAT1'
    1604. 

  1604.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    1605. 

  1605.         call mpi_file_read_at(iunit,file_offset(index)+5*4,      &
    1606. 

  1606.                               garb,1,mpi_real4,                  &
    1607. 

  1607.                               mpi_status_ignore, ierr)
    1608. 

  1608.           CALL nl_set_truelat1 ( grid%id , garb )
    1609. 

  1609. 

  1610.       VarName='TRUELAT2'
    1611. 

  1611.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    1612. 

  1612.         call mpi_file_read_at(iunit,file_offset(index)+5*4,      &
    1613. 

  1613.                               garb,1,mpi_real4,                  &
    1614. 

  1614.                               mpi_status_ignore, ierr)
    1615. 

  1615.           CALL nl_set_truelat2 ( grid%id , garb )
    1616. 

  1616. 

  1617.       VarName='MAP_PROJ'
    1618. 

  1618.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    1619. 

  1619.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    1620. 

  1620.                               igarb,1,mpi_integer4,             &
    1621. 

  1621.                               mpi_status_ignore, ierr)
    1622. 

  1622. 

  1623.           CALL  nl_set_map_proj( grid%id, igarb)
    1624. 

  1624. 

  1625.       VarName='FLAG_SNOWH'
    1626. 

  1626.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    1627. 

  1627.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    1628. 

  1628.                               igarb,1,mpi_integer4,             &
    1629. 

  1629.                               mpi_status_ignore, ierr)
    1630. 

  1630.         write(0,*) 'ierr, igarb for FLAG_SNOWH: ', ierr,igarb
    1631. 

  1631.         flag_snowh=igarb
    1632. 

  1632. 

  1633. 

  1634.     hor_size=(IDE-IDS)*(JDE-JDS)
    1635. 

  1635. 

  1636.     varName='PRES'
    1637. 

  1637. 	if (.not. allocated(dumdata)) then
    1638. 

  1638.     allocate(dumdata(IDS:IDE-1,JDS:JDE-1,num_metgrid_levels))
    1639. 

  1639. 	endif
    1640. 

  1640. 

  1641.      CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1642. 

  1642.      CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1643. 

  1643.                           dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    1644. 

  1644.                           mpi_status_ignore, ierr)
    1645. 

  1645. 

  1646.        DO K=1,num_metgrid_levels
    1647. 

  1647.         DO J=JTS,min(JTE,JDE-1)
    1648. 

  1648.          DO I=ITS,min(ITE,IDE-1)
    1649. 

  1649.            grid%p_gc(I,J,K)=dumdata(I,J,K)
    1650. 

  1650.          ENDDO
    1651. 

  1651.         ENDDO
    1652. 

  1652.        ENDDO
    1653. 

  1653. 

  1654.     varName='GHT'
    1655. 

  1655. 

  1656.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1657. 

  1657.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1658. 

  1658.                              dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    1659. 

  1659.                              mpi_status_ignore, ierr)
    1660. 

  1660. 

  1661. 

  1662.        DO K=1,num_metgrid_levels
    1663. 

  1663.         DO J=JTS,min(JTE,JDE-1)
    1664. 

  1664.          DO I=ITS,min(ITE,IDE-1)
    1665. 

  1665.            grid%ght_gc(I,J,K)=dumdata(I,J,K)
    1666. 

  1666.          ENDDO
    1667. 

  1667.         ENDDO
    1668. 

  1668.        ENDDO
    1669. 

  1669. 

  1670. 

  1671.     varName='VEGCAT'
    1672. 

  1672. 

  1673.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1674. 

  1674.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1675. 

  1675.                              dumdata,hor_size,mpi_real4,             &
    1676. 

  1676.                              mpi_status_ignore, ierr)
    1677. 

  1677. 

  1678.         DO J=JTS,min(JTE,JDE-1)
    1679. 

  1679.          DO I=ITS,min(ITE,IDE-1)
    1680. 

  1680.            grid%vegcat(I,J)=dumdata(I,J,1)
    1681. 

  1681.          ENDDO
    1682. 

  1682.         ENDDO
    1683. 

  1683. 

  1684.     varName='SOIL_CAT'
    1685. 

  1685.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1686. 

  1686.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1687. 

  1687.                              dumdata,hor_size,mpi_real4,             &
    1688. 

  1688.                              mpi_status_ignore, ierr)
    1689. 

  1689.         DO J=JTS,min(JTE,JDE-1)
    1690. 

  1690.          DO I=ITS,min(ITE,IDE-1)
    1691. 

  1691.            grid%input_soil_cat(I,J)=dumdata(I,J,1)
    1692. 

  1692.          ENDDO
    1693. 

  1693.         ENDDO
    1694. 

  1694. 

  1695.     varName='CANWAT'
    1696. 

  1696.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1697. 

  1697.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1698. 

  1698.                              dumdata,hor_size,mpi_real4,             &
    1699. 

  1699.                              mpi_status_ignore, ierr)
    1700. 

  1700. 

  1701.         DO J=JTS,min(JTE,JDE-1)
    1702. 

  1702.          DO I=ITS,min(ITE,IDE-1)
    1703. 

  1703.            grid%canwat(I,J)=dumdata(I,J,1)
    1704. 

  1704.          ENDDO
    1705. 

  1705.         ENDDO
    1706. 

  1706. 

  1707.     varName='SNOW'
    1708. 

  1708.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1709. 

  1709.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1710. 

  1710.                              dumdata,hor_size,mpi_real4,             &
    1711. 

  1711.                              mpi_status_ignore, ierr)
    1712. 

  1712.         DO J=JTS,min(JTE,JDE-1)
    1713. 

  1713.          DO I=ITS,min(ITE,IDE-1)
    1714. 

  1714.            grid%snow(I,J)=dumdata(I,J,1)
    1715. 

  1715.          ENDDO
    1716. 

  1716.         ENDDO
    1717. 

  1717. 

  1718.     varName='SNOWH'
    1719. 

  1719.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1720. 

  1720.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1721. 

  1721.                              dumdata,hor_size,mpi_real4,             &
    1722. 

  1722.                              mpi_status_ignore, ierr)
    1723. 

  1723.         DO J=JTS,min(JTE,JDE-1)
    1724. 

  1724.          DO I=ITS,min(ITE,IDE-1)
    1725. 

  1725.            grid%snowh(I,J)=dumdata(I,J,1)
    1726. 

  1726.          ENDDO
    1727. 

  1727.         ENDDO
    1728. 

  1728. 

  1729.     varName='SKINTEMP'
    1730. 

  1730.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1731. 

  1731.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1732. 

  1732.                              dumdata,hor_size,mpi_real4,             &
    1733. 

  1733.                              mpi_status_ignore, ierr)
    1734. 

  1734.         DO J=JTS,min(JTE,JDE-1)
    1735. 

  1735.          DO I=ITS,min(ITE,IDE-1)
    1736. 

  1736.            grid%tsk_gc(I,J)=dumdata(I,J,1)
    1737. 

  1737.          ENDDO
    1738. 

  1738.         ENDDO
    1739. 

  1739. 

  1740.     varName='SOILHGT'
    1741. 

  1741.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1742. 

  1742.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1743. 

  1743.                              dumdata,hor_size,mpi_real4,             &
    1744. 

  1744.                              mpi_status_ignore, ierr)
    1745. 

  1745.         DO J=JTS,min(JTE,JDE-1)
    1746. 

  1746.          DO I=ITS,min(ITE,IDE-1)
    1747. 

  1747.            grid%toposoil(I,J)=dumdata(I,J,1)
    1748. 

  1748.          ENDDO
    1749. 

  1749.         ENDDO
    1750. 

  1750. 

  1751.     varName='SEAICE'
    1752. 

  1752.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1753. 

  1753.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1754. 

  1754.                              dumdata,hor_size,mpi_real4,             &
    1755. 

  1755.                              mpi_status_ignore, ierr)
    1756. 

  1756.         DO J=JTS,min(JTE,JDE-1)
    1757. 

  1757.          DO I=ITS,min(ITE,IDE-1)
    1758. 

  1758.            grid%xice_gc(I,J)=dumdata(I,J,1)
    1759. 

  1759.          ENDDO
    1760. 

  1760.         ENDDO
    1761. 

  1761. 

  1762.     varName='ST100200'
    1763. 

  1763.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1764. 

  1764.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1765. 

  1765.                              dumdata,hor_size,mpi_real4,             &
    1766. 

  1766.                              mpi_status_ignore, ierr)
    1767. 

  1767.         DO J=JTS,min(JTE,JDE-1)
    1768. 

  1768.          DO I=ITS,min(ITE,IDE-1)
    1769. 

  1769.            grid%st100200(I,J)=dumdata(I,J,1)
    1770. 

  1770.          ENDDO
    1771. 

  1771.         ENDDO
    1772. 

  1772. 

  1773.     varName='ST040100'
    1774. 

  1774.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1775. 

  1775.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1776. 

  1776.                              dumdata,hor_size,mpi_real4,             &
    1777. 

  1777.                              mpi_status_ignore, ierr)
    1778. 

  1778.         DO J=JTS,min(JTE,JDE-1)
    1779. 

  1779.          DO I=ITS,min(ITE,IDE-1)
    1780. 

  1780.            grid%st040100(I,J)=dumdata(I,J,1)
    1781. 

  1781.          ENDDO
    1782. 

  1782.         ENDDO
    1783. 

  1783. 

  1784.     varName='ST010040'
    1785. 

  1785.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1786. 

  1786.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1787. 

  1787.                              dumdata,hor_size,mpi_real4,             &
    1788. 

  1788.                              mpi_status_ignore, ierr)
    1789. 

  1789. 

  1790.         DO J=JTS,min(JTE,JDE-1)
    1791. 

  1791.          DO I=ITS,min(ITE,IDE-1)
    1792. 

  1792.            grid%st010040(I,J)=dumdata(I,J,1)
    1793. 

  1793.          ENDDO
    1794. 

  1794.         ENDDO
    1795. 

  1795. 

  1796.     varName='ST000010'
    1797. 

  1797.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1798. 

  1798.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1799. 

  1799.                              dumdata,hor_size,mpi_real4,             &
    1800. 

  1800.                              mpi_status_ignore, ierr)
    1801. 

  1801. 

  1802.         DO J=JTS,min(JTE,JDE-1)
    1803. 

  1803.          DO I=ITS,min(ITE,IDE-1)
    1804. 

  1804.            grid%st000010(I,J)=dumdata(I,J,1)
    1805. 

  1805.          ENDDO
    1806. 

  1806.         ENDDO
    1807. 

  1807. 

  1808.     varName='SM100200'
    1809. 

  1809.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1810. 

  1810.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1811. 

  1811.                              dumdata,hor_size,mpi_real4,             &
    1812. 

  1812.                              mpi_status_ignore, ierr)
    1813. 

  1813. 

  1814.         DO J=JTS,min(JTE,JDE-1)
    1815. 

  1815.          DO I=ITS,min(ITE,IDE-1)
    1816. 

  1816.            grid%sm100200(I,J)=dumdata(I,J,1)
    1817. 

  1817.          ENDDO
    1818. 

  1818.         ENDDO
    1819. 

  1819. 

  1820.     varName='SM040100'
    1821. 

  1821.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1822. 

  1822.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1823. 

  1823.                              dumdata,hor_size,mpi_real4,             &
    1824. 

  1824.                              mpi_status_ignore, ierr)
    1825. 

  1825. 

  1826.         DO J=JTS,min(JTE,JDE-1)
    1827. 

  1827.          DO I=ITS,min(ITE,IDE-1)
    1828. 

  1828.            grid%sm040100(I,J)=dumdata(I,J,1)
    1829. 

  1829.          ENDDO
    1830. 

  1830.         ENDDO
    1831. 

  1831. 

  1832.     varName='SM010040'
    1833. 

  1833.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1834. 

  1834.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1835. 

  1835.                              dumdata,hor_size,mpi_real4,             &
    1836. 

  1836.                              mpi_status_ignore, ierr)
    1837. 

  1837. 

  1838.         DO J=JTS,min(JTE,JDE-1)
    1839. 

  1839.          DO I=ITS,min(ITE,IDE-1)
    1840. 

  1840.            grid%sm010040(I,J)=dumdata(I,J,1)
    1841. 

  1841.          ENDDO
    1842. 

  1842.         ENDDO
    1843. 

  1843. 

  1844.     varName='SM000010'
    1845. 

  1845.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1846. 

  1846.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1847. 

  1847.                              dumdata,hor_size,mpi_real4,             &
    1848. 

  1848.                              mpi_status_ignore, ierr)
    1849. 

  1849. 

  1850.         DO J=JTS,min(JTE,JDE-1)
    1851. 

  1851.          DO I=ITS,min(ITE,IDE-1)
    1852. 

  1852.            grid%sm000010(I,J)=dumdata(I,J,1)
    1853. 

  1853.          ENDDO
    1854. 

  1854.         ENDDO
    1855. 

  1855. 

  1856.     varName='PSFC'
    1857. 

  1857.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1858. 

  1858.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1859. 

  1859.                              dumdata,hor_size,mpi_real4,             &
    1860. 

  1860.                              mpi_status_ignore, ierr)
    1861. 

  1861. 

  1862.         DO J=JTS,min(JTE,JDE-1)
    1863. 

  1863.          DO I=ITS,min(ITE,IDE-1)
    1864. 

  1864.            grid%psfc(I,J)=dumdata(I,J,1)
    1865. 

  1865.          ENDDO
    1866. 

  1866.         ENDDO
    1867. 

  1867. 

  1868.     varName='RH'
    1869. 

  1869.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1870. 

  1870.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1871. 

  1871.                              dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    1872. 

  1872.                              mpi_status_ignore, ierr)
    1873. 

  1873. 

  1874.        DO K=1,num_metgrid_levels
    1875. 

  1875.         DO J=JTS,min(JTE,JDE-1)
    1876. 

  1876.          DO I=ITS,min(ITE,IDE-1)
    1877. 

  1877.            grid%rh_gc(I,J,K)=dumdata(I,J,K)
    1878. 

  1878.          ENDDO
    1879. 

  1879.         ENDDO
    1880. 

  1880.        ENDDO
    1881. 

  1881. 

  1882.     varName='VV'
    1883. 

  1883.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1884. 

  1884.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1885. 

  1885.                              dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    1886. 

  1886.                              mpi_status_ignore, ierr)
    1887. 

  1887.        DO K=1,num_metgrid_levels
    1888. 

  1888.         DO J=JTS,min(JTE,JDE-1)
    1889. 

  1889.          DO I=ITS,min(ITE,IDE-1)
    1890. 

  1890.            grid%v_gc(I,J,K)=dumdata(I,J,K)
    1891. 

  1891.          ENDDO
    1892. 

  1892.         ENDDO
    1893. 

  1893.        ENDDO
    1894. 

  1894. 

  1895.     varName='UU'
    1896. 

  1896.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1897. 

  1897.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1898. 

  1898.                              dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    1899. 

  1899.                              mpi_status_ignore, ierr)
    1900. 

  1900.        DO K=1,num_metgrid_levels
    1901. 

  1901.         DO J=JTS,min(JTE,JDE-1)
    1902. 

  1902.          DO I=ITS,min(ITE,IDE-1)
    1903. 

  1903.            grid%u_gc(I,J,K)=dumdata(I,J,K)
    1904. 

  1904.          ENDDO
    1905. 

  1905.         ENDDO
    1906. 

  1906.        ENDDO
    1907. 

  1907. 

  1908.     varName='TT'
    1909. 

  1909.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1910. 

  1910. 

  1911.         if (IRET .eq. 0) then
    1912. 

  1912.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1913. 

  1913.                              dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    1914. 

  1914.                              mpi_status_ignore, ierr)
    1915. 

  1915.        DO K=1,num_metgrid_levels
    1916. 

  1916.         DO J=JTS,min(JTE,JDE-1)
    1917. 

  1917.          DO I=ITS,min(ITE,IDE-1)
    1918. 

  1918.            grid%t_gc(I,J,K)=dumdata(I,J,K)
    1919. 

  1919.          ENDDO
    1920. 

  1920.         ENDDO
    1921. 

  1921.        ENDDO
    1922. 

  1922.         endif
    1923. 

  1923. 

  1924. !    varName='RWMR'
    1925. 

  1925. !    CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1926. 

  1926. !        if (iret .ne. 0) then
    1927. 

  1927. !        grid%rwmr_gc=0.
    1928. 

  1928. !        grid%snmr_gc=0.
    1929. 

  1929. !        grid%clwmr_gc=0.
    1930. 

  1930. !        grid%cice_gc=0.
    1931. 

  1931. !        grid%rimef_gc=0.
    1932. 

  1932. !        write(0,*) 'skipping cloud reads'
    1933. 

  1933. !        goto 979
    1934. 

  1934. !        endif
    1935. 

  1935. 

  1936. !    CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1937. 

  1937. !                             dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    1938. 

  1938. !                             mpi_status_ignore, ierr)
    1939. 

  1939. !       DO K=1,num_metgrid_levels
    1940. 

  1940. !        DO J=JTS,min(JTE,JDE-1)
    1941. 

  1941. !         DO I=ITS,min(ITE,IDE-1)
    1942. 

  1942. !           grid%rwmr_gc(I,J,K)=dumdata(I,J,K)
    1943. 

  1943. !         ENDDO
    1944. 

  1944. !        ENDDO
    1945. 

  1945. !       ENDDO
    1946. 

  1946. 

  1947. !    varName='SNMR'
    1948. 

  1948. !    CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1949. 

  1949. !    CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1950. 

  1950. !                             dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    1951. 

  1951. !                             mpi_status_ignore, ierr)
    1952. 

  1952. !       DO K=1,num_metgrid_levels
    1953. 

  1953. !        DO J=JTS,min(JTE,JDE-1)
    1954. 

  1954. !         DO I=ITS,min(ITE,IDE-1)
    1955. 

  1955. !           grid%snmr_gc(I,J,K)=dumdata(I,J,K)
    1956. 

  1956. !         ENDDO
    1957. 

  1957. !        ENDDO
    1958. 

  1958. !       ENDDO
    1959. 

  1959. 

  1960. !    varName='CLWMR'
    1961. 

  1961. !    CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1962. 

  1962. !    CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1963. 

  1963. !                             dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    1964. 

  1964. !                             mpi_status_ignore, ierr)
    1965. 

  1965. !       DO K=1,num_metgrid_levels
    1966. 

  1966. !        DO J=JTS,min(JTE,JDE-1)
    1967. 

  1967. !         DO I=ITS,min(ITE,IDE-1)
    1968. 

  1968. !           grid%clwmr_gc(I,J,K)=dumdata(I,J,K)
    1969. 

  1969. !         ENDDO
    1970. 

  1970. !        ENDDO
    1971. 

  1971. !       ENDDO
    1972. 

  1972. 

  1973. !    varName='CICE'
    1974. 

  1974. !    CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1975. 

  1975. !    CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1976. 

  1976. !                             dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    1977. 

  1977. !                             mpi_status_ignore, ierr)
    1978. 

  1978. !       DO K=1,num_metgrid_levels
    1979. 

  1979. !        DO J=JTS,min(JTE,JDE-1)
    1980. 

  1980. !         DO I=ITS,min(ITE,IDE-1)
    1981. 

  1981. !           grid%cice_gc(I,J,K)=dumdata(I,J,K)
    1982. 

  1982. !         ENDDO
    1983. 

  1983. !        ENDDO
    1984. 

  1984. !       ENDDO
    1985. 

  1985. 

  1986. !    varName='FRIMEF'
    1987. 

  1987. !    CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1988. 

  1988. !    CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1989. 

  1989. !                             dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    1990. 

  1990. !                             mpi_status_ignore, ierr)
    1991. 

  1991. !       DO K=1,num_metgrid_levels
    1992. 

  1992. !        DO J=JTS,min(JTE,JDE-1)
    1993. 

  1993. !         DO I=ITS,min(ITE,IDE-1)
    1994. 

  1994. !           grid%rimef_gc(I,J,K)=dumdata(I,J,K)
    1995. 

  1995. !         ENDDO
    1996. 

  1996. !        ENDDO
    1997. 

  1997. !       ENDDO
    1998. 

  1998. 

  1999.   979   continue
    2000. 

  2000. 

  2001. !    varName='PMSL'
    2002. 

  2002. 

  2003.     varName='SLOPECAT'
    2004. 

  2004.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2005. 

  2005.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2006. 

  2006.                              dumdata,hor_size,mpi_real4,             &
    2007. 

  2007.                              mpi_status_ignore, ierr)
    2008. 

  2008.         DO J=JTS,min(JTE,JDE-1)
    2009. 

  2009.          DO I=ITS,min(ITE,IDE-1)
    2010. 

  2010.            grid%slopecat(I,J)=dumdata(I,J,1)
    2011. 

  2011.          ENDDO
    2012. 

  2012.         ENDDO
    2013. 

  2013. 

  2014.     varName='SNOALB'
    2015. 

  2015.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2016. 

  2016.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2017. 

  2017.                              dumdata,hor_size,mpi_real4,             &
    2018. 

  2018.                              mpi_status_ignore, ierr)
    2019. 

  2019. 

  2020.         DO J=JTS,min(JTE,JDE-1)
    2021. 

  2021.          DO I=ITS,min(ITE,IDE-1)
    2022. 

  2022.            grid%snoalb(I,J)=dumdata(I,J,1)
    2023. 

  2023.          ENDDO
    2024. 

  2024.         ENDDO
    2025. 

  2025. 

  2026.          num_veg_cat      = SIZE ( grid%landusef_gc , DIM=3 )
    2027. 

  2027.          num_soil_top_cat = SIZE ( grid%soilctop_gc , DIM=3 )
    2028. 

  2028.          num_soil_bot_cat = SIZE ( grid%soilcbot_gc , DIM=3 )
    2029. 

  2029. 

  2030.     varName='GREENFRAC'
    2031. 

  2031.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2032. 

  2032.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2033. 

  2033.                              dumdata,hor_size*12,mpi_real4,             &
    2034. 

  2034.                              mpi_status_ignore, ierr)
    2035. 

  2035. 

  2036.        DO K=1,12
    2037. 

  2037.         DO J=JTS,min(JTE,JDE-1)
    2038. 

  2038.          DO I=ITS,min(ITE,IDE-1)
    2039. 

  2039.            grid%greenfrac_gc(I,J,K)=dumdata(I,J,K)
    2040. 

  2040.          ENDDO
    2041. 

  2041.         ENDDO
    2042. 

  2042.        ENDDO
    2043. 

  2043. 

  2044.     varName='ALBEDO12M'
    2045. 

  2045.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2046. 

  2046.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2047. 

  2047.                              dumdata,hor_size*12,mpi_real4,             &
    2048. 

  2048.                              mpi_status_ignore, ierr)
    2049. 

  2049. 

  2050.        DO K=1,12
    2051. 

  2051.         DO J=JTS,min(JTE,JDE-1)
    2052. 

  2052.          DO I=ITS,min(ITE,IDE-1)
    2053. 

  2053.            grid%albedo12m_gc(I,J,K)=dumdata(I,J,K)
    2054. 

  2054.          ENDDO
    2055. 

  2055.         ENDDO
    2056. 

  2056.        ENDDO
    2057. 

  2057. 

  2058.     varName='SOILCBOT'
    2059. 

  2059.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2060. 

  2060.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2061. 

  2061.                              dumdata,hor_size*num_soil_bot_cat,mpi_real4,             &
    2062. 

  2062.                              mpi_status_ignore, ierr)
    2063. 

  2063. 

  2064.        DO K=1,num_soil_bot_cat
    2065. 

  2065.         DO J=JTS,min(JTE,JDE-1)
    2066. 

  2066.          DO I=ITS,min(ITE,IDE-1)
    2067. 

  2067.            grid%soilcbot_gc(I,J,K)=dumdata(I,J,K)
    2068. 

  2068.          ENDDO
    2069. 

  2069.         ENDDO
    2070. 

  2070.        ENDDO
    2071. 

  2071. 

  2072.     varName='SOILCAT'
    2073. 

  2073.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2074. 

  2074.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2075. 

  2075.                              dumdata,hor_size,mpi_real4,             &
    2076. 

  2076.                              mpi_status_ignore, ierr)
    2077. 

  2077. 

  2078.         DO J=JTS,min(JTE,JDE-1)
    2079. 

  2079.          DO I=ITS,min(ITE,IDE-1)
    2080. 

  2080.            grid%soilcat(I,J)=dumdata(I,J,1)
    2081. 

  2081.          ENDDO
    2082. 

  2082.         ENDDO
    2083. 

  2083. 

  2084. 

  2085.     varName='SOILCTOP'
    2086. 

  2086.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2087. 

  2087.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2088. 

  2088.                              dumdata,hor_size*num_soil_top_cat,mpi_real4,             &
    2089. 

  2089.                              mpi_status_ignore, ierr)
    2090. 

  2090.        DO K=1,num_soil_top_cat
    2091. 

  2091.         DO J=JTS,min(JTE,JDE-1)
    2092. 

  2092.          DO I=ITS,min(ITE,IDE-1)
    2093. 

  2093.            grid%soilctop_gc(I,J,K)=dumdata(I,J,K)
    2094. 

  2094.          ENDDO
    2095. 

  2095.         ENDDO
    2096. 

  2096.        ENDDO
    2097. 

  2097. 

  2098.     varName='SOILTEMP'
    2099. 

  2099.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2100. 

  2100.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2101. 

  2101.                              dumdata,hor_size,mpi_real4,             &
    2102. 

  2102.                              mpi_status_ignore, ierr)
    2103. 

  2103. 

  2104.         DO J=JTS,min(JTE,JDE-1)
    2105. 

  2105.          DO I=ITS,min(ITE,IDE-1)
    2106. 

  2106.            grid%tmn_gc(I,J)=dumdata(I,J,1)
    2107. 

  2107.          ENDDO
    2108. 

  2108.         ENDDO
    2109. 

  2109. 

  2110.     varName='HGT_V'
    2111. 

  2111.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2112. 

  2112.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2113. 

  2113.                              dumdata,hor_size,mpi_real4,             &
    2114. 

  2114.                              mpi_status_ignore, ierr)
    2115. 

  2115. 

  2116.         DO J=JTS,min(JTE,JDE-1)
    2117. 

  2117.          DO I=ITS,min(ITE,IDE-1)
    2118. 

  2118.            grid%htv_gc(I,J)=dumdata(I,J,1)
    2119. 

  2119.          ENDDO
    2120. 

  2120.         ENDDO
    2121. 

  2121. 

  2122.     varName='HGT_M'
    2123. 

  2123.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2124. 

  2124.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2125. 

  2125.                              dumdata,hor_size,mpi_real4,             &
    2126. 

  2126.                              mpi_status_ignore, ierr)
    2127. 

  2127. 

  2128.         DO J=JTS,min(JTE,JDE-1)
    2129. 

  2129.          DO I=ITS,min(ITE,IDE-1)
    2130. 

  2130.            grid%ht_gc(I,J)=dumdata(I,J,1)
    2131. 

  2131.          ENDDO
    2132. 

  2132.         ENDDO
    2133. 

  2133. 

  2134.     varName='LU_INDEX'
    2135. 

  2135.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2136. 

  2136.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2137. 

  2137.                              dumdata,hor_size,mpi_real4,             &
    2138. 

  2138.                              mpi_status_ignore, ierr)
    2139. 

  2139. 

  2140.         DO J=JTS,min(JTE,JDE-1)
    2141. 

  2141.          DO I=ITS,min(ITE,IDE-1)
    2142. 

  2142.            grid%lu_index(I,J)=dumdata(I,J,1)
    2143. 

  2143.          ENDDO
    2144. 

  2144.         ENDDO
    2145. 

  2145. 

  2146.     varName='LANDUSEF'
    2147. 

  2147.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2148. 

  2148.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2149. 

  2149.                              dumdata,hor_size*num_veg_cat,mpi_real4,             &
    2150. 

  2150.                              mpi_status_ignore, ierr)
    2151. 

  2151. 

  2152.        DO K=1,num_veg_cat
    2153. 

  2153.         DO J=JTS,min(JTE,JDE-1)
    2154. 

  2154.          DO I=ITS,min(ITE,IDE-1)
    2155. 

  2155.            grid%landusef_gc(I,J,K)=dumdata(I,J,K)
    2156. 

  2156.          ENDDO
    2157. 

  2157.         ENDDO
    2158. 

  2158.        ENDDO
    2159. 

  2159. 

  2160.     varName='LANDMASK'
    2161. 

  2161.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2162. 

  2162.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2163. 

  2163.                              dumdata,hor_size,mpi_real4,             &
    2164. 

  2164.                              mpi_status_ignore, ierr)
    2165. 

  2165. 

  2166.         DO J=JTS,min(JTE,JDE-1)
    2167. 

  2167.          DO I=ITS,min(ITE,IDE-1)
    2168. 

  2168.            grid%landmask(I,J)=dumdata(I,J,1)
    2169. 

  2169.          ENDDO
    2170. 

  2170.         ENDDO
    2171. 

  2171. 

  2172. 

  2173.     varName='XLONG_V'
    2174. 

  2174.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2175. 

  2175.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2176. 

  2176.                              dumdata,hor_size,mpi_real4,             &
    2177. 

  2177.                              mpi_status_ignore, ierr)
    2178. 

  2178. 

  2179.         DO J=JTS,min(JTE,JDE-1)
    2180. 

  2180.          DO I=ITS,min(ITE,IDE-1)
    2181. 

  2181.            grid%vlon_gc(I,J)=dumdata(I,J,1)
    2182. 

  2182.          ENDDO
    2183. 

  2183.         ENDDO
    2184. 

  2184. 

  2185.     varName='XLAT_V'
    2186. 

  2186.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2187. 

  2187.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2188. 

  2188.                              dumdata,hor_size,mpi_real4,             &
    2189. 

  2189.                              mpi_status_ignore, ierr)
    2190. 

  2190. 

  2191.         DO J=JTS,min(JTE,JDE-1)
    2192. 

  2192.          DO I=ITS,min(ITE,IDE-1)
    2193. 

  2193.            grid%vlat_gc(I,J)=dumdata(I,J,1)
    2194. 

  2194.          ENDDO
    2195. 

  2195.         ENDDO
    2196. 

  2196. 

  2197.     varName='XLONG_M'
    2198. 

  2198.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2199. 

  2199.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2200. 

  2200.                              dumdata,hor_size,mpi_real4,             &
    2201. 

  2201.                              mpi_status_ignore, ierr)
    2202. 

  2202. 

  2203.         DO J=JTS,min(JTE,JDE-1)
    2204. 

  2204.          DO I=ITS,min(ITE,IDE-1)
    2205. 

  2205.            grid%hlon_gc(I,J)=dumdata(I,J,1)
    2206. 

  2206.          ENDDO
    2207. 

  2207.         ENDDO
    2208. 

  2208. 

  2209.     varName='XLAT_M'
    2210. 

  2210.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2211. 

  2211.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2212. 

  2212.                              dumdata,hor_size,mpi_real4,             &
    2213. 

  2213.                              mpi_status_ignore, ierr)
    2214. 

  2214. 

  2215.         DO J=JTS,min(JTE,JDE-1)
    2216. 

  2216.          DO I=ITS,min(ITE,IDE-1)
    2217. 

  2217.            grid%hlat_gc(I,J)=dumdata(I,J,1)
    2218. 

  2218.          ENDDO
    2219. 

  2219.         ENDDO
    2220. 

  2220. 

  2221. 

  2222. !!! GWD fields
    2223. 

  2223. 

  2224.     varName='HSTDV'
    2225. 

  2225.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2226. 

  2226.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2227. 

  2227.                              dumdata,hor_size,mpi_real4,             &
    2228. 

  2228.                              mpi_status_ignore, ierr)
    2229. 

  2229. 

  2230.         DO J=JTS,min(JTE,JDE-1)
    2231. 

  2231.          DO I=ITS,min(ITE,IDE-1)
    2232. 

  2232.            grid%hstdv(I,J)=dumdata(I,J,1)
    2233. 

  2233.          ENDDO
    2234. 

  2234.         ENDDO
    2235. 

  2235. 

  2236.     varName='HCNVX'
    2237. 

  2237.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2238. 

  2238.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2239. 

  2239.                              dumdata,hor_size,mpi_real4,             &
    2240. 

  2240.                              mpi_status_ignore, ierr)
    2241. 

  2241. 

  2242.         DO J=JTS,min(JTE,JDE-1)
    2243. 

  2243.          DO I=ITS,min(ITE,IDE-1)
    2244. 

  2244.            grid%hcnvx(I,J)=dumdata(I,J,1)
    2245. 

  2245.          ENDDO
    2246. 

  2246.         ENDDO
    2247. 

  2247. 

  2248.     varName='HASYW'
    2249. 

  2249.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2250. 

  2250.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2251. 

  2251.                              dumdata,hor_size,mpi_real4,             &
    2252. 

  2252.                              mpi_status_ignore, ierr)
    2253. 

  2253. 

  2254.         DO J=JTS,min(JTE,JDE-1)
    2255. 

  2255.          DO I=ITS,min(ITE,IDE-1)
    2256. 

  2256.            grid%hasyw(I,J)=dumdata(I,J,1)
    2257. 

  2257.          ENDDO
    2258. 

  2258.         ENDDO
    2259. 

  2259. 

  2260.     varName='HASYS'
    2261. 

  2261.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2262. 

  2262.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2263. 

  2263.                              dumdata,hor_size,mpi_real4,             &
    2264. 

  2264.                              mpi_status_ignore, ierr)
    2265. 

  2265. 

  2266.         DO J=JTS,min(JTE,JDE-1)
    2267. 

  2267.          DO I=ITS,min(ITE,IDE-1)
    2268. 

  2268.            grid%hasys(I,J)=dumdata(I,J,1)
    2269. 

  2269.          ENDDO
    2270. 

  2270.         ENDDO
    2271. 

  2271. 

  2272.     varName='HASYSW'
    2273. 

  2273.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2274. 

  2274.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2275. 

  2275.                              dumdata,hor_size,mpi_real4,             &
    2276. 

  2276.                              mpi_status_ignore, ierr)
    2277. 

  2277. 

  2278.         DO J=JTS,min(JTE,JDE-1)
    2279. 

  2279.          DO I=ITS,min(ITE,IDE-1)
    2280. 

  2280.            grid%hasysw(I,J)=dumdata(I,J,1)
    2281. 

  2281.          ENDDO
    2282. 

  2282.         ENDDO
    2283. 

  2283. 

  2284.     varName='HASYNW'
    2285. 

  2285.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2286. 

  2286.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2287. 

  2287.                              dumdata,hor_size,mpi_real4,             &
    2288. 

  2288.                              mpi_status_ignore, ierr)
    2289. 

  2289. 

  2290.         DO J=JTS,min(JTE,JDE-1)
    2291. 

  2291.          DO I=ITS,min(ITE,IDE-1)
    2292. 

  2292.            grid%hasynw(I,J)=dumdata(I,J,1)
    2293. 

  2293.          ENDDO
    2294. 

  2294.         ENDDO
    2295. 

  2295. 

  2296.     varName='HLENW'
    2297. 

  2297.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2298. 

  2298.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2299. 

  2299.                              dumdata,hor_size,mpi_real4,             &
    2300. 

  2300.                              mpi_status_ignore, ierr)
    2301. 

  2301. 

  2302.         DO J=JTS,min(JTE,JDE-1)
    2303. 

  2303.          DO I=ITS,min(ITE,IDE-1)
    2304. 

  2304.            grid%hlenw(I,J)=dumdata(I,J,1)
    2305. 

  2305.          ENDDO
    2306. 

  2306.         ENDDO
    2307. 

  2307. 

  2308.     varName='HLENS'
    2309. 

  2309.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2310. 

  2310.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2311. 

  2311.                              dumdata,hor_size,mpi_real4,             &
    2312. 

  2312.                              mpi_status_ignore, ierr)
    2313. 

  2313. 

  2314.         DO J=JTS,min(JTE,JDE-1)
    2315. 

  2315.          DO I=ITS,min(ITE,IDE-1)
    2316. 

  2316.            grid%hlens(I,J)=dumdata(I,J,1)
    2317. 

  2317.          ENDDO
    2318. 

  2318.         ENDDO
    2319. 

  2319. 

  2320.     varName='HLENSW'
    2321. 

  2321.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2322. 

  2322.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2323. 

  2323.                              dumdata,hor_size,mpi_real4,             &
    2324. 

  2324.                              mpi_status_ignore, ierr)
    2325. 

  2325. 

  2326.         DO J=JTS,min(JTE,JDE-1)
    2327. 

  2327.          DO I=ITS,min(ITE,IDE-1)
    2328. 

  2328.            grid%hlensw(I,J)=dumdata(I,J,1)
    2329. 

  2329.          ENDDO
    2330. 

  2330.         ENDDO
    2331. 

  2331. 

  2332.     varName='HLENNW'
    2333. 

  2333.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2334. 

  2334.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2335. 

  2335.                              dumdata,hor_size,mpi_real4,             &
    2336. 

  2336.                              mpi_status_ignore, ierr)
    2337. 

  2337. 

  2338.         DO J=JTS,min(JTE,JDE-1)
    2339. 

  2339.          DO I=ITS,min(ITE,IDE-1)
    2340. 

  2340.            grid%hlennw(I,J)=dumdata(I,J,1)
    2341. 

  2341.          ENDDO
    2342. 

  2342.         ENDDO
    2343. 

  2343. 

  2344.     varName='HANGL'
    2345. 

  2345.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2346. 

  2346.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2347. 

  2347.                              dumdata,hor_size,mpi_real4,             &
    2348. 

  2348.                              mpi_status_ignore, ierr)
    2349. 

  2349. 

  2350.         DO J=JTS,min(JTE,JDE-1)
    2351. 

  2351.          DO I=ITS,min(ITE,IDE-1)
    2352. 

  2352.            grid%hangl(I,J)=dumdata(I,J,1)
    2353. 

  2353.          ENDDO
    2354. 

  2354.         ENDDO
    2355. 

  2355. 

  2356.     varName='HANIS'
    2357. 

  2357.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2358. 

  2358.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2359. 

  2359.                              dumdata,hor_size,mpi_real4,             &
    2360. 

  2360.                              mpi_status_ignore, ierr)
    2361. 

  2361. 

  2362.         DO J=JTS,min(JTE,JDE-1)
    2363. 

  2363.          DO I=ITS,min(ITE,IDE-1)
    2364. 

  2364.            grid%hanis(I,J)=dumdata(I,J,1)
    2365. 

  2365.          ENDDO
    2366. 

  2366.         ENDDO
    2367. 

  2367. 

  2368.     varName='HSLOP'
    2369. 

  2369.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2370. 

  2370.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2371. 

  2371.                              dumdata,hor_size,mpi_real4,             &
    2372. 

  2372.                              mpi_status_ignore, ierr)
    2373. 

  2373. 

  2374.         DO J=JTS,min(JTE,JDE-1)
    2375. 

  2375.          DO I=ITS,min(ITE,IDE-1)
    2376. 

  2376.            grid%hslop(I,J)=dumdata(I,J,1)
    2377. 

  2377.          ENDDO
    2378. 

  2378.         ENDDO
    2379. 

  2379. 

  2380.     varName='HZMAX'
    2381. 

  2381.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    2382. 

  2382.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    2383. 

  2383.                              dumdata,hor_size,mpi_real4,             &
    2384. 

  2384.                              mpi_status_ignore, ierr)
    2385. 

  2385. 

  2386.         DO J=JTS,min(JTE,JDE-1)
    2387. 

  2387.          DO I=ITS,min(ITE,IDE-1)
    2388. 

  2388.            grid%hzmax(I,J)=dumdata(I,J,1)
    2389. 

  2389.          ENDDO
    2390. 

  2390.         ENDDO
    2391. 

  2391. 	write(0,*) 'maxval grid%hzmax: ', maxval(grid%hzmax)
    2392. 

  2392. 

  2393.       call mpi_file_close(mpi_comm_world, ierr)
    2394. 

  2394. 

  2395.        varName='ST000010'
    2396. 

  2396.        flag_st000010 = 1
    2397. 

  2397.        num_st_levels_input = num_st_levels_input + 1
    2398. 

  2398.        st_levels_input(num_st_levels_input) = char2int2(varName(3:8))
    2399. 

  2399.        DO J=JTS,min(JTE,JDE-1)
    2400. 

  2400.         DO I=ITS,min(ITE,IDE-1)
    2401. 

  2401.            st_inputx(I,J,num_st_levels_input + 1) = grid%st000010(i,j)
    2402. 

  2402.         ENDDO
    2403. 

  2403.        ENDDO
    2404. 

  2404. 

  2405.        varName='ST010040'
    2406. 

  2406.        flag_st010040 = 1
    2407. 

  2407.        num_st_levels_input = num_st_levels_input + 1
    2408. 

  2408.        st_levels_input(num_st_levels_input) = char2int2(varName(3:8))
    2409. 

  2409.        DO J=JTS,min(JTE,JDE-1)
    2410. 

  2410.         DO I=ITS,min(ITE,IDE-1)
    2411. 

  2411.             st_inputx(I,J,num_st_levels_input + 1) = grid%st010040(i,j)
    2412. 

  2412.         ENDDO
    2413. 

  2413.        ENDDO
    2414. 

  2414. 

  2415.        varName='ST040100'
    2416. 

  2416.        flag_st040100 = 1
    2417. 

  2417.        num_st_levels_input = num_st_levels_input + 1
    2418. 

  2418.        st_levels_input(num_st_levels_input) = char2int2(varName(3:8))
    2419. 

  2419.        DO J=JTS,min(JTE,JDE-1)
    2420. 

  2420.         DO I=ITS,min(ITE,IDE-1)
    2421. 

  2421.               st_inputx(I,J,num_st_levels_input + 1) = grid%st040100(i,j)
    2422. 

  2422.         ENDDO
    2423. 

  2423.        ENDDO
    2424. 

  2424. 

  2425.        varName='ST100200'
    2426. 

  2426.        flag_st100200 = 1
    2427. 

  2427.        num_st_levels_input = num_st_levels_input + 1
    2428. 

  2428.        st_levels_input(num_st_levels_input) = char2int2(varName(3:8))
    2429. 

  2429.        DO J=JTS,min(JTE,JDE-1)
    2430. 

  2430.         DO I=ITS,min(ITE,IDE-1)
    2431. 

  2431.               st_inputx(I,J,num_st_levels_input + 1) = grid%st100200(i,j)
    2432. 

  2432.         ENDDO
    2433. 

  2433.        ENDDO
    2434. 

  2434. 

  2435.        varName='SM000010'
    2436. 

  2436.        flag_sm000010 = 1
    2437. 

  2437.        num_sm_levels_input = num_sm_levels_input + 1
    2438. 

  2438.        sm_levels_input(num_sm_levels_input) = char2int2(varName(3:8))
    2439. 

  2439.        DO J=JTS,min(JTE,JDE-1)
    2440. 

  2440.         DO I=ITS,min(ITE,IDE-1)
    2441. 

  2441.            sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm000010(i,j)
    2442. 

  2442.         ENDDO
    2443. 

  2443.        ENDDO
    2444. 

  2444. 

  2445.        varName='SM010040'
    2446. 

  2446.        flag_sm010040 = 1
    2447. 

  2447.        num_sm_levels_input = num_sm_levels_input + 1
    2448. 

  2448.        sm_levels_input(num_sm_levels_input) = char2int2(varName(3:8))
    2449. 

  2449.        DO J=JTS,min(JTE,JDE-1)
    2450. 

  2450.         DO I=ITS,min(ITE,IDE-1)
    2451. 

  2451.             sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm010040(i,j)
    2452. 

  2452.         ENDDO
    2453. 

  2453.        ENDDO
    2454. 

  2454. 

  2455.        varName='SM040100'
    2456. 

  2456.        flag_sm040100 = 1
    2457. 

  2457.        num_sm_levels_input = num_sm_levels_input + 1
    2458. 

  2458.        sm_levels_input(num_sm_levels_input) = char2int2(varName(3:8))
    2459. 

  2459.        DO J=JTS,min(JTE,JDE-1)
    2460. 

  2460.         DO I=ITS,min(ITE,IDE-1)
    2461. 

  2461.               sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm040100(i,j)
    2462. 

  2462.         ENDDO
    2463. 

  2463.        ENDDO
    2464. 

  2464. 

  2465.        varName='SM100200'
    2466. 

  2466.        flag_sm100200 = 1
    2467. 

  2467.        num_sm_levels_input = num_sm_levels_input + 1
    2468. 

  2468.        sm_levels_input(num_sm_levels_input) = char2int2(varName(3:8))
    2469. 

  2469.        DO J=JTS,min(JTE,JDE-1)
    2470. 

  2470.         DO I=ITS,min(ITE,IDE-1)
    2471. 

  2471.               sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm100200(i,j)
    2472. 

  2472.         ENDDO
    2473. 

  2473.        ENDDO
    2474. 

  2474. 

  2475.             flag_sst = 1
    2476. 

  2476. 

  2477. !new
    2478. 

  2478.         sw_inputx=0.
    2479. 

  2479. !new
    2480. 

  2480. 

  2481.       sw_input=0.
    2482. 

  2482. 

  2483. 

  2484.         do J=JTS,min(JDE-1,JTE)
    2485. 

  2485.          do K=1,num_st_levels_alloc
    2486. 

  2486.           do I=ITS,min(IDE-1,ITE)
    2487. 

  2487.              st_input(I,K,J)=st_inputx(I,J,K)
    2488. 

  2488.              sm_input(I,K,J)=sm_inputx(I,J,K)
    2489. 

  2489.              sw_input(I,K,J)=sw_inputx(I,J,K)
    2490. 

  2490.           enddo
    2491. 

  2491.          enddo
    2492. 

  2492.         enddo
    2493. 

  2493. 

  2494. !        DEALLOCATE(pmsl)
    2495. 

  2495. !        DEALLOCATE(psfc_in)
    2496. 

  2496. !        DEALLOCATE(st_inputx)
    2497. 

  2497. !        DEALLOCATE(sm_inputx)
    2498. 

  2498. !        DEALLOCATE(sw_inputx)
    2499. 

  2499. !        DEALLOCATE(soilt010_input)
    2500. 

  2500. !        DEALLOCATE(soilt040_input)
    2501. 

  2501. !        DEALLOCATE(soilt100_input)
    2502. 

  2502. !        DEALLOCATE(soilt200_input)
    2503. 

  2503. !        DEALLOCATE(soilm010_input)
    2504. 

  2504. !        DEALLOCATE(soilm040_input)
    2505. 

  2505. !        DEALLOCATE(soilm100_input)
    2506. 

  2506. !        DEALLOCATE(soilm200_input)
    2507. 

  2507. !        DEALLOCATE(dumdata)
    2508. 

  2508. 

  2509. #endif
    2510. 

  2510.      end subroutine read_wps
    2511. 

  2511. 

  2512. ! -------------------------------------------------------------------------
    2513. 

  2513. ! -------------------------------------------------------------------------
    2514. 

  2514. ! -------------------------------------------------------------------------
    2515. 

  2515. ! -------------------------------------------------------------------------
    2516. 

  2516. !!!! MPI-IO pieces
    2517. 

  2517. 

  2518. subroutine retrieve_index(index,string,varname_all,nrecs,iret)
    2519. 

  2519. !$$$  subprogram documentation block
    2520. 

  2520. !                .      .    .                                       .
    2521. 

  2521. ! subprogram:    retrieve_index  get record number of desired variable
    2522. 

  2522. !   prgmmr: parrish          org: np22                date: 2004-11-29
    2523. 

  2523. !
    2524. 

  2524. ! abstract: by examining previously generated inventory of wrf binary restart file,
    2525. 

  2525. !             find record number that contains the header record for variable
    2526. 

  2526. !             identified by input character variable "string".
    2527. 

  2527. !
    2528. 

  2528. ! program history log:
    2529. 

  2529. !   2004-11-29  parrish
    2530. 

  2530. !
    2531. 

  2531. !   input argument list:
    2532. 

  2532. !     string           - mnemonic for variable desired
    2533. 

  2533. !     varname_all      - list of all mnemonics obtained from inventory of file
    2534. 

  2534. !     nrecs            - total number of sequential records counted in wrf
    2535. 

  2535. !                        binary restart file
    2536. 

  2536. !
    2537. 

  2537. !   output argument list:
    2538. 

  2538. !     index            - desired record number
    2539. 

  2539. !     iret             - return status, set to 0 if variable was found,
    2540. 

  2540. !                        non-zero if not.
    2541. 

  2541. !
    2542. 

  2542. ! attributes:
    2543. 

  2543. !   language: f90
    2544. 

  2544. !   machine:  ibm RS/6000 SP
    2545. 

  2545. !
    2546. 

  2546. !$$$
    2547. 

  2547. 

  2548.   implicit none
    2549. 

  2549. 

  2550.   integer,intent(out)::iret
    2551. 

  2551.   integer,intent(in)::nrecs
    2552. 

  2552.   integer,intent(out):: index
    2553. 

  2553.   character(*), intent(in):: string
    2554. 

  2554.   character(132),intent(in)::varname_all(nrecs)
    2555. 

  2555. 

  2556.   integer i
    2557. 

  2557. 

  2558.   iret=0
    2559. 

  2559. 

  2560.   do i=1,nrecs
    2561. 

  2561.    if(trim(string) == trim(varname_all(i))) then
    2562. 

  2562.       index=i
    2563. 

  2563.       return
    2564. 

  2564.    end if
    2565. 

  2565.   end do
    2566. 

  2566. 

  2567.   write(6,*)' problem reading wrf nmm binary file, rec id "',trim(string),'" not found'
    2568. 

  2568. 

  2569.   iret=-1
    2570. 

  2570. 

  2571. end subroutine retrieve_index
    2572. 

  2572. subroutine next_buf(in_unit,buf,nextbyte,locbyte,thisblock,lrecl,nreads,lastbuf)
    2573. 

  2573. !$$$  subprogram documentation block
    2574. 

  2574. !                .      .    .                                       .
    2575. 

  2575. ! subprogram:    next_buf    bring in next direct access block
    2576. 

  2576. !   prgmmr: parrish          org: np22                date: 2004-11-29
    2577. 

  2577. !
    2578. 

  2578. ! abstract: bring in next direct access block when needed, as the file is scanned
    2579. 

  2579. !             from beginning to end during counting and inventory of records.
    2580. 

  2580. !             (subroutines count_recs_wrf_binary_file and inventory_wrf_binary_file)
    2581. 

  2581. !
    2582. 

  2582. ! program history log:
    2583. 

  2583. !   2004-11-29  parrish
    2584. 

  2584. !
    2585. 

  2585. !   input argument list:
    2586. 

  2586. !     in_unit          - fortran unit number where input file is opened through.
    2587. 

  2587. !     nextbyte         - byte number from beginning of file that is desired
    2588. 

  2588. !     locbyte          - byte number from beginning of last block read for desired byt
    2589. 

  2589. !     lrecl            - direct access block length
    2590. 

  2590. !     nreads           - number of blocks read before now (for diagnostic information
    2591. 

  2591. !     lastbuf          - logical, if true, then no more blocks, so return
    2592. 

  2592. !
    2593. 

  2593. !   output argument list:
    2594. 

  2594. !     buf              - output array containing contents of next block
    2595. 

  2595. !     locbyte          - byte number from beginning of new block read for desired byte
    2596. 

  2596. !     thisblock        - number of new block being read by this routine
    2597. 

  2597. !     nreads           - number of blocks read now (for diagnostic information only)
    2598. 

  2598. !     lastbuf          - logical, if true, then at end of file.
    2599. 

  2599. !
    2600. 

  2600. ! attributes:
    2601. 

  2601. !   language: f90
    2602. 

  2602. !   machine:  ibm RS/6000 SP
    2603. 

  2603. !
    2604. 

  2604. !$$$
    2605. 

  2605. !  use kinds, only: i_byte,i_llong
    2606. 

  2606.   implicit none
    2607. 

  2607. 

  2608.   integer(i_llong) lrecl
    2609. 

  2609.   integer in_unit,nreads
    2610. 

  2610.   integer(i_byte) buf(lrecl)
    2611. 

  2611.   integer(i_llong) nextbyte,locbyte,thisblock
    2612. 

  2612.   logical lastbuf
    2613. 

  2613. 

  2614.   integer ierr
    2615. 

  2615. 

  2616.   if(lastbuf) return
    2617. 

  2617. 

  2618.   ierr=0
    2619. 

  2619.   nreads=nreads+1
    2620. 

  2620. 

  2621. !  compute thisblock:
    2622. 

  2622. 

  2623.   thisblock = 1_i_llong + (nextbyte-1_i_llong)/lrecl
    2624. 

  2624. 

  2625.   locbyte = 1_i_llong+mod(locbyte-1_i_llong,lrecl)
    2626. 

  2626. 

  2627.   read(in_unit,rec=thisblock,iostat=ierr)buf
    2628. 

  2628.   lastbuf = ierr /= 0
    2629. 

  2629. 

  2630. end subroutine next_buf
    2631. 

  2631. 

  2632. subroutine inventory_wrf_binary_file(in_unit,wrf_ges_filename,nrecs, &
    2633. 

  2633.                                      datestr_all,varname_all,domainend_all, &
    2634. 

  2634.                                      start_block,end_block,start_byte,end_byte,file_offset)
    2635. 

  2635. !$$$  subprogram documentation block
    2636. 

  2636. !                .      .    .                                       .
    2637. 

  2637. ! subprogram:    inventory_wrf_binary_file  get contents of wrf binary file
    2638. 

  2638. !   prgmmr: parrish          org: np22                date: 2004-11-29
    2639. 

  2639. !
    2640. 

  2640. ! abstract: generate list of contents and map of wrf binary file which can be
    2641. 

  2641. !             used for reading and writing with mpi io routines.
    2642. 

  2642. !             same basic routine as count_recs_wrf_binary_file, except
    2643. 

  2643. !             now wrf unpacking routines are used to decode wrf header
    2644. 

  2644. !             records, and send back lists of variable mnemonics, dates,
    2645. 

  2645. !             grid dimensions, and byte addresses relative to start of
    2646. 

  2646. !             file for each field (this is used by mpi io routines).
    2647. 

  2647. !
    2648. 

  2648. ! program history log:
    2649. 

  2649. !   2004-11-29  parrish
    2650. 

  2650. !
    2651. 

  2651. !
    2652. 

  2652. !   input argument list:
    2653. 

  2653. !     in_unit          - fortran unit number where input file is opened through.
    2654. 

  2654. !     wrf_ges_filename - filename of input wrf binary restart file
    2655. 

  2655. !     nrecs            - number of sequential records found on input wrf binary restart file.
    2656. 

  2656. !                          (obtained by a previous call to count_recs_wrf_binary_file)
    2657. 

  2657. !
    2658. 

  2658. !   output argument list:  (all following dimensioned nrecs)
    2659. 

  2659. !     datestr_all      - date character string for each field, where applicable (or else blanks)
    2660. 

  2660. !     varname_all      - wrf mnemonic for each variable, where applicable (or blank)
    2661. 

  2661. !     domainend_all    - dimensions of each field, where applicable (up to 3 dimensions)
    2662. 

  2662. !     start_block      - direct access block number containing 1st byte of record
    2663. 

  2663. !                            (after 4 byte record mark)
    2664. 

  2664. !     end_block        - direct access block number containing last byte of record
    2665. 

  2665. !                            (before 4 byte record mark)
    2666. 

  2666. !     start_byte       - relative byte address in direct access block of 1st byte of record
    2667. 

  2667. !     end_byte         - relative byte address in direct access block of last byte of record
    2668. 

  2668. !     file_offset      - absolute address of byte before 1st byte of record (used by mpi io)
    2669. 

  2669. !
    2670. 

  2670. ! attributes:
    2671. 

  2671. !   language: f90
    2672. 

  2672. !   machine:  ibm RS/6000 SP
    2673. 

  2673. !
    2674. 

  2674. !$$$
    2675. 

  2675. !   use kinds, only: r_single,i_byte,i_long,i_llong
    2676. 

  2676.   use module_internal_header_util
    2677. 

  2677.   implicit none
    2678. 

  2678. 

  2679.   integer,intent(in)::in_unit,nrecs
    2680. 

  2680.   character(*),intent(in)::wrf_ges_filename
    2681. 

  2681.   character(132),intent(out)::datestr_all(nrecs),varname_all(nrecs)
    2682. 

  2682.   integer,intent(out)::domainend_all(3,nrecs)
    2683. 

  2683.   integer,intent(out)::start_block(nrecs),end_block(nrecs)
    2684. 

  2684.   integer,intent(out)::start_byte(nrecs),end_byte(nrecs)
    2685. 

  2685.   integer(i_llong),intent(out)::file_offset(nrecs)
    2686. 

  2686. 

  2687.   integer irecs
    2688. 

  2688.   integer(i_llong) nextbyte,locbyte,thisblock
    2689. 

  2689.   integer(i_byte) lenrec4(4)
    2690. 

  2690.   integer(i_long) lenrec,lensave
    2691. 

  2691.   equivalence (lenrec4(1),lenrec)
    2692. 

  2692.   integer(i_byte) missing4(4)
    2693. 

  2693.   integer(i_long) missing
    2694. 

  2694.   equivalence (missing,missing4(1))
    2695. 

  2695.   integer(i_llong),parameter:: lrecl=2**16-1
    2696. 

  2696.   integer(i_byte) buf(lrecl)
    2697. 

  2697.   integer i,loc_count,nreads
    2698. 

  2698.   logical lastbuf
    2699. 

  2699.   integer(i_byte) hdrbuf4(2048)
    2700. 

  2700.   integer(i_long) hdrbuf(512)
    2701. 

  2701.   equivalence(hdrbuf(1),hdrbuf4(1))
    2702. 

  2702.   integer,parameter:: int_field       =       530
    2703. 

  2703.   integer,parameter:: int_dom_ti_char =       220
    2704. 

  2704.   integer,parameter:: int_dom_ti_real =       140
    2705. 

  2705.   integer,parameter:: int_dom_ti_integer =       180
    2706. 

  2706.   integer hdrbufsize
    2707. 

  2707.   integer inttypesize
    2708. 

  2708.   integer datahandle,count
    2709. 

  2709.   character(128) element,dumstr,strdata
    2710. 

  2710.   integer loccode
    2711. 

  2711.   character(132) blanks
    2712. 

  2712.   integer typesize
    2713. 

  2713.   integer fieldtype,comm,iocomm
    2714. 

  2714.   integer domaindesc
    2715. 

  2715.   character(132) memoryorder,stagger,dimnames(3)
    2716. 

  2716.   integer domainstart(3),domainend(3)
    2717. 

  2717.   integer memorystart(3),memoryend(3)
    2718. 

  2718.   integer patchstart(3),patchend(3)
    2719. 

  2719.   character(132) datestr,varname
    2720. 

  2720.   real(r_single) dummy_field(1)
    2721. 

  2721. !  integer dummy_field
    2722. 

  2722. !  real dummy_field
    2723. 

  2723.   integer itypesize
    2724. 

  2724.   integer idata(1)
    2725. 

  2725.   real rdata(16)
    2726. 

  2726. 

  2727.   call wrf_sizeof_integer(itypesize)
    2728. 

  2728.   inttypesize=itypesize
    2729. 

  2729. 

  2730.   blanks=trim(' ')
    2731. 

  2731. 

  2732.   open(in_unit,file=trim(wrf_ges_filename),access='direct',recl=lrecl)
    2733. 

  2733.   irecs=0
    2734. 

  2734.   missing=-9999
    2735. 

  2735.   nextbyte=0_i_llong
    2736. 

  2736.   locbyte=lrecl
    2737. 

  2737.   nreads=0
    2738. 

  2738.   lastbuf=.false.
    2739. 

  2739.   do
    2740. 

  2740. 

  2741. !   get length of next record
    2742. 

  2742. 

  2743.     do i=1,4
    2744. 

  2744.      nextbyte=nextbyte+1_i_llong
    2745. 

  2745.      locbyte=locbyte+1_i_llong
    2746. 

  2746.      if(locbyte > lrecl .and. lastbuf) go to 900
    2747. 

  2747.      if(locbyte > lrecl) call next_buf(in_unit,buf,nextbyte,locbyte,thisblock,lrecl,nreads,lastbuf)
    2748. 

  2748.      lenrec4(i)=buf(locbyte)
    2749. 

  2749.     end do
    2750. 

  2750.     if(lenrec <= 0 .and. lastbuf) go to 900
    2751. 

  2751.     if(lenrec <= 0 .and. .not. lastbuf) go to 885
    2752. 

  2752.     nextbyte=nextbyte+1_i_llong
    2753. 

  2753.     locbyte=locbyte+1_i_llong
    2754. 

  2754.     if(locbyte > lrecl .and. lastbuf) go to 900
    2755. 

  2755.     if(locbyte > lrecl) call next_buf(in_unit,buf,nextbyte,locbyte,thisblock,lrecl,nreads,lastbuf)
    2756. 

  2756. 

  2757.     irecs=irecs+1
    2758. 

  2758.     start_block(irecs)=thisblock
    2759. 

  2759.     start_byte(irecs)=locbyte
    2760. 

  2760.     file_offset(irecs)=nextbyte-1_i_llong
    2761. 

  2761.     hdrbuf4(1)=buf(locbyte)
    2762. 

  2762.     hdrbuf4(2:4)=missing4(2:4)
    2763. 

  2763.     hdrbuf4(5:8)=missing4(1:4)
    2764. 

  2764.     datestr_all(irecs)=blanks
    2765. 

  2765.     varname_all(irecs)=blanks
    2766. 

  2766.     domainend_all(1:3,irecs)=0
    2767. 

  2767. 

  2768.     loc_count=1
    2769. 

  2769.     do i=2,8
    2770. 

  2770.        if(loc_count.ge.lenrec) exit
    2771. 

  2771.        loc_count=loc_count+1
    2772. 

  2772.        nextbyte=nextbyte+1_i_llong
    2773. 

  2773.        locbyte=locbyte+1_i_llong
    2774. 

  2774.        if(locbyte > lrecl .and. lastbuf) go to 900
    2775. 

  2775.        if(locbyte > lrecl) call next_buf(in_unit,buf,nextbyte,locbyte,thisblock,lrecl,nreads,lastbuf)
    2776. 

  2776.        hdrbuf4(i)=buf(locbyte)
    2777. 

  2777.     end do
    2778. 

  2778. 

  2779. !         if(lenrec==2048) write(6,*)' irecs,hdrbuf(2),int_dom_ti_char,int_field=', &
    2780. 

  2780. !                                      irecs,hdrbuf(2),int_dom_ti_char,int_field
    2781. 

  2781. 

  2782.     if(lenrec==2048.and.(hdrbuf(2) == int_dom_ti_char .or. hdrbuf(2) == int_field &
    2783. 

  2783.     .or. hdrbuf(2) == int_dom_ti_real .or. hdrbuf(2) == int_dom_ti_integer)) then
    2784. 

  2784. 

  2785. !    bring in next full record, so we can unpack datestr, varname, and domainend
    2786. 

  2786.        do i=9,lenrec
    2787. 

  2787.           loc_count=loc_count+1
    2788. 

  2788.           nextbyte=nextbyte+1_i_llong
    2789. 

  2789.           locbyte=locbyte+1_i_llong
    2790. 

  2790.           if(locbyte > lrecl .and. lastbuf) go to 900
    2791. 

  2791.           if(locbyte > lrecl) call next_buf(in_unit,buf,nextbyte,locbyte,thisblock,lrecl,nreads,lastbuf)
    2792. 

  2792.           hdrbuf4(i)=buf(locbyte)
    2793. 

  2793.        end do
    2794. 

  2794. 

  2795.        if(hdrbuf(2) == int_dom_ti_char) then
    2796. 

  2796. 

  2797.           call int_get_ti_header_char(hdrbuf,hdrbufsize,inttypesize, &
    2798. 

  2798.                    datahandle,element,dumstr,strdata,loccode)
    2799. 

  2799.           varname_all(irecs)=trim(element)
    2800. 

  2800.           datestr_all(irecs)=trim(strdata)
    2801. 

  2801. !              write(6,*)' irecs,varname,datestr = ',irecs,trim(varname_all(irecs)),trim(datestr_all(irecs))
    2802. 

  2802. 

  2803.        else if(hdrbuf(2) == int_dom_ti_real) then
    2804. 

  2804. 

  2805.           call int_get_ti_header_real(hdrbuf,hdrbufsize,inttypesize,typesize, &
    2806. 

  2806.                    datahandle,element,rdata,count,loccode)
    2807. 

  2807.           varname_all(irecs)=trim(element)
    2808. 

  2808. !          datestr_all(irecs)=trim(strdata)
    2809. 

  2809. !	write(6,*) 'count: ', count
    2810. 

  2810. !              write(6,*)' irecs,varname,datestr = ',irecs,trim(varname_all(irecs)),rdata(1:count)
    2811. 

  2811.          
    2812. 

  2812.        else if(hdrbuf(2) == int_dom_ti_integer) then
    2813. 

  2813. 

  2814.           call int_get_ti_header_integer(hdrbuf,hdrbufsize,inttypesize,typesize, &
    2815. 

  2815.                    datahandle,element,idata,count,loccode)
    2816. 

  2816.           varname_all(irecs)=trim(element)
    2817. 

  2817. !          datestr_all(irecs)=trim(strdata)
    2818. 

  2818. !              write(6,*)' irecs,varname,datestr = ',irecs,trim(varname_all(irecs)),idata(1:count)
    2819. 

  2819. 

  2820.        else
    2821. 

  2821. 

  2822.           call int_get_write_field_header(hdrbuf,hdrbufsize,inttypesize,typesize, &
    2823. 

  2823.              datahandle,datestr,varname,dummy_field,fieldtype,comm,iocomm, &
    2824. 

  2824.              domaindesc,memoryorder,stagger,dimnames, &
    2825. 

  2825.              domainstart,domainend,memorystart,memoryend,patchstart,patchend)
    2826. 

  2826.           varname_all(irecs)=trim(varname)
    2827. 

  2827.           datestr_all(irecs)=trim(datestr)
    2828. 

  2828.           domainend_all(1:3,irecs)=domainend(1:3)
    2829. 

  2829. !              write(6,*)' irecs,datestr,domend,varname = ', &
    2830. 

  2830. !                  irecs,trim(datestr_all(irecs)),domainend_all(1:3,irecs),trim(varname_all(irecs))
    2831. 

  2831. 

  2832.        end if
    2833. 

  2833.     end if
    2834. 

  2834. 

  2835.     nextbyte=nextbyte-loc_count+lenrec
    2836. 

  2836.     locbyte=locbyte-loc_count+lenrec
    2837. 

  2837.     if(locbyte > lrecl .and. lastbuf) go to 900
    2838. 

  2838.     if(locbyte > lrecl) call next_buf(in_unit,buf,nextbyte,locbyte,thisblock,lrecl,nreads,lastbuf)
    2839. 

  2839.     end_block(irecs)=thisblock
    2840. 

  2840.     end_byte(irecs)=locbyte
    2841. 

  2841.     lensave=lenrec
    2842. 

  2842.     do i=1,4
    2843. 

  2843.      nextbyte=nextbyte+1_i_llong
    2844. 

  2844.      locbyte=locbyte+1_i_llong
    2845. 

  2845.      if(locbyte > lrecl .and. lastbuf) go to 900
    2846. 

  2846.      if(locbyte > lrecl) call next_buf(in_unit,buf,nextbyte,locbyte,thisblock,lrecl,nreads,lastbuf)
    2847. 

  2847.      lenrec4(i)=buf(locbyte)
    2848. 

  2848.     end do
    2849. 

  2849.     if(lenrec /= lensave) go to 890
    2850. 

  2850. 

  2851.   end do
    2852. 

  2852. 

  2853. 880  continue
    2854. 

  2854.      write(6,*)' reached impossible place in inventory_wrf_binary_file'
    2855. 

  2855.      close(in_unit)
    2856. 

  2856.      return
    2857. 

  2857. 

  2858. 885  continue
    2859. 

  2859.      write(6,*)' problem in inventory_wrf_binary_file, lenrec has bad value before end of file'
    2860. 

  2860.      write(6,*)'     lenrec =',lenrec
    2861. 

  2861.      close(in_unit)
    2862. 

  2862.      return
    2863. 

  2863. 

  2864. 890  continue
    2865. 

  2865.      write(6,*)' problem in inventory_wrf_binary_file, beginning and ending rec len words unequal'
    2866. 

  2866.      write(6,*)'     begining reclen =',lensave
    2867. 

  2867.      write(6,*)'       ending reclen =',lenrec
    2868. 

  2868.      write(6,*)'               irecs =',irecs
    2869. 

  2869.      write(6,*)'               nrecs =',nrecs
    2870. 

  2870.      close(in_unit)
    2871. 

  2871.      return
    2872. 

  2872. 

  2873. 900  continue
    2874. 

  2874.      write(6,*)' normal end of file reached in inventory_wrf_binary_file'
    2875. 

  2875.      write(6,*)'        nblocks=',thisblock
    2876. 

  2876.      write(6,*)'          irecs,nrecs=',irecs,nrecs
    2877. 

  2877.      write(6,*)'         nreads=',nreads
    2878. 

  2878.      close(in_unit)
    2879. 

  2879. 

  2880. end subroutine inventory_wrf_binary_file
    2881. 

  2881. 

  2882. SUBROUTINE wrf_sizeof_integer( retval )
    2883. 

  2883.   IMPLICIT NONE
    2884. 

  2884.   INTEGER retval
    2885. 

  2885. ! 4 is defined by CPP
    2886. 

  2886.   retval = 4
    2887. 

  2887.   RETURN
    2888. 

  2888. END SUBROUTINE wrf_sizeof_integer
    2889. 

  2889. 

  2890. SUBROUTINE wrf_sizeof_real( retval )
    2891. 

  2891.   IMPLICIT NONE
    2892. 

  2892.   INTEGER retval
    2893. 

  2893. ! 4 is defined by CPP
    2894. 

  2894.   retval = 4
    2895. 

  2895.   RETURN
    2896. 

  2896. END SUBROUTINE wrf_sizeof_real
    2897. 

  2897. subroutine count_recs_wrf_binary_file(in_unit,wrf_ges_filename,nrecs)
    2898. 

  2898. !$$$  subprogram documentation block
    2899. 

  2899. !                .      .    .                                       .
    2900. 

  2900. ! subprogram:    count_recs_binary_file  count # recs on wrf binary file
    2901. 

  2901. !   prgmmr: parrish          org: np22                date: 2004-11-29
    2902. 

  2902. !
    2903. 

  2903. ! abstract: count number of sequential records contained in wrf binary
    2904. 

  2904. !             file.  this is done by opening the file in direct access
    2905. 

  2905. !             mode with block length of 2**20, the size of the physical
    2906. 

  2906. !             blocks on ibm "blue" and "white" machines.  for optimal
    2907. 

  2907. !             performance, change block length to correspond to the
    2908. 

  2908. !             physical block length of host machine disk space.
    2909. 

  2909. !             records are counted by looking for the 4 byte starting
    2910. 

  2910. !             and ending sequential record markers, which contain the
    2911. 

  2911. !             record size in bytes.  only blocks are read which are known
    2912. 

  2912. !             by simple calculation to contain these record markers.
    2913. 

  2913. !             even though this is done on one processor, it is still
    2914. 

  2914. !             very fast, and the time will always scale by the number of
    2915. 

  2915. !             sequential records, not their size.  this step and the
    2916. 

  2916. !             following inventory step consistently take less than 0.1 seconds
    2917. 

  2917. !             to complete.
    2918. 

  2918. !
    2919. 

  2919. ! program history log:
    2920. 

  2920. !   2004-11-29  parrish
    2921. 

  2921. !
    2922. 

  2922. !   input argument list:
    2923. 

  2923. !     in_unit          - fortran unit number where input file is opened through.
    2924. 

  2924. !     wrf_ges_filename - filename of input wrf binary restart file
    2925. 

  2925. !
    2926. 

  2926. !   output argument list:
    2927. 

  2927. !     nrecs            - number of sequential records found on input wrf binary restart fil
    2928. 

  2928. !
    2929. 

  2929. ! attributes:
    2930. 

  2930. !   language: f90
    2931. 

  2931. !   machine:  ibm RS/6000 SP
    2932. 

  2932. !
    2933. 

  2933. !$$$
    2934. 

  2934. 

  2935. !   do an initial read through of a wrf binary file, and get total number of sequential fil
    2936. 

  2936. 

  2937. !   use kinds, only: r_single,i_byte,i_long,i_llong
    2938. 

  2938.   implicit none
    2939. 

  2939. 

  2940.   integer,intent(in)::in_unit
    2941. 

  2941.   character(*),intent(in)::wrf_ges_filename
    2942. 

  2942.   integer,intent(out)::nrecs
    2943. 

  2943. 

  2944.   integer(i_llong) nextbyte,locbyte,thisblock
    2945. 

  2945.   integer(i_byte) lenrec4(4)
    2946. 

  2946.   integer(i_long) lenrec,lensave
    2947. 

  2947.   equivalence (lenrec4(1),lenrec)
    2948. 

  2948.   integer(i_byte) missing4(4)
    2949. 

  2949.   integer(i_long) missing
    2950. 

  2950.   equivalence (missing,missing4(1))
    2951. 

  2951.   integer(i_llong),parameter:: lrecl=2**16-1
    2952. 

  2952.   integer(i_byte) buf(lrecl)
    2953. 

  2953.   integer i,loc_count,nreads
    2954. 

  2954.   logical lastbuf
    2955. 

  2955. 

  2956.   open(in_unit,file=trim(wrf_ges_filename),access='direct',recl=lrecl)
    2957. 

  2957.   nrecs=0
    2958. 

  2958.   missing=-9999
    2959. 

  2959.   nextbyte=0_i_llong
    2960. 

  2960.   locbyte=lrecl
    2961. 

  2961.   nreads=0
    2962. 

  2962.   lastbuf=.false.
    2963. 

  2963.   do
    2964. 

  2964. 

  2965. !   get length of next record
    2966. 

  2966. 

  2967.     do i=1,4
    2968. 

  2968.      nextbyte=nextbyte+1_i_llong
    2969. 

  2969.      locbyte=locbyte+1_i_llong
    2970. 

  2970.      if(locbyte > lrecl .and. lastbuf) go to 900
    2971. 

  2971.      if(locbyte > lrecl) call next_buf(in_unit,buf,nextbyte,locbyte,thisblock,lrecl,nreads,lastbuf)
    2972. 

  2972.      lenrec4(i)=buf(locbyte)
    2973. 

  2973.     end do
    2974. 

  2974.     if(lenrec <= 0 .and. lastbuf) go to 900
    2975. 

  2975.     if(lenrec <= 0 .and. .not.lastbuf) go to 885
    2976. 

  2976.     nextbyte=nextbyte+1_i_llong
    2977. 

  2977.     locbyte=locbyte+1_i_llong
    2978. 

  2978.     if(locbyte > lrecl .and. lastbuf) go to 900
    2979. 

  2979.     if(locbyte > lrecl) call next_buf(in_unit,buf,nextbyte,locbyte,thisblock,lrecl,nreads,lastbuf)
    2980. 

  2980. 

  2981.     nrecs=nrecs+1
    2982. 

  2982. 

  2983.     loc_count=1
    2984. 

  2984.     do i=2,4
    2985. 

  2985.        if(loc_count.ge.lenrec) exit
    2986. 

  2986.        loc_count=loc_count+1
    2987. 

  2987.        nextbyte=nextbyte+1_i_llong
    2988. 

  2988.        locbyte=locbyte+1_i_llong
    2989. 

  2989.        if(locbyte > lrecl .and. lastbuf) go to 900
    2990. 

  2990.        if(locbyte > lrecl) call next_buf(in_unit,buf,nextbyte,locbyte,thisblock,lrecl,nreads,lastbuf)
    2991. 

  2991.     end do
    2992. 

  2992.     do i=1,4
    2993. 

  2993.        if(loc_count.ge.lenrec) exit
    2994. 

  2994.        loc_count=loc_count+1
    2995. 

  2995.        nextbyte=nextbyte+1_i_llong
    2996. 

  2996.        locbyte=locbyte+1_i_llong
    2997. 

  2997.        if(locbyte > lrecl .and. lastbuf) go to 900
    2998. 

  2998.        if(locbyte > lrecl) call next_buf(in_unit,buf,nextbyte,locbyte,thisblock,lrecl,nreads,lastbuf)
    2999. 

  2999.     end do
    3000. 

  3000.     nextbyte=nextbyte-loc_count+lenrec
    3001. 

  3001.     locbyte=locbyte-loc_count+lenrec
    3002. 

  3002.     if(locbyte > lrecl .and. lastbuf) go to 900
    3003. 

  3003.     if(locbyte > lrecl) call next_buf(in_unit,buf,nextbyte,locbyte,thisblock,lrecl,nreads,lastbuf)
    3004. 

  3004.     lensave=lenrec
    3005. 

  3005.     do i=1,4
    3006. 

  3006.      nextbyte=nextbyte+1_i_llong
    3007. 

  3007.      locbyte=locbyte+1_i_llong
    3008. 

  3008.      if(locbyte > lrecl .and. lastbuf) go to 900
    3009. 

  3009.      if(locbyte > lrecl) call next_buf(in_unit,buf,nextbyte,locbyte,thisblock,lrecl,nreads,lastbuf)
    3010. 

  3010.      lenrec4(i)=buf(locbyte)
    3011. 

  3011.     end do
    3012. 

  3012.     if(lenrec /= lensave) go to 890
    3013. 

  3013. 

  3014.   end do
    3015. 

  3015. 

  3016. 880  continue
    3017. 

  3017.      write(6,*)' reached impossible place in count_recs_wrf_binary_file'
    3018. 

  3018.      close(in_unit)
    3019. 

  3019.      return
    3020. 

  3020. 

  3021. 885  continue
    3022. 

  3022.      write(6,*)' problem in count_recs_wrf_binary_file, lenrec has bad value before end of file'
    3023. 

  3023.      write(6,*)'     lenrec =',lenrec
    3024. 

  3024.      close(in_unit)
    3025. 

  3025.      return
    3026. 

  3026. 

  3027. 890  continue
    3028. 

  3028.      write(6,*)' problem in count_recs_wrf_binary_file, beginning and ending rec len words unequal'
    3029. 

  3029.      write(6,*)'     begining reclen =',lensave
    3030. 

  3030.      write(6,*)'       ending reclen =',lenrec
    3031. 

  3031.      close(in_unit)
    3032. 

  3032.      return
    3033. 

  3033. 

  3034. 900  continue
    3035. 

  3035.      write(6,*)' normal end of file reached in count_recs_wrf_binary_file'
    3036. 

  3036.      write(6,*)'        nblocks=',thisblock
    3037. 

  3037.      write(6,*)'          nrecs=',nrecs
    3038. 

  3038.      write(6,*)'         nreads=',nreads
    3039. 

  3039.      close(in_unit)
    3040. 

  3040. 

  3041. end subroutine count_recs_wrf_binary_file
    3042. 

  3042. 

  3043. subroutine retrieve_field(in_unit,wrfges,out,start_block,end_block,start_byte,end_byte)
    3044. 

  3044. !$$$  subprogram documentation block
    3045. 

  3045. !                .      .    .                                       .
    3046. 

  3046. ! subprogram:    retrieve_field  retrieve field from wrf binary file
    3047. 

  3047. !   prgmmr: parrish          org: np22                date: 2004-11-29
    3048. 

  3048. !
    3049. 

  3049. ! abstract: still using direct access, retrieve a field from the wrf binary restart file.
    3050. 

  3050. !
    3051. 

  3051. ! program history log:
    3052. 

  3052. !   2004-11-29  parrish
    3053. 

  3053. !
    3054. 

  3054. !   input argument list:
    3055. 

  3055. !     in_unit          - fortran unit number where input file is opened through.
    3056. 

  3056. !     wrfges - filename of input wrf binary restart file
    3057. 

  3057. !     start_block      - direct access block number containing 1st byte of record
    3058. 

  3058. !                            (after 4 byte record mark)
    3059. 

  3059. !     end_block        - direct access block number containing last byte of record
    3060. 

  3060. !                            (before 4 byte record mark)
    3061. 

  3061. !     start_byte       - relative byte address in direct access block of 1st byte of record
    3062. 

  3062. !     end_byte         - relative byte address in direct access block of last byte of record
    3063. 

  3063. !
    3064. 

  3064. !   output argument list:
    3065. 

  3065. !     out              - output buffer where desired field is deposited
    3066. 

  3066. !
    3067. 

  3067. ! attributes:
    3068. 

  3068. !   language: f90
    3069. 

  3069. !   machine:  ibm RS/6000 SP
    3070. 

  3070. !
    3071. 

  3071. !$$$
    3072. 

  3072. 

  3073.  ! use kinds, only: i_byte,i_kind
    3074. 

  3074.   implicit none
    3075. 

  3075. 

  3076.   integer(i_kind),intent(in)::in_unit
    3077. 

  3077.   character(50),intent(in)::wrfges
    3078. 

  3078.   integer(i_kind),intent(in)::start_block,end_block,start_byte,end_byte
    3079. 

  3079.   integer(i_byte),intent(out)::out(*)
    3080. 

  3080. 

  3081.   integer(i_llong),parameter:: lrecl=2**16-1
    3082. 

  3082.   integer(i_byte) buf(lrecl)
    3083. 

  3083.   integer(i_kind) i,ii,k
    3084. 

  3084.   integer ierr, ibegin, iend
    3085. 

  3085. 

  3086.   open(in_unit,file=trim(wrfges),access='direct',recl=lrecl)
    3087. 

  3087. 

  3088.      write(6,*)' in retrieve_field, start_block,end_block=',start_block,end_block
    3089. 

  3089.      write(6,*)' in retrieve_field, start_byte,end_byte=',start_byte,end_byte
    3090. 

  3090.   ii=0
    3091. 

  3091.   ierr=0
    3092. 

  3092.   do k=start_block,end_block
    3093. 

  3093.      read(in_unit,rec=k,iostat=ierr)buf
    3094. 

  3094.      ibegin=1 ; iend=lrecl
    3095. 

  3095.      if(k == start_block) ibegin=start_byte
    3096. 

  3096.      if(k == end_block) iend=end_byte
    3097. 

  3097.      do i=ibegin,iend
    3098. 

  3098.         ii=ii+1
    3099. 

  3099.         out(ii)=buf(i)
    3100. 

  3100.      end do
    3101. 

  3101.   end do
    3102. 

  3102.   close(in_unit)
    3103. 

  3103. 

  3104. end subroutine retrieve_field
    3105. 

  3105. 

  3106. 

  3107. END MODULE module_si_io_nmm
    3108. 

  3108.