/wrfv2_fire/dyn_em/module_wps_io_arw.F

http://github.com/jbeezley/wrf-fire · FORTRAN Legacy · 1944 lines · 1092 code · 300 blank · 552 comment · 68 complexity · 100ac757f26606a7119c8b03b77f8dce MD5 · raw file

Large files are truncated click here to view the full file

    

  1. MODULE module_wps_io_arw
    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. 

  85.       REAL , DIMENSION(:,:,:) , ALLOCATABLE :: landuse_frac_input , &
    86. 

  86.                                                soil_top_cat_input , &
    87. 

  87.                                                soil_bot_cat_input
    88. 

  88. 

  89. 

  90.       !  Input 2D surface fields.
    91. 

  91. 

  92.       REAL , DIMENSION(:,:)   , ALLOCATABLE :: soilt010_input , soilt040_input , &
    93. 

  93.                                                soilt100_input , soilt200_input , &
    94. 

  94.                                                soilm010_input , soilm040_input , &
    95. 

  95.                                                soilm100_input , soilm200_input , &
    96. 

  96.                                                psfc_in,pmsl
    97. 

  97. 

  98.       REAL , DIMENSION(:,:)   , ALLOCATABLE :: lat_wind, lon_wind 
    99. 

  99. 

  100. 

  101.       !  Local input arrays
    102. 

  102. 

  103.       REAL,DIMENSION(:,:),ALLOCATABLE :: dum2d
    104. 

  104.       INTEGER,DIMENSION(:,:),ALLOCATABLE :: idum2d
    105. 

  105.       REAL,DIMENSION(:,:,:),ALLOCATABLE :: dum3d
    106. 

  106. 

  107.       LOGICAL , SAVE :: first_time_in = .TRUE.
    108. 

  108. 

  109.       INTEGER :: flag_soilt010 , flag_soilt100 , flag_soilt200 , &
    110. 

  110.         	 flag_soilm010 , flag_soilm100 , flag_soilm200
    111. 

  111. 

  112. !   Some constants to allow simple dimensions in the defined types
    113. 

  113. !   given below.
    114. 

  114. 

  115. 

  116. CONTAINS
    117. 

  117. 

  118.    SUBROUTINE read_wps ( grid, filename, file_date_string, num_metgrid_levels )
    119. 

  119. 

  120.       USE module_soil_pre
    121. 

  121.       USE module_domain
    122. 

  122. 

  123.       IMPLICIT NONE
    124. 

  124. 

  125.       TYPE(domain) , INTENT(INOUT)  :: grid
    126. 

  126.       CHARACTER (LEN=19) , INTENT(IN) :: file_date_string
    127. 

  127.       CHARACTER (LEN=4)              :: dummychar
    128. 

  128.       CHARACTER (LEN=132)              :: VarName
    129. 

  129.       CHARACTER (LEN=150)             :: chartemp
    130. 

  130.       CHARACTER (*) , INTENT(IN) :: filename
    131. 

  131. 

  132.       INTEGER :: ids,ide,jds,jde,kds,kde           &
    133. 

  133.                 ,ims,ime,jms,jme,kms,kme           &
    134. 

  134.                 ,its,ite,jts,jte,kts,kte
    135. 

  135. 

  136.       INTEGER :: i , j , k , loop, IMAX, JMAX
    137. 

  137.       INTEGER :: DATAHANDLE, num_metgrid_levels
    138. 

  138.       INTEGER :: Sysdepinfo, Status
    139. 

  139.       INTEGER :: istatus,ioutcount,iret,index,ierr
    140. 

  140.       
    141. 

  141.       integer :: nrecs,iunit, L,hor_size,hor_size_u,hor_size_v
    142. 

  142. 

  143. !!
    144. 

  144.       character*132, allocatable :: datestr_all(:)
    145. 

  145.       character*132, allocatable :: varname_all(:)
    146. 

  146.       integer, allocatable       :: domainend_all(:,:)
    147. 

  147.       integer, allocatable       :: start_block(:)
    148. 

  148.       integer, allocatable       :: end_block(:)
    149. 

  149.       integer, allocatable       :: start_byte(:)
    150. 

  150.       integer, allocatable       :: end_byte(:)
    151. 

  151.       integer(kind=i_llong), allocatable           :: file_offset(:)
    152. 

  152. !!
    153. 

  153. 

  154.       REAL :: dummy,tmp,garb
    155. 

  155.       REAL, ALLOCATABLE:: dumdata(:,:,:)
    156. 

  156.       REAL, ALLOCATABLE:: dumdata_u(:,:,:)
    157. 

  157.       REAL, ALLOCATABLE:: dumdata_v(:,:,:)
    158. 

  158. 

  159.       REAL :: lats16(16),lons16(16)
    160. 

  160. 

  161.       CHARACTER (LEN= 8) :: dummy_char
    162. 

  162. 

  163.       INTEGER :: ok , map_proj , ok_open, igarb,igarb2, N
    164. 

  164.       REAL :: pt
    165. 

  165.       INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
    166. 

  166. 

  167. #if defined(DM_PARALLEL) && !defined(STUBMPI)
    168. 

  168.       INCLUDE "mpif.h"
    169. 

  169. 

  170.       SELECT CASE ( model_data_order )
    171. 

  171.          CASE ( DATA_ORDER_ZXY )
    172. 

  172.             kds = grid%sd31 ; kde = grid%ed31 ;
    173. 

  173.             ids = grid%sd32 ; ide = grid%ed32 ;
    174. 

  174.             jds = grid%sd33 ; jde = grid%ed33 ;
    175. 

  175. 

  176.             kms = grid%sm31 ; kme = grid%em31 ;
    177. 

  177.             ims = grid%sm32 ; ime = grid%em32 ;
    178. 

  178.             jms = grid%sm33 ; jme = grid%em33 ;
    179. 

  179. 

  180.             kts = grid%sp31 ; kte = grid%ep31 ; ! tile is entire patch
    181. 

  181.             its = grid%sp32 ; ite = grid%ep32 ; ! tile is entire patch
    182. 

  182.             jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
    183. 

  183. 

  184.          CASE ( DATA_ORDER_XYZ )
    185. 

  185.             ids = grid%sd31 ; ide = grid%ed31 ;
    186. 

  186.             jds = grid%sd32 ; jde = grid%ed32 ;
    187. 

  187.             kds = grid%sd33 ; kde = grid%ed33 ;
    188. 

  188. 

  189.             ims = grid%sm31 ; ime = grid%em31 ;
    190. 

  190.             jms = grid%sm32 ; jme = grid%em32 ;
    191. 

  191.             kms = grid%sm33 ; kme = grid%em33 ;
    192. 

  192. 

  193.             its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
    194. 

  194.             jts = grid%sp32 ; jte = grid%ep32 ; ! tile is entire patch
    195. 

  195.             kts = grid%sp33 ; kte = grid%ep33 ; ! tile is entire patch
    196. 

  196. 

  197.          CASE ( DATA_ORDER_XZY )
    198. 

  198.             ids = grid%sd31 ; ide = grid%ed31 ;
    199. 

  199.             kds = grid%sd32 ; kde = grid%ed32 ;
    200. 

  200.             jds = grid%sd33 ; jde = grid%ed33 ;
    201. 

  201. 

  202.             ims = grid%sm31 ; ime = grid%em31 ;
    203. 

  203.             kms = grid%sm32 ; kme = grid%em32 ;
    204. 

  204.             jms = grid%sm33 ; jme = grid%em33 ;
    205. 

  205. 

  206.             its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
    207. 

  207.             kts = grid%sp32 ; kte = grid%ep32 ; ! tile is entire patch
    208. 

  208.             jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
    209. 

  209. 

  210.       END SELECT
    211. 

  211. 

  212.       !  Initialize what soil temperature and moisture is available.
    213. 

  213. 

  214. 

  215.       flag_st000010 = 0
    216. 

  216.       flag_st010040 = 0
    217. 

  217.       flag_st040100 = 0
    218. 

  218.       flag_st100200 = 0
    219. 

  219.       flag_sm000010 = 0 
    220. 

  220.       flag_sm010040 = 0
    221. 

  221.       flag_sm040100 = 0
    222. 

  222.       flag_sm100200 = 0
    223. 

  223.       flag_st010200 = 0
    224. 

  224.       flag_sm010200 = 0
    225. 

  225. 

  226.       flag_soilt010 = 0
    227. 

  227.       flag_soilt040 = 0
    228. 

  228.       flag_soilt100 = 0
    229. 

  229.       flag_soilt200 = 0 
    230. 

  230.       flag_soilm010 = 0 
    231. 

  231.       flag_soilm040 = 0
    232. 

  232.       flag_soilm100 = 0
    233. 

  233.       flag_soilm200 = 0
    234. 

  234. 

  235.       flag_sst      = 0
    236. 

  236.       flag_toposoil = 0
    237. 

  237. 

  238.       !  How many soil levels have we found?  Well, right now, none.
    239. 

  239. 

  240.       num_st_levels_input = 0
    241. 

  241.       num_sm_levels_input = 0
    242. 

  242.       st_levels_input = -1
    243. 

  243.       sm_levels_input = -1
    244. 

  244. 

  245.       !  Get the space for the data if this is the first time here.
    246. 

  246. 

  247. 

  248.         IF (.NOT. ALLOCATED (pmsl)              ) ALLOCATE ( pmsl(its:ite,jts:jte) )
    249. 

  249.         IF (.NOT. ALLOCATED (psfc_in)           ) ALLOCATE ( psfc_in(its:ite,jts:jte) )
    250. 

  250. 

  251. !!! MPI IO
    252. 

  252. 

  253.       iunit=33
    254. 

  254.       call count_recs_wrf_binary_file(iunit, trim(fileName), nrecs)
    255. 

  255. 

  256.       allocate (datestr_all(nrecs))
    257. 

  257.       allocate (varname_all(nrecs))
    258. 

  258.       allocate (domainend_all(3,nrecs))
    259. 

  259.       allocate (start_block(nrecs))
    260. 

  260.       allocate (end_block(nrecs))
    261. 

  261.       allocate (start_byte(nrecs))
    262. 

  262.       allocate (end_byte(nrecs))
    263. 

  263.       allocate (file_offset(nrecs))
    264. 

  264.  
    265. 

  265.       call inventory_wrf_binary_file(iunit, trim(filename), nrecs,  &
    266. 

  266.                       datestr_all,varname_all,domainend_all,   &
    267. 

  267.                       start_block,end_block,start_byte,end_byte,file_offset)
    268. 

  268. 

  269.       call mpi_file_open(mpi_comm_world, trim(filename),     &
    270. 

  270.                          mpi_mode_rdonly,mpi_info_null, iunit, ierr)
    271. 

  271.       if (ierr /= 0) then
    272. 

  272.        call wrf_error_fatal("Error opening file with mpi io")
    273. 

  273.       end if
    274. 

  274. 

  275.       VarName='CEN_LAT'
    276. 

  276.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    277. 

  277.       if (iret /= 0) then
    278. 

  278.         print*,VarName," not found in file"
    279. 

  279.       else
    280. 

  280. 

  281.         call mpi_file_read_at(iunit,file_offset(index)+5*4,      &
    282. 

  282.                               garb,1,mpi_real4,                  &
    283. 

  283.                               mpi_status_ignore, ierr)
    284. 

  284. 

  285.         if (ierr /= 0) then
    286. 

  286.           print*,"Error reading ", VarName," using MPIIO"
    287. 

  287.         else
    288. 

  288.           print*,VarName, ' from MPIIO READ= ',garb
    289. 

  289.           CALL nl_set_cen_lat ( grid%id , garb )
    290. 

  290.         end if
    291. 

  291.       end if
    292. 

  292. 

  293.       VarName='CEN_LON'
    294. 

  294.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    295. 

  295.         call mpi_file_read_at(iunit,file_offset(index)+5*4,      &
    296. 

  296.                               garb,1,mpi_real4,                  &
    297. 

  297.                               mpi_status_ignore, ierr)
    298. 

  298.           CALL nl_set_cen_lon ( grid%id , garb )
    299. 

  299.           CALL nl_set_stand_lon ( grid%id , garb )
    300. 

  300. 

  301.       VarName='POLE_LAT'
    302. 

  302.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    303. 

  303.         call mpi_file_read_at(iunit,file_offset(index)+5*4,      &
    304. 

  304.                               garb,1,mpi_real4,                  &
    305. 

  305.                               mpi_status_ignore, ierr)
    306. 

  306.           CALL nl_set_pole_lat ( grid%id , garb )
    307. 

  307. 

  308.       VarName='TRUELAT1'
    309. 

  309.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    310. 

  310.         call mpi_file_read_at(iunit,file_offset(index)+5*4,      &
    311. 

  311.                               garb,1,mpi_real4,                  &
    312. 

  312.                               mpi_status_ignore, ierr)
    313. 

  313.           CALL nl_set_truelat1 ( grid%id , garb )
    314. 

  314. 

  315.       VarName='TRUELAT2'
    316. 

  316.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    317. 

  317.         call mpi_file_read_at(iunit,file_offset(index)+5*4,      &
    318. 

  318.                               garb,1,mpi_real4,                  &
    319. 

  319.                               mpi_status_ignore, ierr)
    320. 

  320.           CALL nl_set_truelat2 ( grid%id , garb )
    321. 

  321. 

  322.       VarName='MAP_PROJ'
    323. 

  323.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    324. 

  324. 

  325.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    326. 

  326.                               igarb,1,mpi_integer4,             &
    327. 

  327.                               mpi_status_ignore, ierr)
    328. 

  328. 

  329.           CALL  nl_set_map_proj( grid%id, igarb)
    330. 

  330. 

  331.       VarName='ISURBAN'
    332. 

  332.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    333. 

  333.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    334. 

  334.                               igarb,1,mpi_integer4,             &
    335. 

  335.                               mpi_status_ignore, ierr)
    336. 

  336.           CALL  nl_set_isurban ( grid%id, igarb)
    337. 

  337. 

  338.       VarName='ISWATER'
    339. 

  339.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    340. 

  340.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    341. 

  341.                               igarb,1,mpi_integer4,             &
    342. 

  342.                               mpi_status_ignore, ierr)
    343. 

  343. 	write(0,*) 'setting iswater to be: ', igarb
    344. 

  344.         CALL nl_set_iswater (grid%id, igarb )
    345. 

  345. 

  346.       VarName='ISICE'
    347. 

  347.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    348. 

  348.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    349. 

  349.                               igarb2,1,mpi_integer4,             &
    350. 

  350.                               mpi_status_ignore, ierr)
    351. 

  351. 	write(0,*) 'setting isice to be: ', igarb2
    352. 

  352.         CALL nl_set_isice (grid%id, igarb2 )
    353. 

  353. 

  354.       IF ( igarb .eq. 16 .and. igarb2 .eq. 24 ) THEN
    355. 

  355.       CALL nl_set_mminlu ( grid%id, 'USGS')
    356. 

  356.       ENDIF
    357. 

  357. 

  358.       IF ( igarb .eq. 17 .and. igarb2 .eq. 15 ) THEN
    359. 

  359. ! ambiguous
    360. 

  360.       CALL nl_set_mminlu ( grid%id, 'MODIFIED_IGBP_MODIS_NOAH')
    361. 

  361. !      CALL nl_set_mminlu ( grid%id, 'MODIS')
    362. 

  362.       ENDIF
    363. 

  363. 

  364.       IF ( igarb .eq. 15 .and. igarb2 .eq. 16 ) THEN
    365. 

  365.       CALL nl_set_mminlu ( grid%id, 'SiB')
    366. 

  366.       ENDIF
    367. 

  367. 

  368.       VarName='FLAG_SNOWH'
    369. 

  369.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    370. 

  370.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    371. 

  371.                               igarb,1,mpi_integer4,             &
    372. 

  372.                               mpi_status_ignore, ierr)
    373. 

  373.         flag_snowh=igarb
    374. 

  374. 

  375.       VarName='FLAG_SNOW'
    376. 

  376.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    377. 

  377.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    378. 

  378.                               igarb,1,mpi_integer4,             &
    379. 

  379.                               mpi_status_ignore, ierr)
    380. 

  380.         flag_snow=igarb
    381. 

  381. 

  382.       VarName='FLAG_METGRID'
    383. 

  383.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    384. 

  384. 	if (iret .eq. 0) then
    385. 

  385.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    386. 

  386.                               igarb,1,mpi_integer4,             &
    387. 

  387.                               mpi_status_ignore, ierr)
    388. 

  388.         flag_metgrid=igarb
    389. 

  389. 	endif
    390. 

  390. 

  391.       VarName='FLAG_SOILHGT'
    392. 

  392.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    393. 

  393. 	if (iret .eq. 0) then
    394. 

  394.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    395. 

  395.                               igarb,1,mpi_integer4,             &
    396. 

  396.                               mpi_status_ignore, ierr)
    397. 

  397.         flag_soilhgt=igarb
    398. 

  398. 	endif
    399. 

  399. 

  400.       VarName='FLAG_PSFC'
    401. 

  401.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    402. 

  402. 	if (iret .eq. 0) then
    403. 

  403.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    404. 

  404.                               igarb,1,mpi_integer4,             &
    405. 

  405.                               mpi_status_ignore, ierr)
    406. 

  406.         flag_psfc=igarb
    407. 

  407. 	endif
    408. 

  408. 

  409.       VarName='FLAG_SLP'
    410. 

  410.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    411. 

  411. 	if (iret .eq. 0) then
    412. 

  412.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    413. 

  413.                               igarb,1,mpi_integer4,             &
    414. 

  414.                               mpi_status_ignore, ierr)
    415. 

  415.         flag_slp=igarb
    416. 

  416. 	endif
    417. 

  417. 

  418.       VarName='NUM_METGRID_SOIL_LEVELS'
    419. 

  419.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    420. 

  420.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    421. 

  421.                               igarb,1,mpi_integer4,             &
    422. 

  422.                               mpi_status_ignore, ierr)
    423. 

  423. 

  424.         CALL nl_set_num_metgrid_soil_levels(grid%id, igarb)
    425. 

  425.         num_sw_levels_input=igarb
    426. 

  426. 

  427. 

  428.       VarName='FLAG_SOIL_LEVELS'
    429. 

  429.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    430. 

  430. 	if (iret .eq. 0) then
    431. 

  431.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    432. 

  432.                               igarb,1,mpi_integer4,             &
    433. 

  433.                               mpi_status_ignore, ierr)
    434. 

  434.         flag_soil_levels=igarb
    435. 

  435. 	endif
    436. 

  436. 

  437. 

  438.       VarName='FLAG_SOIL_LAYERS'
    439. 

  439.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    440. 

  440.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    441. 

  441.                               igarb,1,mpi_integer4,             &
    442. 

  442.                               mpi_status_ignore, ierr)
    443. 

  443.         flag_soil_layers=igarb
    444. 

  444. 

  445. 

  446. 

  447.       VarName='ISLAKE'
    448. 

  448.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    449. 

  449.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    450. 

  450.                               igarb,1,mpi_integer4,             &
    451. 

  451.                               mpi_status_ignore, ierr)
    452. 

  452.           CALL  nl_set_islake ( grid%id, igarb)
    453. 

  453. 

  454.       VarName='ISOILWATER'
    455. 

  455.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    456. 

  456.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    457. 

  457.                               igarb,1,mpi_integer4,             &
    458. 

  458.                               mpi_status_ignore, ierr)
    459. 

  459.           CALL  nl_set_isoilwater ( grid%id, igarb)
    460. 

  460. 

  461.       VarName='MOAD_CEN_LAT'
    462. 

  462.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    463. 

  463.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    464. 

  464.                               garb,1,mpi_real4,             &
    465. 

  465.                               mpi_status_ignore, ierr)
    466. 

  466.           CALL  nl_set_moad_cen_lat ( grid%id,garb)
    467. 

  467. 

  468.       VarName='corner_lats'
    469. 

  469.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    470. 

  470.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    471. 

  471.                               lats16,16,mpi_real4,             &
    472. 

  472.                               mpi_status_ignore, ierr)
    473. 

  473. 

  474.       VarName='corner_lons'
    475. 

  475.       call retrieve_index(index,VarName,varname_all,nrecs,iret)
    476. 

  476.         call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    477. 

  477.                               lons16,16,mpi_real4,             &
    478. 

  478.                               mpi_status_ignore, ierr)
    479. 

  479. 

  480. !      VarName='MMINLU'
    481. 

  481. !      call retrieve_index(index,VarName,varname_all,nrecs,iret)
    482. 

  482. !	if (iret .eq. 0) then
    483. 

  483. !       call mpi_file_read_at(iunit,file_offset(index)+5*4,     &
    484. 

  484. !                              dummychar,1,mpi_char,             &
    485. 

  485. !                              mpi_status_ignore, ierr)
    486. 

  486. !        endif
    487. 

  487. 

  488.     hor_size=(IDE-IDS)*(JDE-JDS)
    489. 

  489.     hor_size_u=(IDE+1-IDS)*(JDE-JDS)
    490. 

  490.     hor_size_v=(IDE-IDS)*(JDE+1-JDS)
    491. 

  491. 

  492.     varName='PRES'
    493. 

  493.     allocate(dumdata(IDS:IDE-1,JDS:JDE-1,num_metgrid_levels))
    494. 

  494.     allocate(dumdata_u(IDS:IDE,JDS:JDE-1,num_metgrid_levels))
    495. 

  495.     allocate(dumdata_v(IDS:IDE-1,JDS:JDE,num_metgrid_levels))
    496. 

  496. 

  497.      CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    498. 

  498.      CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    499. 

  499.                           dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    500. 

  500.                           mpi_status_ignore, ierr)
    501. 

  501. 

  502. 

  503.        DO K=1,num_metgrid_levels
    504. 

  504.         DO J=JTS,min(JTE,JDE-1)
    505. 

  505.          DO I=ITS,min(ITE,IDE-1)
    506. 

  506.            grid%p_gc(I,K,J)=dumdata(I,J,K)
    507. 

  507.          ENDDO
    508. 

  508.         ENDDO
    509. 

  509.        ENDDO
    510. 

  510. 

  511. 

  512.     varName='GHT'
    513. 

  513.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    514. 

  514.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    515. 

  515.                              dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    516. 

  516.                              mpi_status_ignore, ierr)
    517. 

  517. 

  518. 

  519.        DO K=1,num_metgrid_levels
    520. 

  520.         DO J=JTS,min(JTE,JDE-1)
    521. 

  521.          DO I=ITS,min(ITE,IDE-1)
    522. 

  522.            grid%ght_gc(I,K,J)=dumdata(I,J,K)
    523. 

  523.          ENDDO
    524. 

  524.         ENDDO
    525. 

  525.        ENDDO
    526. 

  526. 

  527.     varName='VEGCAT'
    528. 

  528.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    529. 

  529.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    530. 

  530.                              dumdata,hor_size,mpi_real4,             &
    531. 

  531.                              mpi_status_ignore, ierr)
    532. 

  532. 

  533.         DO J=JTS,min(JTE,JDE-1)
    534. 

  534.          DO I=ITS,min(ITE,IDE-1)
    535. 

  535.            grid%vegcat(I,J)=dumdata(I,J,1)
    536. 

  536.          ENDDO
    537. 

  537.         ENDDO
    538. 

  538. 

  539. !    varName='SOIL_CAT'
    540. 

  540. !    CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    541. 

  541. !    CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    542. 

  542. !                             dumdata,hor_size,mpi_real4,             &
    543. 

  543. !                             mpi_status_ignore, ierr)
    544. 

  544. !        DO J=JTS,min(JTE,JDE-1)
    545. 

  545. !         DO I=ITS,min(ITE,IDE-1)
    546. 

  546. !           grid%input_soil_cat(I,J)=dumdata(I,J,1)
    547. 

  547. !         ENDDO
    548. 

  548. !        ENDDO
    549. 

  549. 

  550.     varName='CANWAT'
    551. 

  551.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    552. 

  552.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    553. 

  553.                              dumdata,hor_size,mpi_real4,             &
    554. 

  554.                              mpi_status_ignore, ierr)
    555. 

  555. 

  556.         DO J=JTS,min(JTE,JDE-1)
    557. 

  557.          DO I=ITS,min(ITE,IDE-1)
    558. 

  558.            grid%canwat(I,J)=dumdata(I,J,1)
    559. 

  559.          ENDDO
    560. 

  560.         ENDDO
    561. 

  561. 

  562.     varName='SNOW'
    563. 

  563.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    564. 

  564.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    565. 

  565.                              dumdata,hor_size,mpi_real4,             &
    566. 

  566.                              mpi_status_ignore, ierr)
    567. 

  567.         DO J=JTS,min(JTE,JDE-1)
    568. 

  568.          DO I=ITS,min(ITE,IDE-1)
    569. 

  569.            grid%snow(I,J)=dumdata(I,J,1)
    570. 

  570.          ENDDO
    571. 

  571.         ENDDO
    572. 

  572. 

  573.     varName='SNOWH'
    574. 

  574.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    575. 

  575.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    576. 

  576.                              dumdata,hor_size,mpi_real4,             &
    577. 

  577.                              mpi_status_ignore, ierr)
    578. 

  578.         DO J=JTS,min(JTE,JDE-1)
    579. 

  579.          DO I=ITS,min(ITE,IDE-1)
    580. 

  580.            grid%snowh(I,J)=dumdata(I,J,1)
    581. 

  581.          ENDDO
    582. 

  582.         ENDDO
    583. 

  583. 

  584.     varName='SKINTEMP'
    585. 

  585.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    586. 

  586.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    587. 

  587.                              dumdata,hor_size,mpi_real4,             &
    588. 

  588.                              mpi_status_ignore, ierr)
    589. 

  589.         DO J=JTS,min(JTE,JDE-1)
    590. 

  590.          DO I=ITS,min(ITE,IDE-1)
    591. 

  591.            grid%tsk_gc(I,J)=dumdata(I,J,1)
    592. 

  592.          ENDDO
    593. 

  593.         ENDDO
    594. 

  594. 

  595.     varName='SOILHGT'
    596. 

  596.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    597. 

  597.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    598. 

  598.                              dumdata,hor_size,mpi_real4,             &
    599. 

  599.                              mpi_status_ignore, ierr)
    600. 

  600.         DO J=JTS,min(JTE,JDE-1)
    601. 

  601.          DO I=ITS,min(ITE,IDE-1)
    602. 

  602.            grid%toposoil(I,J)=dumdata(I,J,1)
    603. 

  603.          ENDDO
    604. 

  604.         ENDDO
    605. 

  605. 

  606. !    varName='SEAICE'
    607. 

  607. !    CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    608. 

  608. !    CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    609. 

  609. !                             dumdata,hor_size,mpi_real4,             &
    610. 

  610. !                             mpi_status_ignore, ierr)
    611. 

  611. !        DO J=JTS,min(JTE,JDE-1)
    612. 

  612. !         DO I=ITS,min(ITE,IDE-1)
    613. 

  613. !           grid%xice_gc(I,J)=dumdata(I,J,1)
    614. 

  614. !         ENDDO
    615. 

  615. !        ENDDO
    616. 

  616. 

  617.     varName='ST100200'
    618. 

  618.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    619. 

  619.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    620. 

  620.                              dumdata,hor_size,mpi_real4,             &
    621. 

  621.                              mpi_status_ignore, ierr)
    622. 

  622.         DO J=JTS,min(JTE,JDE-1)
    623. 

  623.          DO I=ITS,min(ITE,IDE-1)
    624. 

  624.            grid%st100200(I,J)=dumdata(I,J,1)
    625. 

  625.          ENDDO
    626. 

  626.         ENDDO
    627. 

  627. 

  628.     varName='ST040100'
    629. 

  629.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    630. 

  630.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    631. 

  631.                              dumdata,hor_size,mpi_real4,             &
    632. 

  632.                              mpi_status_ignore, ierr)
    633. 

  633.         DO J=JTS,min(JTE,JDE-1)
    634. 

  634.          DO I=ITS,min(ITE,IDE-1)
    635. 

  635.            grid%st040100(I,J)=dumdata(I,J,1)
    636. 

  636.          ENDDO
    637. 

  637.         ENDDO
    638. 

  638. 

  639.     varName='ST010040'
    640. 

  640.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    641. 

  641.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    642. 

  642.                              dumdata,hor_size,mpi_real4,             &
    643. 

  643.                              mpi_status_ignore, ierr)
    644. 

  644. 

  645.         DO J=JTS,min(JTE,JDE-1)
    646. 

  646.          DO I=ITS,min(ITE,IDE-1)
    647. 

  647.            grid%st010040(I,J)=dumdata(I,J,1)
    648. 

  648.          ENDDO
    649. 

  649.         ENDDO
    650. 

  650. 

  651.     varName='ST000010'
    652. 

  652.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    653. 

  653.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    654. 

  654.                              dumdata,hor_size,mpi_real4,             &
    655. 

  655.                              mpi_status_ignore, ierr)
    656. 

  656. 

  657.         DO J=JTS,min(JTE,JDE-1)
    658. 

  658.          DO I=ITS,min(ITE,IDE-1)
    659. 

  659.            grid%st000010(I,J)=dumdata(I,J,1)
    660. 

  660.          ENDDO
    661. 

  661.         ENDDO
    662. 

  662. 

  663.     varName='SM100200'
    664. 

  664.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    665. 

  665.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    666. 

  666.                              dumdata,hor_size,mpi_real4,             &
    667. 

  667.                              mpi_status_ignore, ierr)
    668. 

  668. 

  669.         DO J=JTS,min(JTE,JDE-1)
    670. 

  670.          DO I=ITS,min(ITE,IDE-1)
    671. 

  671.            grid%sm100200(I,J)=dumdata(I,J,1)
    672. 

  672.          ENDDO
    673. 

  673.         ENDDO
    674. 

  674. 

  675.     varName='SM040100'
    676. 

  676.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    677. 

  677.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    678. 

  678.                              dumdata,hor_size,mpi_real4,             &
    679. 

  679.                              mpi_status_ignore, ierr)
    680. 

  680. 

  681.         DO J=JTS,min(JTE,JDE-1)
    682. 

  682.          DO I=ITS,min(ITE,IDE-1)
    683. 

  683.            grid%sm040100(I,J)=dumdata(I,J,1)
    684. 

  684.          ENDDO
    685. 

  685.         ENDDO
    686. 

  686. 

  687.     varName='SM010040'
    688. 

  688.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    689. 

  689.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    690. 

  690.                              dumdata,hor_size,mpi_real4,             &
    691. 

  691.                              mpi_status_ignore, ierr)
    692. 

  692. 

  693.         DO J=JTS,min(JTE,JDE-1)
    694. 

  694.          DO I=ITS,min(ITE,IDE-1)
    695. 

  695.            grid%sm010040(I,J)=dumdata(I,J,1)
    696. 

  696.          ENDDO
    697. 

  697.         ENDDO
    698. 

  698. 

  699.     varName='SM000010'
    700. 

  700.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    701. 

  701.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    702. 

  702.                              dumdata,hor_size,mpi_real4,             &
    703. 

  703.                              mpi_status_ignore, ierr)
    704. 

  704. 

  705.         DO J=JTS,min(JTE,JDE-1)
    706. 

  706.          DO I=ITS,min(ITE,IDE-1)
    707. 

  707.            grid%sm000010(I,J)=dumdata(I,J,1)
    708. 

  708.          ENDDO
    709. 

  709.         ENDDO
    710. 

  710. 

  711.     varName='PSFC'
    712. 

  712.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    713. 

  713.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    714. 

  714.                              dumdata,hor_size,mpi_real4,             &
    715. 

  715.                              mpi_status_ignore, ierr)
    716. 

  716. 

  717. 	if ( ierr .eq. 0 ) flag_psfc=1
    718. 

  718. 

  719.         DO J=JTS,min(JTE,JDE-1)
    720. 

  720.          DO I=ITS,min(ITE,IDE-1)
    721. 

  721.            grid%psfc(I,J)=dumdata(I,J,1)
    722. 

  722.          ENDDO
    723. 

  723.         ENDDO
    724. 

  724. 

  725.     varName='RH'
    726. 

  726.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    727. 

  727.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    728. 

  728.                              dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    729. 

  729.                              mpi_status_ignore, ierr)
    730. 

  730. 

  731.        DO K=1,num_metgrid_levels
    732. 

  732.         DO J=JTS,min(JTE,JDE-1)
    733. 

  733.          DO I=ITS,min(ITE,IDE-1)
    734. 

  734.            grid%rh_gc(I,K,J)=dumdata(I,J,K)
    735. 

  735.          ENDDO
    736. 

  736.         ENDDO
    737. 

  737.        ENDDO
    738. 

  738. 

  739.     varName='VV'
    740. 

  740.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    741. 

  741.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    742. 

  742.                              dumdata_v,hor_size_v*num_metgrid_levels,mpi_real4,             &
    743. 

  743.                              mpi_status_ignore, ierr)
    744. 

  744. 

  745.        DO K=1,num_metgrid_levels
    746. 

  746.         DO J=JTS,min(JTE,JDE)
    747. 

  747.          DO I=ITS,min(ITE,IDE-1)
    748. 

  748.            grid%v_gc(I,K,J)=dumdata_v(I,J,K)
    749. 

  749. 	if (grid%v_gc(I,K,J) .ne. grid%v_gc(I,K,J) .or. abs(grid%v_gc(I,K,J)) .gt. 100.) then
    750. 

  750. 	write(0,*) 'bad v_gc defined: ', I,K,J,grid%v_gc(I,K,J)
    751. 

  751. 	call wrf_error_fatal(" bad v_gc")
    752. 

  752. 	endif
    753. 

  753.          ENDDO
    754. 

  754.         ENDDO
    755. 

  755.        ENDDO
    756. 

  756. 

  757.     varName='UU'
    758. 

  758.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    759. 

  759.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    760. 

  760.                              dumdata_u,hor_size_u*num_metgrid_levels,mpi_real4,             &
    761. 

  761.                              mpi_status_ignore, ierr)
    762. 

  762.        DO K=1,num_metgrid_levels
    763. 

  763.         DO J=JTS,min(JTE,JDE-1)
    764. 

  764.          DO I=ITS,min(ITE,IDE)
    765. 

  765.            grid%u_gc(I,K,J)=dumdata_u(I,J,K)
    766. 

  766. 	if (grid%u_gc(I,K,J) .ne. grid%u_gc(I,K,J) .or. abs(grid%u_gc(I,K,J)) .gt. 100.) then
    767. 

  767. 	write(0,*) 'bad u_gc defined: ', I,K,J,grid%u_gc(I,K,J)
    768. 

  768. 	call wrf_error_fatal(" bad u_gc")
    769. 

  769. 	endif
    770. 

  770.          ENDDO
    771. 

  771.         ENDDO
    772. 

  772.        ENDDO
    773. 

  773. 

  774.     varName='TT'
    775. 

  775.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    776. 

  776.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    777. 

  777.                              dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    778. 

  778.                              mpi_status_ignore, ierr)
    779. 

  779.        DO K=1,num_metgrid_levels
    780. 

  780.         DO J=JTS,min(JTE,JDE-1)
    781. 

  781.          DO I=ITS,min(ITE,IDE-1)
    782. 

  782.            grid%t_gc(I,K,J)=dumdata(I,J,K)
    783. 

  783. 	if (grid%t_gc(I,K,J) .ne. grid%t_gc(I,K,J) .or. abs(grid%t_gc(I,K,J)) .gt. 350.) then
    784. 

  784. 	write(0,*) 'bad t_gc defined: ', I,K,J,grid%t_gc(I,K,J)
    785. 

  785. 	call wrf_error_fatal(" bad t_gc")
    786. 

  786. 	endif
    787. 

  787.          ENDDO
    788. 

  788.         ENDDO
    789. 

  789.        ENDDO
    790. 

  790. 

  791. !    varName='RWMR'
    792. 

  792. !    CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    793. 

  793. !    CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    794. 

  794. !                             dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    795. 

  795. !                             mpi_status_ignore, ierr)
    796. 

  796. !       DO K=1,num_metgrid_levels
    797. 

  797. !        DO J=JTS,min(JTE,JDE-1)
    798. 

  798. !         DO I=ITS,min(ITE,IDE-1)
    799. 

  799. !           grid%nmm_rwmr_gc(I,J,K)=dumdata(I,J,K)
    800. 

  800. !         ENDDO
    801. 

  801. !        ENDDO
    802. 

  802. !       ENDDO
    803. 

  803. 

  804. !    varName='SNMR'
    805. 

  805. !    CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    806. 

  806. !    CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    807. 

  807. !                             dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    808. 

  808. !                             mpi_status_ignore, ierr)
    809. 

  809. !       DO K=1,num_metgrid_levels
    810. 

  810. !        DO J=JTS,min(JTE,JDE-1)
    811. 

  811. !         DO I=ITS,min(ITE,IDE-1)
    812. 

  812. !           grid%nmm_snmr_gc(I,J,K)=dumdata(I,J,K)
    813. 

  813. !         ENDDO
    814. 

  814. !        ENDDO
    815. 

  815. !       ENDDO
    816. 

  816. 

  817. !    varName='CLWMR'
    818. 

  818. !    CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    819. 

  819. !    CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    820. 

  820. !                             dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    821. 

  821. !                             mpi_status_ignore, ierr)
    822. 

  822. !       DO K=1,num_metgrid_levels
    823. 

  823. !        DO J=JTS,min(JTE,JDE-1)
    824. 

  824. !         DO I=ITS,min(ITE,IDE-1)
    825. 

  825. !           grid%nmm_clwmr_gc(I,J,K)=dumdata(I,J,K)
    826. 

  826. !         ENDDO
    827. 

  827. !        ENDDO
    828. 

  828. !       ENDDO
    829. 

  829. 

  830. !    varName='CICE'
    831. 

  831. !    CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    832. 

  832. !    CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    833. 

  833. !                             dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    834. 

  834. !                             mpi_status_ignore, ierr)
    835. 

  835. !       DO K=1,num_metgrid_levels
    836. 

  836. !        DO J=JTS,min(JTE,JDE-1)
    837. 

  837. !         DO I=ITS,min(ITE,IDE-1)
    838. 

  838. !           grid%nmm_cice_gc(I,J,K)=dumdata(I,J,K)
    839. 

  839. !         ENDDO
    840. 

  840. !        ENDDO
    841. 

  841. !       ENDDO
    842. 

  842. 

  843. !    varName='FRIMEF'
    844. 

  844. !    CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    845. 

  845. !    CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    846. 

  846. !                             dumdata,hor_size*num_metgrid_levels,mpi_real4,             &
    847. 

  847. !                             mpi_status_ignore, ierr)
    848. 

  848. !       DO K=1,num_metgrid_levels
    849. 

  849. !        DO J=JTS,min(JTE,JDE-1)
    850. 

  850. !         DO I=ITS,min(ITE,IDE-1)
    851. 

  851. !           grid%nmm_rimef_gc(I,J,K)=dumdata(I,J,K)
    852. 

  852. !         ENDDO
    853. 

  853. !        ENDDO
    854. 

  854. !       ENDDO
    855. 

  855. 

  856. 

  857.      varName='PMSL'
    858. 

  858.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    859. 

  859.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    860. 

  860.                              dumdata,hor_size,mpi_real4,             &
    861. 

  861.                              mpi_status_ignore, ierr)
    862. 

  862.         DO J=JTS,min(JTE,JDE-1)
    863. 

  863.          DO I=ITS,min(ITE,IDE-1)
    864. 

  864.            grid%pslv_gc(I,J)=dumdata(I,J,1)
    865. 

  865.          ENDDO
    866. 

  866.         ENDDO
    867. 

  867. 

  868. 

  869.     varName='SLOPECAT'
    870. 

  870.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    871. 

  871.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    872. 

  872.                              dumdata,hor_size,mpi_real4,             &
    873. 

  873.                              mpi_status_ignore, ierr)
    874. 

  874.         DO J=JTS,min(JTE,JDE-1)
    875. 

  875.          DO I=ITS,min(ITE,IDE-1)
    876. 

  876.            grid%slopecat(I,J)=dumdata(I,J,1)
    877. 

  877.          ENDDO
    878. 

  878.         ENDDO
    879. 

  879. 

  880.     varName='SNOALB'
    881. 

  881.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    882. 

  882.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    883. 

  883.                              dumdata,hor_size,mpi_real4,             &
    884. 

  884.                              mpi_status_ignore, ierr)
    885. 

  885. 

  886.         DO J=JTS,min(JTE,JDE-1)
    887. 

  887.          DO I=ITS,min(ITE,IDE-1)
    888. 

  888.            grid%snoalb(I,J)=dumdata(I,J,1)
    889. 

  889.          ENDDO
    890. 

  890.         ENDDO
    891. 

  891. 

  892.          num_veg_cat      = SIZE ( grid%landusef , DIM=2 )
    893. 

  893.          num_soil_top_cat = SIZE ( grid%soilctop , DIM=2 )
    894. 

  894.          num_soil_bot_cat = SIZE ( grid%soilcbot , DIM=2 )
    895. 

  895. 

  896.     varName='GREENFRAC'
    897. 

  897.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    898. 

  898.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    899. 

  899.                              dumdata,hor_size*12,mpi_real4,             &
    900. 

  900.                              mpi_status_ignore, ierr)
    901. 

  901. 

  902.        DO K=1,12
    903. 

  903.         DO J=JTS,min(JTE,JDE-1)
    904. 

  904.          DO I=ITS,min(ITE,IDE-1)
    905. 

  905.            grid%greenfrac(I,K,J)=dumdata(I,J,K)
    906. 

  906.          ENDDO
    907. 

  907.         ENDDO
    908. 

  908.        ENDDO
    909. 

  909. 

  910.     varName='ALBEDO12M'
    911. 

  911.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    912. 

  912.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    913. 

  913.                              dumdata,hor_size*12,mpi_real4,             &
    914. 

  914.                              mpi_status_ignore, ierr)
    915. 

  915. 

  916.        DO K=1,12
    917. 

  917.         DO J=JTS,min(JTE,JDE-1)
    918. 

  918.          DO I=ITS,min(ITE,IDE-1)
    919. 

  919.            grid%albedo12m(I,K,J)=dumdata(I,J,K)
    920. 

  920.          ENDDO
    921. 

  921.         ENDDO
    922. 

  922.        ENDDO
    923. 

  923. 

  924.     varName='SOILCBOT'
    925. 

  925.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    926. 

  926.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    927. 

  927.                              dumdata,hor_size*num_soil_bot_cat,mpi_real4,             &
    928. 

  928.                              mpi_status_ignore, ierr)
    929. 

  929. 

  930.        DO K=1,num_soil_bot_cat
    931. 

  931.         DO J=JTS,min(JTE,JDE-1)
    932. 

  932.          DO I=ITS,min(ITE,IDE-1)
    933. 

  933.            grid%soilcbot(I,K,J)=dumdata(I,J,K)
    934. 

  934.          ENDDO
    935. 

  935.         ENDDO
    936. 

  936.        ENDDO
    937. 

  937. 

  938.     varName='SOILCAT'
    939. 

  939.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    940. 

  940.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    941. 

  941.                              dumdata,hor_size,mpi_real4,             &
    942. 

  942.                              mpi_status_ignore, ierr)
    943. 

  943. 

  944.         DO J=JTS,min(JTE,JDE-1)
    945. 

  945.          DO I=ITS,min(ITE,IDE-1)
    946. 

  946.            grid%soilcat(I,J)=dumdata(I,J,1)
    947. 

  947.          ENDDO
    948. 

  948.         ENDDO
    949. 

  949. 

  950. 	write(0,*) 'veg_cat and soil_cat sizes:::: ', num_veg_cat , num_soil_top_cat
    951. 

  951. 

  952.     varName='SOILCTOP'
    953. 

  953.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    954. 

  954.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    955. 

  955.                              dumdata,hor_size*num_soil_top_cat,mpi_real4,             &
    956. 

  956.                              mpi_status_ignore, ierr)
    957. 

  957.        DO K=1,num_soil_top_cat
    958. 

  958.         DO J=JTS,min(JTE,JDE-1)
    959. 

  959.          DO I=ITS,min(ITE,IDE-1)
    960. 

  960.            grid%soilctop(I,K,J)=dumdata(I,J,K)
    961. 

  961.          ENDDO
    962. 

  962.         ENDDO
    963. 

  963.        ENDDO
    964. 

  964. 

  965.     varName='SOILTEMP'
    966. 

  966.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    967. 

  967.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    968. 

  968.                              dumdata,hor_size,mpi_real4,             &
    969. 

  969.                              mpi_status_ignore, ierr)
    970. 

  970. 

  971.         DO J=JTS,min(JTE,JDE-1)
    972. 

  972.          DO I=ITS,min(ITE,IDE-1)
    973. 

  973.            grid%tmn_gc(I,J)=dumdata(I,J,1)
    974. 

  974.          ENDDO
    975. 

  975.         ENDDO
    976. 

  976. 

  977. !    varName='HGT_V'
    978. 

  978. !    CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    979. 

  979. !    CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    980. 

  980. !                             dumdata,hor_size,mpi_real4,             &
    981. 

  981. !                             mpi_status_ignore, ierr)
    982. 

  982. !
    983. 

  983. !        DO J=JTS,min(JTE,JDE-1)
    984. 

  984. !         DO I=ITS,min(ITE,IDE-1)
    985. 

  985. !           grid%nmm_htv_gc(I,J)=dumdata(I,J,1)
    986. 

  986. !         ENDDO
    987. 

  987. !        ENDDO
    988. 

  988. 

  989.     varName='HGT_M'
    990. 

  990.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    991. 

  991.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    992. 

  992.                              dumdata,hor_size,mpi_real4,             &
    993. 

  993.                              mpi_status_ignore, ierr)
    994. 

  994. 

  995.         DO J=JTS,min(JTE,JDE-1)
    996. 

  996.          DO I=ITS,min(ITE,IDE-1)
    997. 

  997.            grid%ht_gc(I,J)=dumdata(I,J,1)
    998. 

  998.          ENDDO
    999. 

  999.         ENDDO
    1000. 

  1000. 

  1001.     varName='LU_INDEX'
    1002. 

  1002.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1003. 

  1003.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1004. 

  1004.                              dumdata,hor_size,mpi_real4,             &
    1005. 

  1005.                              mpi_status_ignore, ierr)
    1006. 

  1006. 

  1007.         DO J=JTS,min(JTE,JDE-1)
    1008. 

  1008.          DO I=ITS,min(ITE,IDE-1)
    1009. 

  1009.            grid%lu_index(I,J)=dumdata(I,J,1)
    1010. 

  1010.          ENDDO
    1011. 

  1011.         ENDDO
    1012. 

  1012. 

  1013.     varName='LANDUSEF'
    1014. 

  1014.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1015. 

  1015.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1016. 

  1016.                              dumdata,hor_size*num_veg_cat,mpi_real4,             &
    1017. 

  1017.                              mpi_status_ignore, ierr)
    1018. 

  1018. 

  1019.        DO K=1,num_veg_cat
    1020. 

  1020.         DO J=JTS,min(JTE,JDE-1)
    1021. 

  1021.          DO I=ITS,min(ITE,IDE-1)
    1022. 

  1022.            grid%landusef(I,K,J)=dumdata(I,J,K)
    1023. 

  1023.          ENDDO
    1024. 

  1024.         ENDDO
    1025. 

  1025.        ENDDO
    1026. 

  1026. 

  1027.     varName='LANDMASK'
    1028. 

  1028.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1029. 

  1029.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1030. 

  1030.                              dumdata,hor_size,mpi_real4,             &
    1031. 

  1031.                              mpi_status_ignore, ierr)
    1032. 

  1032. 

  1033.         DO J=JTS,min(JTE,JDE-1)
    1034. 

  1034.          DO I=ITS,min(ITE,IDE-1)
    1035. 

  1035.            grid%landmask(I,J)=dumdata(I,J,1)
    1036. 

  1036.          ENDDO
    1037. 

  1037.         ENDDO
    1038. 

  1038. 

  1039.     varName='F'
    1040. 

  1040.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1041. 

  1041.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1042. 

  1042.                              dumdata,hor_size,mpi_real4,             &
    1043. 

  1043.                              mpi_status_ignore, ierr)
    1044. 

  1044.         DO J=JTS,min(JTE,JDE-1)
    1045. 

  1045.          DO I=ITS,min(ITE,IDE-1)
    1046. 

  1046.            grid%f(I,J)=dumdata(I,J,1)
    1047. 

  1047.          ENDDO
    1048. 

  1048.         ENDDO
    1049. 

  1049. 

  1050.     varName='E'
    1051. 

  1051.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1052. 

  1052.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1053. 

  1053.                              dumdata,hor_size,mpi_real4,             &
    1054. 

  1054.                              mpi_status_ignore, ierr)
    1055. 

  1055.         DO J=JTS,min(JTE,JDE-1)
    1056. 

  1056.          DO I=ITS,min(ITE,IDE-1)
    1057. 

  1057.            grid%e(I,J)=dumdata(I,J,1)
    1058. 

  1058.          ENDDO
    1059. 

  1059.         ENDDO
    1060. 

  1060. 

  1061.     varName='COSALPHA'
    1062. 

  1062.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1063. 

  1063.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1064. 

  1064.                              dumdata,hor_size,mpi_real4,             &
    1065. 

  1065.                              mpi_status_ignore, ierr)
    1066. 

  1066.         DO J=JTS,min(JTE,JDE-1)
    1067. 

  1067.          DO I=ITS,min(ITE,IDE-1)
    1068. 

  1068.            grid%cosa(I,J)=dumdata(I,J,1)
    1069. 

  1069.          ENDDO
    1070. 

  1070.         ENDDO
    1071. 

  1071. 

  1072.     varName='SINALPHA'
    1073. 

  1073.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1074. 

  1074.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1075. 

  1075.                              dumdata,hor_size,mpi_real4,             &
    1076. 

  1076.                              mpi_status_ignore, ierr)
    1077. 

  1077.         DO J=JTS,min(JTE,JDE-1)
    1078. 

  1078.          DO I=ITS,min(ITE,IDE-1)
    1079. 

  1079.            grid%sina(I,J)=dumdata(I,J,1)
    1080. 

  1080.          ENDDO
    1081. 

  1081.         ENDDO
    1082. 

  1082. 

  1083.     varName='MAPFAC_U'
    1084. 

  1084.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1085. 

  1085.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1086. 

  1086.                              dumdata_u,hor_size_u,mpi_real4,             &
    1087. 

  1087.                              mpi_status_ignore, ierr)
    1088. 

  1088.         DO J=JTS,min(JTE,JDE-1)
    1089. 

  1089.          DO I=ITS,min(ITE,IDE)
    1090. 

  1090.            grid%msfu(I,J)=dumdata_u(I,J,1)
    1091. 

  1091. 

  1092. !! bandaid for newly created WPS geogrid static files
    1093. 

  1093.         if (grid%msfu(I,J) .lt. 0.7) then
    1094. 

  1094.         write(0,*) 'weird msfu at I,J: ', I,J,grid%msfu(I,J)
    1095. 

  1095. 

  1096.         if(J .eq. min(JTE,JDE-1)) then
    1097. 

  1097.         grid%msfu(I,J)=dumdata_u(I,J-1,1)
    1098. 

  1098.         write(0,*) 'changing msfu to: ',I,J,  grid%msfu(I,J)
    1099. 

  1099.         endif
    1100. 

  1100.         
    1101. 

  1101.         endif
    1102. 

  1102. !! end bandaid 
    1103. 

  1103. 

  1104.          ENDDO
    1105. 

  1105.         ENDDO
    1106. 

  1106. 

  1107.     varName='MAPFAC_V'
    1108. 

  1108.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1109. 

  1109.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1110. 

  1110.                              dumdata_v,hor_size_v,mpi_real4,             &
    1111. 

  1111.                              mpi_status_ignore, ierr)
    1112. 

  1112.         DO J=JTS,min(JTE,JDE)
    1113. 

  1113.          DO I=ITS,min(ITE,IDE-1)
    1114. 

  1114.            grid%msfv(I,J)=dumdata_v(I,J,1)
    1115. 

  1115. 

  1116.         if (grid%msfv(I,J) .lt. 0.7 ) then
    1117. 

  1117.         write(0,*) 'weird msfv at I,J: ', I,J,grid%msfv(I,J)
    1118. 

  1118.         grid%msfv(I,J)=dumdata_v(I,J-1,1)
    1119. 

  1119.         if( J .eq. min(JTE,JDE)) then
    1120. 

  1120.         write(0,*) 'changing msfv to: ',I,J,  grid%msfv(I,J)
    1121. 

  1121.         endif
    1122. 

  1122. 

  1123.         endif
    1124. 

  1124. 

  1125.          ENDDO
    1126. 

  1126.         ENDDO
    1127. 

  1127. 

  1128.     varName='MAPFAC_M'
    1129. 

  1129.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1130. 

  1130.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1131. 

  1131.                              dumdata,hor_size,mpi_real4,             &
    1132. 

  1132.                              mpi_status_ignore, ierr)
    1133. 

  1133.         DO J=JTS,min(JTE,JDE-1)
    1134. 

  1134.          DO I=ITS,min(ITE,IDE-1)
    1135. 

  1135.            grid%msft(I,J)=dumdata(I,J,1)
    1136. 

  1136.          ENDDO
    1137. 

  1137.         ENDDO
    1138. 

  1138. 

  1139.     varName='CLAT'
    1140. 

  1140.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1141. 

  1141.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1142. 

  1142.                              dumdata,hor_size,mpi_real4,             &
    1143. 

  1143.                              mpi_status_ignore, ierr)
    1144. 

  1144.         DO J=JTS,min(JTE,JDE-1)
    1145. 

  1145.          DO I=ITS,min(ITE,IDE-1)
    1146. 

  1146.            grid%clat(I,J)=dumdata(I,J,1)
    1147. 

  1147.          ENDDO
    1148. 

  1148.         ENDDO
    1149. 

  1149. 

  1150.     varName='XLONG_U'
    1151. 

  1151.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1152. 

  1152.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1153. 

  1153.                              dumdata_u,hor_size_u,mpi_real4,             &
    1154. 

  1154.                              mpi_status_ignore, ierr)
    1155. 

  1155.         DO J=JTS,min(JTE,JDE-1)
    1156. 

  1156.          DO I=ITS,min(ITE,IDE)
    1157. 

  1157.            grid%xlong_u(I,J)=dumdata_u(I,J,1)
    1158. 

  1158.          ENDDO
    1159. 

  1159.         ENDDO
    1160. 

  1160. 

  1161.     varName='XLAT_U'
    1162. 

  1162.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1163. 

  1163.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1164. 

  1164.                              dumdata_u,hor_size_u,mpi_real4,             &
    1165. 

  1165.                              mpi_status_ignore, ierr)
    1166. 

  1166.         DO J=JTS,min(JTE,JDE-1)
    1167. 

  1167.          DO I=ITS,min(ITE,IDE)
    1168. 

  1168.            grid%xlat_u(I,J)=dumdata_u(I,J,1)
    1169. 

  1169.          ENDDO
    1170. 

  1170.         ENDDO
    1171. 

  1171. 

  1172.     varName='XLONG_V'
    1173. 

  1173.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1174. 

  1174.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1175. 

  1175.                              dumdata_v,hor_size_v,mpi_real4,             &
    1176. 

  1176.                              mpi_status_ignore, ierr)
    1177. 

  1177.         DO J=JTS,min(JTE,JDE)
    1178. 

  1178.          DO I=ITS,min(ITE,IDE-1)
    1179. 

  1179.            grid%xlong_v(I,J)=dumdata_v(I,J,1)
    1180. 

  1180.          ENDDO
    1181. 

  1181.         ENDDO
    1182. 

  1182. 

  1183.     varName='XLAT_V'
    1184. 

  1184.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1185. 

  1185.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1186. 

  1186.                              dumdata_v,hor_size_v,mpi_real4,             &
    1187. 

  1187.                              mpi_status_ignore, ierr)
    1188. 

  1188.         DO J=JTS,min(JTE,JDE)
    1189. 

  1189.          DO I=ITS,min(ITE,IDE-1)
    1190. 

  1190.            grid%xlat_v(I,J)=dumdata_v(I,J,1)
    1191. 

  1191.          ENDDO
    1192. 

  1192.         ENDDO
    1193. 

  1193. 

  1194.     varName='XLONG_M'
    1195. 

  1195.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1196. 

  1196.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1197. 

  1197.                              dumdata,hor_size,mpi_real4,             &
    1198. 

  1198.                              mpi_status_ignore, ierr)
    1199. 

  1199. 

  1200.         DO J=JTS,min(JTE,JDE-1)
    1201. 

  1201.          DO I=ITS,min(ITE,IDE-1)
    1202. 

  1202.            grid%xlong_gc(I,J)=dumdata(I,J,1)
    1203. 

  1203.          ENDDO
    1204. 

  1204.         ENDDO
    1205. 

  1205. 

  1206. 	write(0,*) 'reading XLAT_M'
    1207. 

  1207.     varName='XLAT_M'
    1208. 

  1208.     CALL retrieve_index(index,VarName,varname_all,nrecs,iret)
    1209. 

  1209.     CALL mpi_file_read_at(iunit,file_offset(index+1),     &
    1210. 

  1210.                              dumdata,hor_size,mpi_real4,             &
    1211. 

  1211.                              mpi_status_ignore, ierr)
    1212. 

  1212. 

  1213.         DO J=JTS,min(JTE,JDE-1)
    1214. 

  1214.          DO I=ITS,min(ITE,IDE-1)
    1215. 

  1215.            grid%xlat_gc(I,J)=dumdata(I,J,1)
    1216. 

  1216.          ENDDO
    1217. 

  1217.         ENDDO
    1218. 

  1218. 	write(0,*) 'xlat_gc defined'
    1219. 

  1219. 

  1220.       call mpi_file_close(mpi_comm_world, ierr)
    1221. 

  1221. 

  1222. 	write(0,*) 'to ST000010 def'
    1223. 

  1223.        varName='ST000010'
    1224. 

  1224.        flag_st000010 = 1
    1225. 

  1225.        num_st_levels_input = num_st_levels_input + 1
    1226. 

  1226.        st_levels_input(num_st_levels_input) = char2int2(varName(3:8))
    1227. 

  1227.        DO J=JTS,min(JTE,JDE-1)
    1228. 

  1228.         DO I=ITS,min(ITE,IDE-1)
    1229. 

  1229.            st_input(I,num_st_levels_input + 1,J) = grid%st000010(i,j)
    1230. 

  1230.         ENDDO
    1231. 

  1231.        ENDDO
    1232. 

  1232. 	write(0,*) 'past ST000010 def'
    1233. 

  1233. 

  1234.        varName='ST010040'
    1235. 

  1235.        flag_st010040 = 1
    1236. 

  1236.        num_st_levels_input = num_st_levels_input + 1
    1237. 

  1237.        st_levels_input(num_st_levels_input) = char2int2(varName(3:8))
    1238. 

  1238.        DO J=JTS,min(JTE,JDE-1)
    1239. 

  1239.         DO I=ITS,min(ITE,IDE-1)
    1240. 

  1240.             st_input(I,num_st_levels_input + 1,J) = grid%st010040(i,j)
    1241. 

  1241.         ENDDO
    1242. 

  1242.        ENDDO
    1243. 

  1243. 

  1244.        varName='ST040100'
    1245. 

  1245.        flag_st040100 = 1
    1246. 

  1246.        num_st_levels_input = num_st_levels_input + 1
    1247. 

  1247.        st_levels_input(num_st_levels_input) = char2int2(varName(3:8))
    1248. 

  1248.        DO J=JTS,min(JTE,JDE-1)
    1249. 

  1249.         DO I=ITS,min(ITE,IDE-1)
    1250. 

  1250.               st_input(I,num_st_levels_input + 1,J) = grid%st040100(i,j)
    1251. 

  1251.         ENDDO
    1252. 

  1252.        ENDDO
    1253. 

  1253.  
    1254. 

  1254.        varName='ST100200'
    1255. 

  1255.        flag_st100200 = 1
    1256. 

  1256.        num_st_levels_input = num_st_levels_input + 1
    1257. 

  1257.        st_levels_input(num_st_levels_input) = char2int2(varName(3:8))
    1258. 

  1258.        DO J=JTS,min(JTE,JDE-1)
    1259. 

  1259.         DO I=ITS,min(ITE,IDE-1)
    1260. 

  1260.               st_input(I,num_st_levels_input + 1,J) = grid%st100200(i,j)
    1261. 

  1261.         ENDDO
    1262. 

  1262.        ENDDO
    1263. 

  1263. 

  1264.        varName='SM000010'
    1265. 

  1265.        flag_sm000010 = 1
    1266. 

  1266.        num_sm_levels_input = num_sm_levels_input + 1
    1267. 

  1267.        sm_levels_input(num_sm_levels_input) = char2int2(varName(3:8))
    1268. 

  1268.        DO J=JTS,min(JTE,JDE-1)
    1269. 

  1269.         DO I=ITS,min(ITE,IDE-1)
    1270. 

  1270.            sm_input(I,num_sm_levels_input + 1,J) = grid%sm000010(i,j)
    1271. 

  1271.         ENDDO
    1272. 

  1272.        ENDDO
    1273. 

  1273. 

  1274.        varName='SM010040'
    1275. 

  1275.        flag_sm010040 = 1
    1276. 

  1276.        num_sm_levels_input = num_sm_levels_input + 1
    1277. 

  1277.        sm_levels_input(num_sm_levels_input) = char2int2(varName(3:8))
    1278. 

  1278.        DO J=JTS,min(JTE,JDE-1)
    1279. 

  1279.         DO I=ITS,min(ITE,IDE-1)
    1280. 

  1280.             sm_input(I,num_sm_levels_input + 1,J) = grid%sm010040(i,j)
    1281. 

  1281.         ENDDO
    1282. 

  1282.        ENDDO
    1283. 

  1283. 

  1284.        varName='SM040100'
    1285. 

  1285.        flag_sm040100 = 1
    1286. 

  1286.        num_sm_levels_input = num_sm_levels_input + 1
    1287. 

  1287.        sm_levels_input(num_sm_levels_input) = char2int2(varName(3:8))
    1288. 

  1288.        DO J=JTS,min(JTE,JDE-1)
    1289. 

  1289.         DO I=ITS,min(ITE,IDE-1)
    1290. 

  1290.               sm_input(I,num_sm_levels_input + 1,J) = grid%sm040100(i,j)
    1291. 

  1291.         ENDDO
    1292. 

  1292.        ENDDO
    1293. 

  1293.  
    1294. 

  1294.        varName='SM100200'
    1295. 

  1295.        flag_sm100200 = 1
    1296. 

  1296.        num_sm_levels_input = num_sm_levels_input + 1
    1297. 

  1297.        sm_levels_input(num_sm_levels_input) = char2int2(varName(3:8))
    1298. 

  1298.        DO J=JTS,min(JTE,JDE-1)
    1299. 

  1299.         DO I=ITS,min(ITE,IDE-1)
    1300. 

  1300.               sm_input(I,num_sm_levels_input + 1,J) = grid%sm100200(i,j)
    1301. 

  1301.         ENDDO
    1302. 

  1302.        ENDDO
    1303. 

  1303. 

  1304. !           flag_sst = 1
    1305. 

  1305. 

  1306.         write(0,*) 'maxval st_input(1): ', maxval(st_input(:,1,:))
    1307. 

  1307.         write(0,*) 'maxval st_input(2): ', maxval(st_input(:,2,:))
    1308. 

  1308.         write(0,*) 'maxval st_input(3): ', maxval(st_input(:,3,:))
    1309. 

  1309.         write(0,*) 'maxval st_input(4): ', maxval(st_input(:,4,:))
    1310. 

  1310. 

  1311.         DEALLOCATE(pmsl)
    1312. 

  1312.         DEALLOCATE(psfc_in)
    1313. 

  1313.         DEALLOCATE(dumdata)
    1314. 

  1314.         DEALLOCATE(dumdata_u)
    1315. 

  1315.         DEALLOCATE(dumdata_v)
    1316. 

  1316. 

  1317. #endif
    1318. 

  1318.      end subroutine read_wps
    1319. 

  1319. 

  1320. ! -------------------------------------------------------------------------
    1321. 

  1321. ! -------------------------------------------------------------------------
    1322. 

  1322. 

  1323. !!!! MPI-IO pieces
    1324. 

  1324. 

  1325. subroutine retrieve_index(index,string,varname_all,nrecs,iret)
    1326. 

  1326. !$$$  subprogram documentation block
    1327. 

  1327. !                .      .    .                                       .
    1328. 

  1328. ! subprogram:    retrieve_index  get record number of desired variable
    1329. 

  1329. !   prgmmr: parrish          org: np22                date: 2004-11-29
    1330. 

  1330. !
    1331. 

  1331. ! abstract: by examining previously generated inventory of wrf binary restart file,
    1332. 

  1332. !             find record number that contains the header record for variable
    1333. 

  1333. !             identified by input character variable "string".
    1334. 

  1334. !
    1335. 

  1335. ! program history log:
    1336. 

  1336. !   2004-11-29  parrish
    1337. 

  1337. !
    1338. 

  1338. !   input argument list:
    1339. 

  1339. !     string           - mnemonic for variable desired
    1340. 

  1340. !     varname_all      - list of all mnemonics obtained from inventory of file
    1341. 

  1341. !     nrecs            - total number of sequential records counted in wrf
    1342. 

  1342. !                        binary restart file
    1343. 

  1343. !
    1344. 

  1344. !   output argument list:
    1345. 

  1345. !     index            - desired record number
    1346. 

  1346. !     iret             - return status, set to 0 if variable was found,
    1347. 

  1347. !                        non-zero if not.
    1348. 

  1348. !
    1349. 

  1349. ! attributes:
    1350. 

  1350. !   language: f90
    1351. 

  1351. !   machine:  ibm RS/6000 SP
    1352. 

  1352. !
    1353. 

  1353. !$$$
    1354. 

  1354. 

  1355.   implicit none
    1356. 

  1356. 

  1357.   integer,intent(out)::iret
    1358. 

  1358.   integer,intent(in)::nrecs
    1359. 

  1359.   integer,intent(out):: index
    1360. 

  1360.   character(*), intent(in):: string
    1361. 

  1361.   character(132),intent(in)::varname_all(nrecs)
    1362. 

  1362. 

  1363.   integer i
    1364. 

  1364. 

  1365.   iret=0
    1366. 

  1366. 

  1367.   do i=1,nrecs
    1368. 

  1368.    if(trim(string) == trim(varname_all(i))) then
    1369. 

  1369.       index=i
    1370. 

  1370.       return
    1371. 

  1371.    end if
    1372. 

  1372.   end do
    1373. 

  1373. 

  1374.   write(6,*)' problem reading wrf nmm binary file, rec id "',trim(string),'" not found'
    1375. 

  1375. 

  1376.   iret=-1
    1377. 

  1377. 

  1378. end subroutine retrieve_index
    1379. 

  1379. subroutine next_buf(in_unit,buf,nextbyte,locbyte,thisblock,lrecl,nreads,lastbuf)
    1380. 

  1380. !$$$  subprogram documentation block
    1381. 

  1381. !                .      .    .                                       .
    1382. 

  1382. ! subprogram:    next_buf    bring in next direct access block
    1383. 

  1383. !   prgmmr: parrish          org: np22                date: 2004-11-29
    1384. 

  1384. !
    1385. 

  1385. ! abstract: bring in next direct access block when needed, as the file is scanned
    1386. 

  1386. !             from beginning to end during counting and invento…
    1387.