PageRenderTime 51ms CodeModel.GetById 18ms RepoModel.GetById 0ms app.codeStats 1ms

/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

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

  1. MODULE module_si_io_nmm
  2. USE module_optional_input
  3. IMPLICIT NONE
  4. !! FROM MODULE_KINDS
  5. ! The numerical data types defined in this module are:
  6. ! i_byte - specification kind for byte (1-byte) integer variable
  7. ! i_short - specification kind for short (2-byte) integer variable
  8. ! i_long - specification kind for long (4-byte) integer variable
  9. ! i_llong - specification kind for double long (8-byte) integer variable
  10. ! r_single - specification kind for single precision (4-byte) real variable
  11. ! r_double - specification kind for double precision (8-byte) real variable
  12. ! r_quad - specification kind for quad precision (16-byte) real variable
  13. !
  14. ! i_kind - generic specification kind for default integer
  15. ! r_kind - generic specification kind for default floating point
  16. !
  17. !
  18. ! Integer type definitions below
  19. ! Integer types
  20. integer, parameter, public :: i_byte = selected_int_kind(1) ! byte integer
  21. integer, parameter, public :: i_short = selected_int_kind(4) ! short integer
  22. integer, parameter, public :: i_long = selected_int_kind(8) ! long integer
  23. integer, parameter, private :: llong_t = selected_int_kind(16) ! llong integer
  24. integer, parameter, public :: i_llong = max( llong_t, i_long )
  25. ! Expected 8-bit byte sizes of the integer kinds
  26. integer, parameter, public :: num_bytes_for_i_byte = 1
  27. integer, parameter, public :: num_bytes_for_i_short = 2
  28. integer, parameter, public :: num_bytes_for_i_long = 4
  29. integer, parameter, public :: num_bytes_for_i_llong = 8
  30. ! Define arrays for default definition
  31. integer, parameter, private :: num_i_kinds = 4
  32. integer, parameter, dimension( num_i_kinds ), private :: integer_types = (/ &
  33. i_byte, i_short, i_long, i_llong /)
  34. integer, parameter, dimension( num_i_kinds ), private :: integer_byte_sizes = (/ &
  35. num_bytes_for_i_byte, num_bytes_for_i_short, &
  36. num_bytes_for_i_long, num_bytes_for_i_llong /)
  37. ! Default values
  38. ! **** CHANGE THE FOLLOWING TO CHANGE THE DEFAULT INTEGER TYPE KIND ***
  39. integer, parameter, private :: default_integer = 2 ! 1=byte,
  40. ! 2=short,
  41. ! 3=long,
  42. ! 4=llong
  43. integer, parameter, public :: i_kind = integer_types( default_integer )
  44. integer, parameter, public :: num_bytes_for_i_kind = &
  45. integer_byte_sizes( default_integer )
  46. ! Real definitions below
  47. ! Real types
  48. integer, parameter, public :: r_single = selected_real_kind(6) ! single precision
  49. integer, parameter, public :: r_double = selected_real_kind(15) ! double precision
  50. integer, parameter, private :: quad_t = selected_real_kind(20) ! quad precision
  51. integer, parameter, public :: r_quad = max( quad_t, r_double )
  52. ! Expected 8-bit byte sizes of the real kinds
  53. integer, parameter, public :: num_bytes_for_r_single = 4
  54. integer, parameter, public :: num_bytes_for_r_double = 8
  55. integer, parameter, public :: num_bytes_for_r_quad = 16
  56. ! Define arrays for default definition
  57. integer, parameter, private :: num_r_kinds = 3
  58. integer, parameter, dimension( num_r_kinds ), private :: real_kinds = (/ &
  59. r_single, r_double, r_quad /)
  60. integer, parameter, dimension( num_r_kinds ), private :: real_byte_sizes = (/ &
  61. num_bytes_for_r_single, num_bytes_for_r_double, &
  62. num_bytes_for_r_quad /)
  63. ! Default values
  64. ! **** CHANGE THE FOLLOWING TO CHANGE THE DEFAULT REAL TYPE KIND ***
  65. integer, parameter, private :: default_real = 2 ! 1=single,
  66. ! 2=double,
  67. !! END FROM MODULE_KINDS
  68. ! Input 3D meteorological fields.
  69. REAL , DIMENSION(:,:,:) , ALLOCATABLE :: u_input , v_input , &
  70. q_input , t_input
  71. ! Input 3D LSM fields.
  72. REAL , DIMENSION(:,:,:) , ALLOCATABLE :: landuse_frac_input , &
  73. soil_top_cat_input , &
  74. soil_bot_cat_input
  75. REAL, ALLOCATABLE:: htm_in(:,:,:),vtm_in(:,:,:)
  76. ! Input 2D surface fields.
  77. REAL , DIMENSION(:,:) , ALLOCATABLE,save :: soilt010_input , soilt040_input , &
  78. soilt100_input , soilt200_input , &
  79. soilm010_input , soilm040_input , &
  80. soilm100_input , soilm200_input , &
  81. psfc_in,pmsl
  82. REAL , DIMENSION(:,:) , ALLOCATABLE :: lat_wind, lon_wind
  83. REAL , DIMENSION(:) , ALLOCATABLE :: DETA_in, AETA_in, ETAX_in
  84. REAL , DIMENSION(:) , ALLOCATABLE :: DETA1_in, AETA1_in, ETA1_in
  85. REAL , DIMENSION(:) , ALLOCATABLE :: DETA2_in, AETA2_in, ETA2_in, DFL_in
  86. REAL , DIMENSION(:,:,:), ALLOCATABLE,save :: st_inputx , sm_inputx, sw_inputx
  87. ! Local input arrays
  88. REAL,DIMENSION(:,:),ALLOCATABLE :: dum2d
  89. INTEGER,DIMENSION(:,:),ALLOCATABLE :: idum2d
  90. REAL,DIMENSION(:,:,:),ALLOCATABLE :: dum3d
  91. LOGICAL , SAVE :: first_time_in = .TRUE.
  92. INTEGER :: flag_soilt010 , flag_soilt100 , flag_soilt200 , &
  93. flag_soilm010 , flag_soilm100 , flag_soilm200
  94. ! Some constants to allow simple dimensions in the defined types
  95. ! given below.
  96. INTEGER, PARAMETER :: var_maxdims = 5
  97. INTEGER, PARAMETER :: max_staggers_xy_new = 4
  98. INTEGER, PARAMETER :: max_staggers_xy_old = 3
  99. INTEGER, PARAMETER :: max_staggers_z = 2
  100. INTEGER, PARAMETER :: max_standard_lats = 4
  101. INTEGER, PARAMETER :: max_standard_lons = 4
  102. INTEGER, PARAMETER :: max_fg_variables = 200
  103. INTEGER, PARAMETER :: max_vertical_levels = 2000
  104. ! This module defines the items needed for the WRF metadata
  105. ! which is broken up into three levels:
  106. ! Global metadata: Those things which apply to the
  107. ! entire simulation that are
  108. ! independent of time, domain, or
  109. ! variable
  110. !
  111. ! Domain metadata: Those things which apply to
  112. ! a single domain (this may
  113. ! or may not be time dependent)
  114. !
  115. ! Variable metadata: Those things which apply to
  116. ! a specific variable at a
  117. ! specific time
  118. !
  119. ! The variable names and definitions can be
  120. ! found in the wrf_metadata spec, which is still
  121. ! a living document as coding goes on. The names
  122. ! may not match exactly, but you should be able
  123. ! to figure things out.
  124. !
  125. TYPE wrf_var_metadata
  126. CHARACTER (LEN=8) :: name
  127. CHARACTER (LEN=16) :: units
  128. CHARACTER (LEN=80) :: description
  129. INTEGER :: domain_id
  130. INTEGER :: ndim
  131. INTEGER :: dim_val (var_maxdims)
  132. CHARACTER(LEN=4) :: dim_desc (var_maxdims)
  133. INTEGER :: start_index(var_maxdims)
  134. INTEGER :: stop_index(var_maxdims)
  135. INTEGER :: h_stagger_index
  136. INTEGER :: v_stagger_index
  137. CHARACTER(LEN=8) :: array_order
  138. CHARACTER(LEN=4) :: field_type
  139. CHARACTER(LEN=8) :: field_source_prog
  140. CHARACTER(LEN=80) :: source_desc
  141. CHARACTER(LEN=8) :: field_time_type
  142. INTEGER :: vt_date_start
  143. REAL :: vt_time_start
  144. INTEGER :: vt_date_stop
  145. REAL :: vt_time_stop
  146. END TYPE wrf_var_metadata
  147. TYPE(wrf_var_metadata) :: var_meta , var_info
  148. TYPE wrf_domain_metadata
  149. INTEGER :: id
  150. INTEGER :: parent_id
  151. CHARACTER(LEN=8) :: dyn_init_src
  152. CHARACTER(LEN=8) :: static_init_src
  153. INTEGER :: vt_date
  154. REAL :: vt_time
  155. INTEGER :: origin_parent_x
  156. INTEGER :: origin_parent_y
  157. INTEGER :: ratio_to_parent
  158. REAL :: delta_x
  159. REAL :: delta_y
  160. REAL :: top_level
  161. INTEGER :: origin_parent_z
  162. REAL :: corner_lats_new(4,max_staggers_xy_new)
  163. REAL :: corner_lons_new(4,max_staggers_xy_new)
  164. REAL :: corner_lats_old(4,max_staggers_xy_old)
  165. REAL :: corner_lons_old(4,max_staggers_xy_old)
  166. INTEGER :: xdim
  167. INTEGER :: ydim
  168. INTEGER :: zdim
  169. END TYPE wrf_domain_metadata
  170. TYPE(wrf_domain_metadata) :: dom_meta
  171. TYPE wrf_global_metadata
  172. CHARACTER(LEN=80) :: simulation_name
  173. CHARACTER(LEN=80) :: user_desc
  174. INTEGER :: si_version
  175. INTEGER :: analysis_version
  176. INTEGER :: wrf_version
  177. INTEGER :: post_version
  178. CHARACTER(LEN=32) :: map_projection
  179. REAL :: moad_known_lat
  180. REAL :: moad_known_lon
  181. CHARACTER(LEN=8) :: moad_known_loc
  182. REAL :: moad_stand_lats(max_standard_lats)
  183. REAL :: moad_stand_lons(max_standard_lons)
  184. REAL :: moad_delta_x
  185. REAL :: moad_delta_y
  186. CHARACTER(LEN=4) :: horiz_stagger_type
  187. INTEGER :: num_stagger_xy
  188. REAL :: stagger_dir_x_new(max_staggers_xy_new)
  189. REAL :: stagger_dir_y_new(max_staggers_xy_new)
  190. REAL :: stagger_dir_x_old(max_staggers_xy_old)
  191. REAL :: stagger_dir_y_old(max_staggers_xy_old)
  192. INTEGER :: num_stagger_z
  193. REAL :: stagger_dir_z(max_staggers_z)
  194. CHARACTER(LEN=8) :: vertical_coord
  195. INTEGER :: num_domains
  196. INTEGER :: init_date
  197. REAL :: init_time
  198. INTEGER :: end_date
  199. REAL :: end_time
  200. CHARACTER(LEN=4) :: lu_source
  201. INTEGER :: lu_water
  202. INTEGER :: lu_ice
  203. END TYPE wrf_global_metadata
  204. TYPE(wrf_global_metadata) :: global_meta
  205. CONTAINS
  206. SUBROUTINE read_si ( grid, file_date_string )
  207. USE module_soil_pre
  208. USE module_domain
  209. IMPLICIT NONE
  210. TYPE(domain) , INTENT(INOUT) :: grid
  211. CHARACTER (LEN=19) , INTENT(IN) :: file_date_string
  212. INTEGER :: ids,ide,jds,jde,kds,kde &
  213. ,ims,ime,jms,jme,kms,kme &
  214. ,its,ite,jts,jte,kts,kte
  215. INTEGER :: i , j , k , loop, IMAX, JMAX
  216. REAL :: dummy
  217. CHARACTER (LEN= 8) :: dummy_char
  218. CHARACTER (LEN=256) :: dummy_char_256
  219. INTEGER :: ok , map_proj , ok_open
  220. REAL :: pt
  221. INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
  222. SELECT CASE ( model_data_order )
  223. CASE ( DATA_ORDER_ZXY )
  224. kds = grid%sd31 ; kde = grid%ed31 ;
  225. ids = grid%sd32 ; ide = grid%ed32 ;
  226. jds = grid%sd33 ; jde = grid%ed33 ;
  227. kms = grid%sm31 ; kme = grid%em31 ;
  228. ims = grid%sm32 ; ime = grid%em32 ;
  229. jms = grid%sm33 ; jme = grid%em33 ;
  230. kts = grid%sp31 ; kte = grid%ep31 ; ! tile is entire patch
  231. its = grid%sp32 ; ite = grid%ep32 ; ! tile is entire patch
  232. jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
  233. CASE ( DATA_ORDER_XYZ )
  234. ids = grid%sd31 ; ide = grid%ed31 ;
  235. jds = grid%sd32 ; jde = grid%ed32 ;
  236. kds = grid%sd33 ; kde = grid%ed33 ;
  237. ims = grid%sm31 ; ime = grid%em31 ;
  238. jms = grid%sm32 ; jme = grid%em32 ;
  239. kms = grid%sm33 ; kme = grid%em33 ;
  240. its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
  241. jts = grid%sp32 ; jte = grid%ep32 ; ! tile is entire patch
  242. kts = grid%sp33 ; kte = grid%ep33 ; ! tile is entire patch
  243. CASE ( DATA_ORDER_XZY )
  244. ids = grid%sd31 ; ide = grid%ed31 ;
  245. kds = grid%sd32 ; kde = grid%ed32 ;
  246. jds = grid%sd33 ; jde = grid%ed33 ;
  247. ims = grid%sm31 ; ime = grid%em31 ;
  248. kms = grid%sm32 ; kme = grid%em32 ;
  249. jms = grid%sm33 ; jme = grid%em33 ;
  250. its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
  251. kts = grid%sp32 ; kte = grid%ep32 ; ! tile is entire patch
  252. jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
  253. END SELECT
  254. ! Initialize what soil temperature and moisture is available.
  255. ! write(0,*) 'dum3d I allocs: ', ids,ide-1
  256. ! write(0,*) 'dum3d J allocs: ', jds,jde-1
  257. ! write(0,*) 'dum3d K allocs: ', kds,kde-1
  258. flag_st000010 = 0
  259. flag_st010040 = 0
  260. flag_st040100 = 0
  261. flag_st100200 = 0
  262. flag_sm000010 = 0
  263. flag_sm010040 = 0
  264. flag_sm040100 = 0
  265. flag_sm100200 = 0
  266. flag_st010200 = 0
  267. flag_sm010200 = 0
  268. flag_soilt010 = 0
  269. flag_soilt040 = 0
  270. flag_soilt100 = 0
  271. flag_soilt200 = 0
  272. flag_soilm010 = 0
  273. flag_soilm040 = 0
  274. flag_soilm100 = 0
  275. flag_soilm200 = 0
  276. flag_sst = 0
  277. flag_toposoil = 0
  278. ! How many soil levels have we found? Well, right now, none.
  279. num_st_levels_input = 0
  280. num_sm_levels_input = 0
  281. st_levels_input = -1
  282. sm_levels_input = -1
  283. ! Get the space for the data if this is the first time here.
  284. write(6,*) 'enter read_si...first_time_in:: ', first_time_in
  285. IF ( first_time_in ) THEN
  286. CLOSE(12)
  287. OPEN ( FILE = 'real_input_nm.global.metadata' , &
  288. UNIT = 12 , &
  289. STATUS = 'OLD' , &
  290. ACCESS = 'SEQUENTIAL' , &
  291. FORM = 'UNFORMATTED' , &
  292. IOSTAT = ok_open )
  293. IF ( ok_open .NE. 0 ) THEN
  294. PRINT '(A)','You asked for WRF SI data, but no real_input_nm.global.metadata file exists.'
  295. STOP 'No_real_input_nm.global.metadata_exists'
  296. END IF
  297. READ(12) global_meta%simulation_name, global_meta%user_desc, &
  298. global_meta%si_version, global_meta%analysis_version, &
  299. global_meta%wrf_version, global_meta%post_version
  300. REWIND (12)
  301. IF ( global_meta%si_version .EQ. 1 ) THEN
  302. READ(12) global_meta%simulation_name, global_meta%user_desc, &
  303. global_meta%si_version, global_meta%analysis_version, &
  304. global_meta%wrf_version, global_meta%post_version, &
  305. global_meta%map_projection, global_meta%moad_known_lat, &
  306. global_meta%moad_known_lon, global_meta%moad_known_loc, &
  307. global_meta%moad_stand_lats, global_meta%moad_stand_lons, &
  308. global_meta%moad_delta_x, global_meta%moad_delta_y, &
  309. global_meta%horiz_stagger_type, global_meta%num_stagger_xy, &
  310. global_meta%stagger_dir_x_old, global_meta%stagger_dir_y_old, &
  311. global_meta%num_stagger_z, global_meta%stagger_dir_z, &
  312. global_meta%vertical_coord, global_meta%num_domains, &
  313. global_meta%init_date, global_meta%init_time, &
  314. global_meta%end_date, global_meta%end_time
  315. ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
  316. READ(12) global_meta%simulation_name, global_meta%user_desc, &
  317. global_meta%si_version, global_meta%analysis_version, &
  318. global_meta%wrf_version, global_meta%post_version, &
  319. global_meta%map_projection, global_meta%moad_known_lat, &
  320. global_meta%moad_known_lon, global_meta%moad_known_loc, &
  321. global_meta%moad_stand_lats, global_meta%moad_stand_lons, &
  322. global_meta%moad_delta_x, global_meta%moad_delta_y, &
  323. global_meta%horiz_stagger_type, global_meta%num_stagger_xy, &
  324. global_meta%stagger_dir_x_new, global_meta%stagger_dir_y_new, &
  325. global_meta%num_stagger_z, global_meta%stagger_dir_z, &
  326. global_meta%vertical_coord, global_meta%num_domains, &
  327. global_meta%init_date, global_meta%init_time, &
  328. global_meta%end_date, global_meta%end_time , &
  329. global_meta%lu_source, global_meta%lu_water, global_meta%lu_ice
  330. END IF
  331. CLOSE (12)
  332. print *,'GLOBAL METADATA'
  333. print *,'global_meta%simulation_name', global_meta%simulation_name
  334. print *,'global_meta%user_desc', global_meta%user_desc
  335. print *,'global_meta%user_desc', global_meta%user_desc
  336. print *,'global_meta%si_version', global_meta%si_version
  337. print *,'global_meta%analysis_version', global_meta%analysis_version
  338. print *,'global_meta%wrf_version', global_meta%wrf_version
  339. print *,'global_meta%post_version', global_meta%post_version
  340. print *,'global_meta%map_projection', global_meta%map_projection
  341. print *,'global_meta%moad_known_lat', global_meta%moad_known_lat
  342. print *,'global_meta%moad_known_lon', global_meta%moad_known_lon
  343. print *,'global_meta%moad_known_loc', global_meta%moad_known_loc
  344. print *,'global_meta%moad_stand_lats', global_meta%moad_stand_lats
  345. print *,'global_meta%moad_stand_lons', global_meta%moad_stand_lons
  346. print *,'global_meta%moad_delta_x', global_meta%moad_delta_x
  347. print *,'global_meta%moad_delta_y', global_meta%moad_delta_y
  348. print *,'global_meta%horiz_stagger_type', global_meta%horiz_stagger_type
  349. print *,'global_meta%num_stagger_xy', global_meta%num_stagger_xy
  350. IF ( global_meta%si_version .EQ. 1 ) THEN
  351. print *,'global_meta%stagger_dir_x', global_meta%stagger_dir_x_old
  352. print *,'global_meta%stagger_dir_y', global_meta%stagger_dir_y_old
  353. ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
  354. print *,'global_meta%stagger_dir_x', global_meta%stagger_dir_x_new
  355. print *,'global_meta%stagger_dir_y', global_meta%stagger_dir_y_new
  356. END IF
  357. print *,'global_meta%num_stagger_z', global_meta%num_stagger_z
  358. print *,'global_meta%stagger_dir_z', global_meta%stagger_dir_z
  359. print *,'global_meta%vertical_coord', global_meta%vertical_coord
  360. print *,'global_meta%num_domains', global_meta%num_domains
  361. print *,'global_meta%init_date', global_meta%init_date
  362. print *,'global_meta%init_time', global_meta%init_time
  363. print *,'global_meta%end_date', global_meta%end_date
  364. print *,'global_meta%end_time', global_meta%end_time
  365. IF ( global_meta%si_version .EQ. 2 ) THEN
  366. print *,'global_meta%lu_source', global_meta%lu_source
  367. print *,'global_meta%lu_water', global_meta%lu_water
  368. print *,'global_meta%lu_ice', global_meta%lu_ice
  369. END IF
  370. print *,' '
  371. ! 1D - this is the definition of the vertical coordinate.
  372. IF (.NOT. ALLOCATED (DETA_in)) ALLOCATE(DETA_in(kds:kde-1))
  373. IF (.NOT. ALLOCATED (AETA_in)) ALLOCATE(AETA_in(kds:kde-1))
  374. IF (.NOT. ALLOCATED (ETAX_in)) ALLOCATE(ETAX_in(kds:kde))
  375. IF (.NOT. ALLOCATED (DETA1_in)) ALLOCATE(DETA1_in(kds:kde-1))
  376. IF (.NOT. ALLOCATED (AETA1_in)) ALLOCATE(AETA1_in(kds:kde-1))
  377. IF (.NOT. ALLOCATED (ETA1_in)) ALLOCATE(ETA1_in(kds:kde))
  378. IF (.NOT. ALLOCATED (DETA2_in)) ALLOCATE(DETA2_in(kds:kde-1))
  379. IF (.NOT. ALLOCATED (AETA2_in)) ALLOCATE(AETA2_in(kds:kde-1))
  380. IF (.NOT. ALLOCATED (ETA2_in)) ALLOCATE(ETA2_in(kds:kde))
  381. IF (.NOT. ALLOCATED (DFL_in)) ALLOCATE(DFL_in(kds:kde))
  382. ! 3D met
  383. IF (.NOT. ALLOCATED (u_input) ) ALLOCATE ( u_input(its:ite,jts:jte,kts:kte) )
  384. IF (.NOT. ALLOCATED (v_input) ) ALLOCATE ( v_input(its:ite,jts:jte,kts:kte) )
  385. IF (.NOT. ALLOCATED (q_input) ) ALLOCATE ( q_input(its:ite,jts:jte,kts:kte) )
  386. IF (.NOT. ALLOCATED (t_input) ) ALLOCATE ( t_input(its:ite,jts:jte,kts:kte) )
  387. IF (.NOT. ALLOCATED (htm_in) ) ALLOCATE ( htm_in(its:ite,jts:jte,kts:kte) )
  388. IF (.NOT. ALLOCATED (vtm_in) ) ALLOCATE ( vtm_in(its:ite,jts:jte,kts:kte) )
  389. ! 2D pressure fields
  390. IF (.NOT. ALLOCATED (pmsl) ) ALLOCATE ( pmsl(its:ite,jts:jte) )
  391. IF (.NOT. ALLOCATED (psfc_in) ) ALLOCATE ( psfc_in(its:ite,jts:jte) )
  392. ! 2D - for LSM, these are computed from the categorical precentage values.
  393. ! 2D - for LSM, the various soil temperature and moisture levels that are available.
  394. IF (.NOT. ALLOCATED (st_inputx)) ALLOCATE (st_inputx(its:ite,jts:jte,num_st_levels_alloc))
  395. IF (.NOT. ALLOCATED (sm_inputx)) ALLOCATE (sm_inputx(its:ite,jts:jte,num_st_levels_alloc))
  396. IF (.NOT. ALLOCATED (sw_inputx)) ALLOCATE (sw_inputx(its:ite,jts:jte,num_st_levels_alloc))
  397. IF (.NOT. ALLOCATED (soilt010_input) ) ALLOCATE ( soilt010_input(its:ite,jts:jte) )
  398. IF (.NOT. ALLOCATED (soilt040_input) ) ALLOCATE ( soilt040_input(its:ite,jts:jte) )
  399. IF (.NOT. ALLOCATED (soilt100_input) ) ALLOCATE ( soilt100_input(its:ite,jts:jte) )
  400. IF (.NOT. ALLOCATED (soilt200_input) ) ALLOCATE ( soilt200_input(its:ite,jts:jte) )
  401. IF (.NOT. ALLOCATED (soilm010_input) ) ALLOCATE ( soilm010_input(its:ite,jts:jte) )
  402. IF (.NOT. ALLOCATED (soilm040_input) ) ALLOCATE ( soilm040_input(its:ite,jts:jte) )
  403. IF (.NOT. ALLOCATED (soilm100_input) ) ALLOCATE ( soilm100_input(its:ite,jts:jte) )
  404. IF (.NOT. ALLOCATED (soilm200_input) ) ALLOCATE ( soilm200_input(its:ite,jts:jte) )
  405. IF (.NOT. ALLOCATED (lat_wind) ) ALLOCATE (lat_wind(its:ite,jts:jte))
  406. IF (.NOT. ALLOCATED (lon_wind) ) ALLOCATE (lon_wind(its:ite,jts:jte))
  407. ! Local arrays
  408. IF (.NOT. ALLOCATED (dum2d) ) ALLOCATE (dum2d(IDS:IDE-1,JDS:JDE-1))
  409. IF (.NOT. ALLOCATED (idum2d) ) ALLOCATE (idum2d(IDS:IDE-1,JDS:JDE-1))
  410. IF (.NOT. ALLOCATED (dum3d) ) ALLOCATE (dum3d(IDS:IDE-1,JDS:JDE-1,KDS:KDE-1))
  411. END IF
  412. CLOSE(13)
  413. write(6,*) 'file_date_string: ', file_date_string
  414. write(6,*) 'opening real_input_nm.d01.'//file_date_string//' as unit 13'
  415. OPEN ( FILE = 'real_input_nm.d01.'//file_date_string , &
  416. UNIT = 13 , &
  417. STATUS = 'OLD' , &
  418. ACCESS = 'SEQUENTIAL' , &
  419. FORM = 'UNFORMATTED' )
  420. IF ( global_meta%si_version .EQ. 1 ) THEN
  421. READ (13) dom_meta%id,dom_meta%parent_id,dom_meta%dyn_init_src,&
  422. dom_meta%static_init_src, dom_meta%vt_date, dom_meta%vt_time, &
  423. dom_meta%origin_parent_x, dom_meta%origin_parent_y, &
  424. dom_meta%ratio_to_parent, dom_meta%delta_x, dom_meta%delta_y, &
  425. dom_meta%top_level, dom_meta%origin_parent_z, &
  426. dom_meta%corner_lats_old, dom_meta%corner_lons_old, dom_meta%xdim, &
  427. dom_meta%ydim, dom_meta%zdim
  428. ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
  429. READ (13) dom_meta%id,dom_meta%parent_id,dom_meta%dyn_init_src,&
  430. dom_meta%static_init_src, dom_meta%vt_date, dom_meta%vt_time, &
  431. dom_meta%origin_parent_x, dom_meta%origin_parent_y, &
  432. dom_meta%ratio_to_parent, dom_meta%delta_x, dom_meta%delta_y, &
  433. dom_meta%top_level, dom_meta%origin_parent_z, &
  434. dom_meta%corner_lats_new, dom_meta%corner_lons_new, dom_meta%xdim, &
  435. dom_meta%ydim, dom_meta%zdim
  436. END IF
  437. print *,'DOMAIN METADATA'
  438. print *,'dom_meta%id=', dom_meta%id
  439. print *,'dom_meta%parent_id=', dom_meta%parent_id
  440. print *,'dom_meta%dyn_init_src=', dom_meta%dyn_init_src
  441. print *,'dom_meta%static_init_src=', dom_meta%static_init_src
  442. print *,'dom_meta%vt_date=', dom_meta%vt_date
  443. print *,'dom_meta%vt_time=', dom_meta%vt_time
  444. print *,'dom_meta%origin_parent_x=', dom_meta%origin_parent_x
  445. print *,'dom_meta%origin_parent_y=', dom_meta%origin_parent_y
  446. print *,'dom_meta%ratio_to_parent=', dom_meta%ratio_to_parent
  447. print *,'dom_meta%delta_x=', dom_meta%delta_x
  448. print *,'dom_meta%delta_y=', dom_meta%delta_y
  449. print *,'dom_meta%top_level=', dom_meta%top_level
  450. print *,'dom_meta%origin_parent_z=', dom_meta%origin_parent_z
  451. IF ( global_meta%si_version .EQ. 1 ) THEN
  452. print *,'dom_meta%corner_lats=', dom_meta%corner_lats_old
  453. print *,'dom_meta%corner_lons=', dom_meta%corner_lons_old
  454. ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
  455. print *,'dom_meta%corner_lats=', dom_meta%corner_lats_new
  456. print *,'dom_meta%corner_lons=', dom_meta%corner_lons_new
  457. END IF
  458. print *,'dom_meta%xdim=', dom_meta%xdim
  459. print *,'dom_meta%ydim=', dom_meta%ydim
  460. print *,'dom_meta%zdim=', dom_meta%zdim
  461. print *,' '
  462. ! A simple domain size test.
  463. !! relax constraint, as model namelist has +1 for i and j, while
  464. !! si data has true dimensions
  465. IF ( abs(dom_meta%xdim - (ide-1)) .gt. 1 &
  466. .OR. abs(dom_meta%ydim - (jde-1)) .gt. 1 &
  467. .OR. abs(dom_meta%zdim - (kde-1)) .gt. 1) THEN
  468. PRINT '(A)','Namelist does not match the input data.'
  469. PRINT '(A,3I5,A)','Namelist dimensions =',ide-1,jde-1,kde-1,'.'
  470. PRINT '(A,3I5,A)','Input data dimensions =',dom_meta%xdim,dom_meta%ydim,dom_meta%zdim,'.'
  471. STOP 'Wrong_data_size'
  472. END IF
  473. ! How about the grid distance? Is it the same as in the namelist?
  474. IF ( global_meta%si_version .EQ. 1 ) THEN
  475. CALL nl_set_cen_lat ( grid%id , ( dom_meta%corner_lats_old(1,1) + dom_meta%corner_lats_old(2,1) + &
  476. dom_meta%corner_lats_old(3,1) + dom_meta%corner_lats_old(4,1) ) * 0.25 )
  477. ELSE IF ( ( global_meta%si_version .EQ. 2 ) .AND. ( global_meta%moad_known_loc(1:6) .EQ. 'CENTER' ) ) THEN
  478. CALL nl_set_cen_lat ( grid%id , global_meta%moad_known_lat )
  479. ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
  480. CALL nl_set_cen_lat ( grid%id , ( dom_meta%corner_lats_new(1,1) + dom_meta%corner_lats_new(2,1) + &
  481. dom_meta%corner_lats_new(3,1) + dom_meta%corner_lats_new(4,1) ) * 0.25 )
  482. END IF
  483. !!! might be trouble here
  484. CALL nl_set_cen_lon ( grid%id , global_meta%moad_stand_lons(1) )
  485. !!!!!
  486. write(6,*) 'set_cen_lat... global_meta%moad_stand_lats(1): ', global_meta%moad_stand_lats(1)
  487. CALL nl_set_cen_lat ( grid%id , global_meta%moad_stand_lats(1) )
  488. !!!!!
  489. CALL nl_set_truelat1 ( grid%id , global_meta%moad_stand_lats(1) )
  490. CALL nl_set_truelat2 ( grid%id , global_meta%moad_stand_lats(2) )
  491. pt = dom_meta%top_level
  492. IF ( global_meta%map_projection(1:17) .EQ. 'LAMBERT CONFORMAL' ) THEN
  493. map_proj = 1
  494. ELSE IF ( global_meta%map_projection(1:19) .EQ. 'POLAR STEREOGRAPHIC' ) THEN
  495. map_proj = 2
  496. ELSE IF ( global_meta%map_projection(1: 8) .EQ. 'MERCATOR' ) THEN
  497. map_proj = 3
  498. ELSE IF ( global_meta%map_projection(1:14) .EQ. 'ROTATED LATLON' ) THEN
  499. map_proj = 203 !?
  500. ELSE
  501. PRINT '(A,A,A)','Undefined map projection: ',TRIM(global_meta%map_projection(1:20)),'.'
  502. STOP 'Undefined_map_proj_si'
  503. END IF
  504. CALL nl_set_map_proj ( grid%id , map_proj )
  505. ! write(0,*) 'global_meta%si_version: ', global_meta%si_version
  506. ! write(0,*) 'global_meta%lu_source: ', global_meta%lu_source
  507. ! write(0,*) 'global_meta%lu_water: ', global_meta%lu_water
  508. IF ( global_meta%si_version .EQ. 1 ) THEN
  509. CALL nl_set_mminlu (grid%id, 'USGS' )
  510. CALL nl_set_iswater (grid%id, 16 )
  511. ELSE IF ( global_meta%si_version .EQ. 2 ) THEN
  512. CALL nl_set_mminlu ( grid%id, global_meta%lu_source )
  513. CALL nl_set_iswater (grid%id, global_meta%lu_water )
  514. CALL nl_set_isice (grid%id, global_meta%lu_ice )
  515. END IF
  516. CALL nl_set_gmt (grid%id, dom_meta%vt_time / 3600. )
  517. CALL nl_set_julyr (grid%id, dom_meta%vt_date / 1000 )
  518. CALL nl_set_julday (grid%id, dom_meta%vt_date - ( dom_meta%vt_date / 1000 ) * 1000 )
  519. write(6,*) 'start reading from unit 13'
  520. read_all_the_data : DO
  521. READ (13,IOSTAT=OK) var_info%name, var_info%units, &
  522. var_info%description, var_info%domain_id, var_info%ndim, &
  523. var_info%dim_val, var_info%dim_desc, var_info%start_index, &
  524. var_info%stop_index, var_info%h_stagger_index, var_info%v_stagger_index,&
  525. var_info%array_order, var_info%field_type, var_info%field_source_prog, &
  526. var_info%source_desc, var_info%field_time_type, var_info%vt_date_start, &
  527. var_info%vt_time_start, var_info%vt_date_stop, var_info%vt_time_stop
  528. IF ( OK .NE. 0 ) THEN
  529. PRINT '(A,A,A)','End of file found for real_input_nm.d01.',file_date_string,'.'
  530. EXIT read_all_the_data
  531. END IF
  532. ! print *,'VARIABLE METADATA'
  533. PRINT '(A,A)','var_info%name=', var_info%name
  534. ! print *,'var_info%units=', var_info%units
  535. ! print *,'var_info%description=', var_info%description
  536. ! print *,'var_info%domain_id=', var_info%domain_id
  537. ! print *,'var_info%ndim=', var_info%ndim
  538. ! print *,'var_info%dim_val=', var_info%dim_val
  539. ! print *,'var_info%dim_desc=', var_info%dim_desc
  540. ! print *,'var_info%start_index=', var_info%start_index
  541. ! print *,'var_info%stop_index=', var_info%stop_index
  542. ! print *,'var_info%h_stagger_index=', var_info%h_stagger_index
  543. ! print *,'var_info%v_stagger_index=', var_info%v_stagger_index
  544. ! print *,'var_info%array_order=', var_info%array_order
  545. ! print *,'var_info%field_type=', var_info%field_type
  546. ! print *,'var_info%field_source_prog=', var_info%field_source_prog
  547. ! print *,'var_info%source_desc=', var_info%source_desc
  548. ! print *,'var_info%field_time_type=', var_info%field_time_type
  549. ! print *,'var_info%vt_date_start=', var_info%vt_date_start
  550. ! print *,'var_info%vt_time_start=', var_info%vt_time_start
  551. ! print *,'var_info%vt_date_stop=', var_info%vt_date_stop
  552. ! print *,'var_info%vt_time_stop=', var_info%vt_time_stop
  553. JMAX=min(JDE-1,JTE)
  554. IMAX=min(IDE-1,ITE)
  555. ! 3D meteorological fields.
  556. ! write(0,*)' read_si var_info%name=',var_info%name(1:8)
  557. IF ( var_info%name(1:8) .EQ. 'T ' ) THEN
  558. READ (13) dum3d
  559. do k=kts,kte-1
  560. do j=jts,JMAX
  561. do i=its,IMAX
  562. t_input(i,j,k)=dum3d(i,j,k)
  563. enddo
  564. enddo
  565. enddo
  566. ELSE IF ( var_info%name(1:8) .EQ. 'U ' ) THEN
  567. READ (13) dum3d
  568. do k=kts,kte-1
  569. do j=jts,JMAX
  570. do i=its,IMAX
  571. u_input(i,j,k)=dum3d(i,j,k)
  572. enddo
  573. enddo
  574. enddo
  575. ELSE IF ( var_info%name(1:8) .EQ. 'V ' ) THEN
  576. READ (13) dum3d
  577. do k=kts,kte-1
  578. do j=jts,JMAX
  579. do i=its,IMAX
  580. v_input(i,j,k)=dum3d(i,j,k)
  581. enddo
  582. enddo
  583. enddo
  584. ELSE IF ( var_info%name(1:8) .EQ. 'Q ' ) THEN
  585. READ (13) dum3d
  586. do k=kts,kte-1
  587. do j=jts,JMAX
  588. do i=its,IMAX
  589. q_input(i,j,k)=dum3d(i,j,k)
  590. enddo
  591. enddo
  592. enddo
  593. ! 3D LSM fields. Don't know the 3rd dimension until we read it in.
  594. ELSE IF ( var_info%name(1:8) .EQ. 'LANDUSEF' ) THEN
  595. IF ( ( first_time_in ) .AND. ( .NOT. ALLOCATED ( landuse_frac_input) ) ) THEN
  596. ALLOCATE (landuse_frac_input(its:ite,jts:jte,var_info%dim_val(3)) )
  597. END IF
  598. READ (13) (((dum3d(i,j,k),i=ids,ide-1),j=jds,jde-1),k=1,var_info%dim_val(3))
  599. do k=1,var_info%dim_val(3)
  600. do j=jts,JMAX
  601. do i=its,IMAX
  602. landuse_frac_input(i,j,k)=dum3d(i,j,k)
  603. enddo
  604. enddo
  605. enddo
  606. ELSE IF ( var_info%name(1:8) .EQ. 'SOILCTOP' ) THEN
  607. IF ( ( first_time_in ) .AND. ( .NOT. ALLOCATED ( soil_top_cat_input) ) ) THEN
  608. ALLOCATE (soil_top_cat_input(its:ite,jts:jte,var_info%dim_val(3)) )
  609. END IF
  610. READ (13) (((dum3d(i,j,k),i=ids,ide-1),j=jds,jde-1),k=1,var_info%dim_val(3))
  611. do k=1,var_info%dim_val(3)
  612. do j=jts,JMAX
  613. do i=its,IMAX
  614. soil_top_cat_input(i,j,k)=dum3d(i,j,k)
  615. enddo
  616. enddo
  617. enddo
  618. ELSE IF ( var_info%name(1:8) .EQ. 'SOILCBOT' ) THEN
  619. IF ( ( first_time_in ) .AND. ( .NOT. ALLOCATED ( soil_bot_cat_input) ) ) THEN
  620. ALLOCATE (soil_bot_cat_input(its:ite,jts:jte,var_info%dim_val(3)) )
  621. END IF
  622. READ (13) (((dum3d(i,j,k),i=ids,ide-1),j=jds,jde-1),k=1,var_info%dim_val(3))
  623. do k=1,var_info%dim_val(3)
  624. do j=jts,JMAX
  625. do i=its,IMAX
  626. soil_bot_cat_input(i,j,k)=dum3d(i,j,k)
  627. enddo
  628. enddo
  629. enddo
  630. ! 2D dry pressure minus ptop.
  631. ELSE IF ( var_info%name(1:8) .EQ. 'PD ' ) THEN
  632. READ (13) dum2d
  633. do j=jts,JMAX
  634. do i=its,IMAX
  635. grid%pd(i,j)=dum2d(i,j)
  636. enddo
  637. enddo
  638. ELSE IF ( var_info%name(1:8) .EQ. 'PSFC ' ) THEN
  639. READ (13) dum2d
  640. do j=jts,JMAX
  641. do i=its,IMAX
  642. psfc_in(i,j)=dum2d(i,j)
  643. enddo
  644. enddo
  645. ELSE IF ( var_info%name(1:8) .EQ. 'PMSL ' ) THEN
  646. READ (13) dum2d
  647. do j=jts,JMAX
  648. do i=its,IMAX
  649. pmsl(i,j)=dum2d(i,j)
  650. enddo
  651. enddo
  652. ELSE IF ( var_info%name(1:8) .EQ. 'PDTOP ' ) THEN
  653. READ (13) grid%pdtop
  654. ELSE IF ( var_info%name(1:8) .EQ. 'PT ' ) THEN
  655. READ (13) grid%pt
  656. ! 2D surface fields.
  657. ELSE IF ( var_info%name(1:8) .eq. 'GLAT ' ) THEN
  658. READ (13) dum2d
  659. do j=jts,JMAX
  660. do i=its,IMAX
  661. grid%glat(i,j)=dum2d(i,j)
  662. enddo
  663. enddo
  664. ELSE IF ( var_info%name(1:8) .eq. 'GLON ' ) THEN
  665. READ (13) dum2d
  666. do j=jts,JMAX
  667. do i=its,IMAX
  668. grid%glon(i,j)=dum2d(i,j)
  669. enddo
  670. enddo
  671. ELSE IF ( var_info%name(1:8) .eq. 'LAT_V ' ) THEN
  672. READ (13) dum2d
  673. do j=jts,JMAX
  674. do i=its,IMAX
  675. lat_wind(i,j)=dum2d(i,j)
  676. enddo
  677. enddo
  678. ELSE IF ( var_info%name(1:8) .eq. 'LON_V ' ) THEN
  679. READ (13) dum2d
  680. do j=jts,JMAX
  681. do i=its,IMAX
  682. lon_wind(i,j)=dum2d(i,j)
  683. enddo
  684. enddo
  685. ELSE IF ( var_info%name(1:8) .EQ. 'ST000010' ) THEN
  686. READ (13) dum2d
  687. do j=jts,JMAX
  688. do i=its,IMAX
  689. grid%st000010(i,j)=dum2d(i,j)
  690. enddo
  691. enddo
  692. flag_st000010 = 1
  693. num_st_levels_input = num_st_levels_input + 1
  694. st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
  695. do j=jts,JMAX
  696. do i=its,IMAX
  697. st_inputx(I,J,num_st_levels_input + 1) = grid%st000010(i,j)
  698. enddo
  699. enddo
  700. ELSE IF ( var_info%name(1:8) .EQ. 'ST010040' ) THEN
  701. READ (13) dum2d
  702. do j=jts,JMAX
  703. do i=its,IMAX
  704. grid%st010040(i,j)=dum2d(i,j)
  705. enddo
  706. enddo
  707. flag_st010040 = 1
  708. num_st_levels_input = num_st_levels_input + 1
  709. st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
  710. do j=jts,JMAX
  711. do i=its,IMAX
  712. st_inputx(I,J,num_st_levels_input + 1) = grid%st010040(i,j)
  713. enddo
  714. enddo
  715. ELSE IF ( var_info%name(1:8) .EQ. 'ST040100' ) THEN
  716. READ (13) dum2d
  717. do j=jts,JMAX
  718. do i=its,IMAX
  719. grid%st040100(i,j)=dum2d(i,j)
  720. enddo
  721. enddo
  722. flag_st040100 = 1
  723. num_st_levels_input = num_st_levels_input + 1
  724. st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
  725. do j=jts,JMAX
  726. do i=its,IMAX
  727. st_inputx(I,J,num_st_levels_input + 1) = grid%st040100(i,j)
  728. enddo
  729. enddo
  730. ELSE IF ( var_info%name(1:8) .EQ. 'ST100200' ) THEN
  731. READ (13) dum2d
  732. do j=jts,JMAX
  733. do i=its,IMAX
  734. grid%st100200(i,j)=dum2d(i,j)
  735. enddo
  736. enddo
  737. flag_st100200 = 1
  738. num_st_levels_input = num_st_levels_input + 1
  739. st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
  740. do j=jts,JMAX
  741. do i=its,IMAX
  742. st_inputx(I,J,num_st_levels_input + 1) = grid%st100200(i,j)
  743. enddo
  744. enddo
  745. ELSE IF ( var_info%name(1:8) .EQ. 'ST010200' ) THEN
  746. READ (13) dum2d
  747. do j=jts,JMAX
  748. do i=its,IMAX
  749. grid%st010200(i,j)=dum2d(i,j)
  750. enddo
  751. enddo
  752. flag_st010200 = 1
  753. num_st_levels_input = num_st_levels_input + 1
  754. st_levels_input(num_st_levels_input) = char2int2(var_info%name(3:8))
  755. do j=jts,JMAX
  756. do i=its,IMAX
  757. st_inputx(I,J,num_st_levels_input + 1) = grid%st010200(i,j)
  758. enddo
  759. enddo
  760. ELSE IF ( var_info%name(1:8) .EQ. 'SM000010' ) THEN
  761. READ (13) dum2d
  762. do j=jts,JMAX
  763. do i=its,IMAX
  764. grid%sm000010(i,j)=dum2d(i,j)
  765. enddo
  766. enddo
  767. flag_sm000010 = 1
  768. num_sm_levels_input = num_sm_levels_input + 1
  769. sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
  770. do j=jts,JMAX
  771. do i=its,IMAX
  772. sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm000010(i,j)
  773. enddo
  774. enddo
  775. ELSE IF ( var_info%name(1:8) .EQ. 'SM010040' ) THEN
  776. READ (13) dum2d
  777. do j=jts,JMAX
  778. do i=its,IMAX
  779. grid%sm010040(i,j)=dum2d(i,j)
  780. enddo
  781. enddo
  782. flag_sm010040 = 1
  783. num_sm_levels_input = num_sm_levels_input + 1
  784. sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
  785. do j=jts,JMAX
  786. do i=its,IMAX
  787. sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm010040(i,j)
  788. enddo
  789. enddo
  790. ELSE IF ( var_info%name(1:8) .EQ. 'SM040100' ) THEN
  791. READ (13) dum2d
  792. do j=jts,JMAX
  793. do i=its,IMAX
  794. grid%sm040100(i,j)=dum2d(i,j)
  795. enddo
  796. enddo
  797. flag_sm040100 = 1
  798. num_sm_levels_input = num_sm_levels_input + 1
  799. sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
  800. do j=jts,JMAX
  801. do i=its,IMAX
  802. sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm040100(i,j)
  803. enddo
  804. enddo
  805. ELSE IF ( var_info%name(1:8) .EQ. 'SM100200' ) THEN
  806. READ (13) dum2d
  807. do j=jts,JMAX
  808. do i=its,IMAX
  809. grid%sm100200(i,j)=dum2d(i,j)
  810. enddo
  811. enddo
  812. flag_sm100200 = 1
  813. num_sm_levels_input = num_sm_levels_input + 1
  814. sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
  815. do j=jts,JMAX
  816. do i=its,IMAX
  817. sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm100200(i,j)
  818. enddo
  819. enddo
  820. ELSE IF ( var_info%name(1:8) .EQ. 'SM010200' ) THEN
  821. READ (13) dum2d
  822. do j=jts,JMAX
  823. do i=its,IMAX
  824. grid%sm010200(i,j)=dum2d(i,j)
  825. enddo
  826. enddo
  827. flag_sm010200 = 1
  828. num_sm_levels_input = num_sm_levels_input + 1
  829. sm_levels_input(num_sm_levels_input) = char2int2(var_info%name(3:8))
  830. do j=jts,JMAX
  831. do i=its,IMAX
  832. sm_inputx(I,J,num_sm_levels_input + 1) = grid%sm010200(i,j)
  833. enddo
  834. enddo
  835. ELSE IF ( var_info%name(1:8) .EQ. 'SOILT010' ) THEN
  836. READ (13) dum2d
  837. do j=jts,JMAX
  838. do i=its,IMAX
  839. soilt010_input(i,j)=dum2d(i,j)
  840. enddo
  841. enddo
  842. flag_soilt010 = 1
  843. num_st_levels_input = num_st_levels_input + 1
  844. st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
  845. !mp st_inputx(:,:,num_st_levels_input + 1) = soilt010_input
  846. do j=jts,JMAX
  847. do i=its,IMAX
  848. st_inputx(I,J,num_st_levels_input + 1) = soilt010_input(I,J)
  849. enddo
  850. enddo
  851. write(6,*) 'num_st_levels_input=',num_st_levels_input
  852. ELSE IF ( var_info%name(1:8) .EQ. 'SOILT040' ) THEN
  853. READ (13) dum2d
  854. do j=jts,JMAX
  855. do i=its,IMAX
  856. soilt040_input(i,j)=dum2d(i,j)
  857. enddo
  858. enddo
  859. flag_soilt040 = 1
  860. num_st_levels_input = num_st_levels_input + 1
  861. st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
  862. !mp st_inputx(:,:,num_st_levels_input + 1) = soilt040_input
  863. do j=jts,JMAX
  864. do i=its,IMAX
  865. st_inputx(I,J,num_st_levels_input + 1) = soilt040_input(I,J)
  866. enddo
  867. enddo
  868. write(6,*) 'num_st_levels_input=',num_st_levels_input
  869. ELSE IF ( var_info%name(1:8) .EQ. 'SOILT100' ) THEN
  870. READ (13) dum2d
  871. do j=jts,JMAX
  872. do i=its,IMAX
  873. soilt100_input(i,j)=dum2d(i,j)
  874. enddo
  875. enddo
  876. flag_soilt100 = 1
  877. num_st_levels_input = num_st_levels_input + 1
  878. st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
  879. !mp st_inputx(:,:,num_st_levels_input + 1) = soilt100_input
  880. do j=jts,JMAX
  881. do i=its,IMAX
  882. st_inputx(I,J,num_st_levels_input + 1) = soilt100_input(I,J)
  883. enddo
  884. enddo
  885. write(6,*) 'num_st_levels_input=',num_st_levels_input
  886. ELSE IF ( var_info%name(1:8) .EQ. 'SOILT200' ) THEN
  887. READ (13) dum2d
  888. do j=jts,JMAX
  889. do i=its,IMAX
  890. soilt200_input(i,j)=dum2d(i,j)
  891. enddo
  892. enddo
  893. flag_soilt200 = 1
  894. num_st_levels_input = num_st_levels_input + 1
  895. st_levels_input(num_st_levels_input) = char2int1(var_info%name(6:8))
  896. !mp st_inputx(:,:,num_st_levels_input + 1) = soilt200_input
  897. do j=jts,JMAX
  898. do i=its,IMAX
  899. st_inputx(I,J,num_st_levels_input + 1) = soilt200_input(I,J)
  900. enddo
  901. enddo
  902. write(6,*) 'num_st_levels_input=',num_st_levels_input
  903. ELSE IF ( var_info%name(1:8) .EQ. 'SOILM010' ) THEN
  904. READ (13) dum2d
  905. do j=jts,JMAX
  906. do i=its,IMAX
  907. soilm010_input(i,j)=dum2d(i,j)
  908. enddo
  909. enddo
  910. flag_soilm010 = 1
  911. num_sm_levels_input = num_sm_levels_input + 1
  912. sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
  913. !mp sm_inputx(:,:,num_sm_levels_input + 1) = soilm010_input
  914. do j=jts,JMAX
  915. do i=its,IMAX
  916. sm_inputx(I,J,num_sm_levels_input + 1) = soilm010_input(I,J)
  917. enddo
  918. enddo
  919. ELSE IF ( var_info%name(1:8) .EQ. 'SOILM040' ) THEN
  920. READ (13) dum2d
  921. do j=jts,JMAX
  922. do i=its,IMAX
  923. soilm040_input(i,j)=dum2d(i,j)
  924. enddo
  925. enddo
  926. flag_soilm040 = 1
  927. num_sm_levels_input = num_sm_levels_input + 1
  928. sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
  929. !mp sm_inputx(:,:,num_sm_levels_input + 1) = soilm040_input
  930. do j=jts,JMAX
  931. do i=its,IMAX
  932. sm_inputx(I,J,num_sm_levels_input + 1) = soilm040_input(I,J)
  933. enddo
  934. enddo
  935. ELSE IF ( var_info%name(1:8) .EQ. 'SOILM100' ) THEN
  936. READ (13) dum2d
  937. do j=jts,JMAX
  938. do i=its,IMAX
  939. soilm100_input(i,j)=dum2d(i,j)
  940. enddo
  941. enddo
  942. flag_soilm100 = 1
  943. num_sm_levels_input = num_sm_levels_input + 1
  944. sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
  945. !mp sm_inputx(:,:,num_sm_levels_input + 1) = soilm100_input
  946. do j=jts,JMAX
  947. do i=its,IMAX
  948. sm_inputx(I,J,num_sm_levels_input + 1) = soilm100_input(I,J)
  949. enddo
  950. enddo
  951. ELSE IF ( var_info%name(1:8) .EQ. 'SOILM200' ) THEN
  952. READ (13) dum2d
  953. do j=jts,JMAX
  954. do i=its,IMAX
  955. soilm200_input(i,j)=dum2d(i,j)
  956. enddo
  957. enddo
  958. flag_soilm200 = 1
  959. num_sm_levels_input = num_sm_levels_input + 1
  960. sm_levels_input(num_sm_levels_input) = char2int1(var_info%name(6:8))
  961. !mp sm_inputx(:,:,num_sm_levels_input + 1) = soilm200_input
  962. do j=jts,JMAX
  963. do i=its,IMAX
  964. sm_inputx(I,J,num_sm_levels_input + 1) = soilm200_input(I,J)
  965. enddo
  966. enddo
  967. ELSE IF ( var_info%name(1:8) .EQ. 'SEAICE ' ) THEN
  968. READ (13) dum2d
  969. do j=jts,JMAX
  970. do i=its,IMAX
  971. grid%xice(i,j)=dum2d(i,j)
  972. enddo
  973. enddo
  974. ELSE IF ( var_info%name(1:8) .EQ. 'WEASD ' ) THEN
  975. READ (13) dum2d
  976. do j=jts,JMAX
  977. do i=its,IMAX
  978. grid%weasd(i,j)=dum2d(i,j)
  979. enddo
  980. enddo
  981. ELSE IF ( var_info%name(1:8) .EQ. 'CANWAT ' ) THEN
  982. READ (13) dum2d
  983. do j=jts,JMAX
  984. do i=its,IMAX
  985. grid%canwat(i,j)=dum2d(i,j)
  986. enddo
  987. enddo
  988. ELSE IF ( var_info%name(1:8) .EQ. 'LANDMASK' ) THEN
  989. READ (13) dum2d
  990. do j=jts,JMAX
  991. do i=its,IMAX
  992. grid%landmask(i,j)=dum2d(i,j)
  993. enddo
  994. enddo
  995. ELSE IF ( var_info%name(1:8) .EQ. 'SKINTEMP' ) THEN
  996. READ (13) dum2d
  997. do j=jts,JMAX
  998. do i=its,IMAX
  999. grid%nmm_tsk(i,j)=dum2d(i,j)
  1000. enddo
  1001. enddo
  1002. ELSE IF ( var_info%name(1:8) .EQ. 'TGROUND ' ) THEN
  1003. READ (13) dum2d
  1004. do j=jts,JMAX
  1005. do i=its,IMAX
  1006. grid%tg(i,j)=dum2d(i,j)
  1007. enddo
  1008. enddo
  1009. ELSE IF ( var_info%name(1:8) .EQ. 'SOILTB ' ) THEN
  1010. READ (13) dum2d
  1011. do j=jts,JMAX
  1012. do i=its,IMAX
  1013. grid%soiltb(i,j)=dum2d(i,j)
  1014. enddo
  1015. enddo
  1016. ELSE IF ( var_info%name(1:8) .EQ. 'SST ' ) THEN
  1017. READ (13) dum2d
  1018. do j=jts,JMAX
  1019. do i=its,IMAX
  1020. grid%sst(i,j)=dum2d(i,j)
  1021. enddo
  1022. enddo
  1023. flag_sst = 1
  1024. ELSE IF ( var_info%name(1:8) .EQ. 'GREENFRC' ) THEN
  1025. READ (13) dum2d
  1026. do j=jts,JMAX
  1027. do i=its,IMAX
  1028. grid%vegfrc(i,j)=dum2d(i,j)
  1029. enddo
  1030. enddo
  1031. ELSE IF ( var_info%name(1:8) .EQ. 'ISLOPE ' ) THEN
  1032. READ (13) dum2d
  1033. do j=jts,JMAX
  1034. do i=its,IMAX
  1035. grid%islope(i,j)=nint(dum2d(i,j))
  1036. enddo
  1037. enddo
  1038. ELSE IF ( var_info%name(1:8) .EQ. 'GREENMAX' ) THEN
  1039. READ (13) dum2d
  1040. do j=jts,JMAX
  1041. do i=its,IMAX
  1042. grid%greenmax(i,j)=dum2d(i,j)
  1043. enddo
  1044. enddo
  1045. ELSE IF ( var_info%name(1:8) .EQ. 'GREENMIN' ) THEN
  1046. READ (13) dum2d
  1047. do j=jts,JMAX
  1048. do i=its,IMAX
  1049. grid%greenmin(i,j)=dum2d(i,j)
  1050. enddo
  1051. enddo
  1052. ELSE IF ( var_info%name(1:8) .EQ. 'FIS ' ) THEN
  1053. READ (13) dum2d
  1054. do j=jts,JMAX
  1055. do i=its,IMAX
  1056. grid%fis(i,j)=dum2d(i,j)
  1057. enddo
  1058. enddo
  1059. ELSE IF ( var_info%name(1:8) .EQ. 'Z0 ' ) THEN
  1060. ! ELSE IF ( var_info%name(1:8) .EQ. 'STDEV ' ) THEN
  1061. READ (13) dum2d
  1062. do j=jts,JMAX
  1063. do i=its,IMAX
  1064. grid%z0(i,j)=dum2d(i,j)
  1065. enddo
  1066. enddo
  1067. ELSE IF ( var_info%name(1:8) .EQ. 'CMC ' ) THEN
  1068. READ (13) dum2d
  1069. do j=jts,JMAX
  1070. do i=its,IMAX

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