sparring_old.F90 45 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077
  1. program SPARRING
  2. ! reading from NetCDF files and passing the data to OASIS
  3. ! units for the climatic parameters:
  4. ! temperature (K)
  5. ! precipitation (m s-1)
  6. ! radiation (W m-2)
  7. ! Last update: 10 Dec 2015 - add 2 new fields for low veg. - see "ecev3"
  8. ! Now reads AMIP output.
  9. use mod_oasis
  10. use mpi
  11. implicit none
  12. ! integer,parameter :: MAXGRID = 35718
  13. integer,parameter :: MAXGRID = 88838
  14. integer,parameter :: num_years = 10
  15. integer,parameter :: start_year = 1850
  16. integer,parameter :: num_loops = 10
  17. integer,parameter :: t_max_year = 365
  18. integer,parameter :: t_max_leap = 366
  19. character(len=6),parameter :: model_name = "SPARRI"
  20. double precision :: minhlai,maxhlai,minllai,maxllai
  21. double precision :: meanhlai,meanllai,meanvegl,meanvegh
  22. double precision :: maxcvh,maxcvl,maxtvl,maxtvh,cover
  23. ! PM, was SPATEMPE, SPAPRECI, SPARADIA, SPATOLAI
  24. character(len=128),parameter :: f_temp_name = "T2MVeg"
  25. integer :: f_temp_id = -77
  26. double precision :: f_temp_data(MAXGRID,1)
  27. character(len=128),parameter :: f_prec_name = "TPVeg"
  28. integer :: f_prec_id = -77
  29. double precision :: f_prec_data(MAXGRID,1)
  30. double precision :: f_precs_data(MAXGRID,1)
  31. double precision :: f_precc_data(MAXGRID,1)
  32. double precision :: f_snowfall_data(MAXGRID,1)
  33. character(len=128),parameter :: f_vegl_name = "CVLVeg"
  34. integer :: f_vegl_id = -77
  35. double precision :: f_vegl_data(MAXGRID,1)
  36. character(len=128),parameter :: f_vegltype_name = "TVLVeg"
  37. integer :: f_vegltype_id = -77
  38. double precision :: f_vegltype_data(MAXGRID,1)
  39. character(len=128),parameter :: f_vegh_name = "CVHVeg"
  40. integer :: f_vegh_id = -77
  41. double precision :: f_vegh_data(MAXGRID,1)
  42. character(len=128),parameter :: f_snoc_name = "SDVeg"
  43. integer :: f_snoc_id = -77
  44. double precision :: f_snoc_data(MAXGRID,1)
  45. character(len=128),parameter :: f_snod_name = "SDensVeg"
  46. integer :: f_snod_id = -77
  47. double precision :: f_snod_data(MAXGRID,1)
  48. character(len=128),parameter :: f_st1l_name = "SoilTVeg.L001"
  49. integer :: f_st1l_id = -77
  50. double precision :: f_st1l_data(MAXGRID,1)
  51. character(len=128),parameter :: f_st2l_name = "SoilTVeg.L002"
  52. integer :: f_st2l_id = -77
  53. double precision :: f_st2l_data(MAXGRID,1)
  54. character(len=128),parameter :: f_st3l_name = "SoilTVeg.L003"
  55. integer :: f_st3l_id = -77
  56. double precision :: f_st3l_data(MAXGRID,1)
  57. character(len=128),parameter :: f_st4l_name = "SoilTVeg.L004"
  58. integer :: f_st4l_id = -77
  59. double precision :: f_st4l_data(MAXGRID,1)
  60. character(len=128),parameter :: f_sm1l_name = "SoilMVeg.L001"
  61. integer :: f_sm1l_id = -77
  62. double precision :: f_sm1l_data(MAXGRID,1)
  63. character(len=128),parameter :: f_sm2l_name = "SoilMVeg.L002"
  64. integer :: f_sm2l_id = -77
  65. double precision :: f_sm2l_data(MAXGRID,1)
  66. character(len=128),parameter :: f_sm3l_name = "SoilMVeg.L003"
  67. integer :: f_sm3l_id = -77
  68. double precision :: f_sm3l_data(MAXGRID,1)
  69. character(len=128),parameter :: f_sm4l_name = "SoilMVeg.L004"
  70. integer :: f_sm4l_id = -77
  71. double precision :: f_sm4l_data(MAXGRID,1)
  72. character(len=128),parameter :: f_radi_name = "SSRVeg"
  73. integer :: f_radi_id = -77
  74. double precision :: f_radi_data(MAXGRID,1)
  75. character(len=128),parameter :: f_llai_name = "LAILVeg"
  76. integer :: f_llai_id = -77
  77. double precision :: f_llai_data(MAXGRID,1)
  78. character(len=128),parameter :: f_hlai_name = "LAIHVeg"
  79. integer :: f_hlai_id = -77
  80. double precision :: f_hlai_data(MAXGRID,1)
  81. character(len=128),parameter :: f_typh_name = "TypeHVeg"
  82. integer :: f_typh_id = -77
  83. double precision :: f_typh_data(MAXGRID,1)
  84. character(len=128),parameter :: f_vggh_name = "FracHVeg"
  85. integer :: f_vggh_id = -77
  86. double precision :: f_vggh_data(MAXGRID,1)
  87. ! ecev3
  88. character(len=128),parameter :: f_typl_name = "TypeLVeg"
  89. integer :: f_typl_id = -77
  90. double precision :: f_typl_data(MAXGRID,1)
  91. ! ecev3
  92. character(len=128),parameter :: f_vggl_name = "FracLVeg"
  93. integer :: f_vggl_id = -77
  94. double precision :: f_vggl_data(MAXGRID,1)
  95. integer :: comp_id = -77
  96. integer :: part_id = -77
  97. integer :: t,t_step,yr,lyr,t_max,t_step_full,cell,loopyr
  98. integer :: ierror
  99. integer::ix,iy
  100. ! character(len=*),parameter::nc_temp_file="/nobackup/rossby15/sm_paumi/preind/dpic_var167+1849.nc"
  101. ! character(len=*),parameter::nc_prec_file="/nobackup/rossby15/sm_paumi/preind/dpic_var142+1849.nc"
  102. ! character(len=*),parameter::nc_radi_file="/nobackup/rossby15/sm_paumi/preind/dpic_var169+1849.nc"
  103. ! VARIABLE FIELDS
  104. character(len=100) :: nc_temp_file
  105. character(len=100) :: nc_precs_file
  106. character(len=100) :: nc_precc_file
  107. character(len=100) :: nc_snowfall_file
  108. character(len=100) :: nc_st1l_file
  109. character(len=100) :: nc_st2l_file
  110. character(len=100) :: nc_st3l_file
  111. character(len=100) :: nc_st4l_file
  112. character(len=100) :: nc_sm1l_file
  113. character(len=100) :: nc_sm2l_file
  114. character(len=100) :: nc_sm3l_file
  115. character(len=100) :: nc_sm4l_file
  116. character(len=100) :: nc_radi_file
  117. ! FIXED FIELDS - T159!!!!
  118. character(len=*),parameter::nc_vegltype_file="/nobackup/rossby15/sm_paumi/preind/tvl.nc"
  119. character(len=*),parameter::nc_veghtype_file="/nobackup/rossby15/sm_paumi/preind/tvh.nc"
  120. ! STEM FOR VARIABLE FIELDS
  121. ! character(len=*),parameter::nc_file_path="/nobackup/rossby15/sm_paumi/ecev3/processed/"
  122. ! NEW, AMIP OUTPUT:
  123. character(len=*),parameter::nc_file_path="/nobackup/rossby18/sm_wyser/ecearth3-amip/processed/daily/"
  124. character(len=*),parameter::nc_file_tail="_dayavg.nc"
  125. logical :: isleapyear = .false.
  126. character yearstr*4
  127. ! VARIABLE NAMES
  128. character(len=*),parameter::nc_temp_name="var167"
  129. character(len=*),parameter::nc_precs_name="var142"
  130. character(len=*),parameter::nc_precc_name="var143"
  131. character(len=*),parameter::nc_snowfall_name="var144"
  132. ! We do not have the SNOC and SNOD data, so we send fixed values to guess below.
  133. character(len=*),parameter::nc_st1l_name="var139"
  134. character(len=*),parameter::nc_st2l_name="var170"
  135. ! ST3L and ST4L - we do not have this data, so we'll send ST2L values instead - see below.
  136. character(len=*),parameter::nc_st3l_name="var183"
  137. character(len=*),parameter::nc_st4l_name="var236"
  138. character(len=*),parameter::nc_sm1l_name="var039" ! AMIP files have this
  139. character(len=*),parameter::nc_sm2l_name="var040"
  140. character(len=*),parameter::nc_sm3l_name="var041"
  141. character(len=*),parameter::nc_sm4l_name="var042"
  142. character(len=*),parameter::nc_sm1l_varname="var39"
  143. character(len=*),parameter::nc_sm2l_varname="var40"
  144. character(len=*),parameter::nc_sm3l_varname="var41"
  145. character(len=*),parameter::nc_sm4l_varname="var42"
  146. character(len=*),parameter::nc_radi_name="var176"
  147. character(len=*),parameter::nc_vegl_name="tvl"
  148. character(len=*),parameter::nc_vegh_name="tvh"
  149. ! FIELD IDS
  150. integer::nc_temp_fileid,nc_precs_fileid,nc_radi_fileid,nc_vegl_fileid,nc_vegh_fileid,nc_precc_fileid,nc_snowfall_fileid;
  151. integer::nc_temp_varid,nc_precs_varid,nc_radi_varid,nc_vegl_varid,nc_vegh_varid,nc_precc_varid,nc_snowfall_varid;
  152. integer::nc_vegltype_varid; ! We don't have a T255 file for vegltype yet
  153. integer::nc_st1l_fileid,nc_st2l_fileid,nc_st3l_fileid,nc_st4l_fileid;
  154. integer::nc_st1l_varid,nc_st2l_varid,nc_st3l_varid,nc_st4l_varid;
  155. integer::nc_sm1l_fileid,nc_sm2l_fileid,nc_sm3l_fileid,nc_sm4l_fileid;
  156. integer::nc_sm1l_varid,nc_sm2l_varid,nc_sm3l_varid,nc_sm4l_varid;
  157. integer::localcomm, cplcomm, icpl;
  158. ! *** START ***
  159. write (*,'(A)') "*II* sparring: Hello"
  160. write (*,'(A)') "*II* sparring: Now initialising Sparring using oasis_..."
  161. call oasis_init_comp(comp_id,model_name,ierror)
  162. write (*,'(A,I3)') "*II* sparring: oasis_init_comp returned ierror=",ierror
  163. ! call oasis_get_localcomm(localcomm, ierror)
  164. ! write (*,'(A,I3)') "*II* sparring: get_localcomm ierror=",ierror
  165. ! write (*,'(A,I12)') "*II* sparring: oasis_get_localcomm returned localcomm =",localcomm
  166. icpl = 1
  167. call oasis_create_couplcomm(icpl,MPI_COMM_SELF, cplcomm, ierror)
  168. ! call oasis_create_couplcomm(icpl,localcomm, cplcomm, ierror)
  169. write (*,'(A,I3)') "*II* sparring: oasis_create_couplcomm ierror=",ierror
  170. write (*,'(A,I12)') "*II* sparring: oasis_create_couplcomm returned cplcomm =",cplcomm
  171. call oasis_def_partition(part_id,(/ 0,0,MAXGRID*1 /),ierror)
  172. write (*,'(A,I3)') "*II* sparring: oasis_def_partition returned part_id =",part_id
  173. write (*,'(A,I3)') "*II* sparring: oasis_def_partition returned ierror =",ierror
  174. call oasis_def_var( f_temp_id, &
  175. f_temp_name, &
  176. part_id, &
  177. (/ 2,1 /), &
  178. PRISM_Out, &
  179. (/ 1,MAXGRID,1,1 /), &
  180. PRISM_Real, &
  181. ierror )
  182. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_temp_id =",f_temp_id
  183. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  184. call oasis_def_var( f_prec_id, &
  185. f_prec_name, &
  186. part_id, &
  187. (/ 2,1 /), &
  188. PRISM_Out, &
  189. (/ 1,MAXGRID,1,1 /), &
  190. PRISM_Real, &
  191. ierror )
  192. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_prec_id =",f_prec_id
  193. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  194. call oasis_def_var( f_vegl_id, &
  195. f_vegl_name, &
  196. part_id, &
  197. (/ 2,1 /), &
  198. PRISM_Out, &
  199. (/ 1,MAXGRID,1,1 /), &
  200. PRISM_Real, &
  201. ierror )
  202. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_vegl_id =",f_vegl_id
  203. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  204. call oasis_def_var( f_vegh_id, &
  205. f_vegh_name, &
  206. part_id, &
  207. (/ 2,1 /), &
  208. PRISM_Out, &
  209. (/ 1,MAXGRID,1,1 /), &
  210. PRISM_Real, &
  211. ierror )
  212. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_vegh_id =",f_vegh_id
  213. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  214. call oasis_def_var( f_snoc_id, &
  215. f_snoc_name, &
  216. part_id, &
  217. (/ 2,1 /), &
  218. PRISM_Out, &
  219. (/ 1,MAXGRID,1,1 /), &
  220. PRISM_Real, &
  221. ierror )
  222. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_snoc_id =",f_snoc_id
  223. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  224. call oasis_def_var( f_snod_id, &
  225. f_snod_name, &
  226. part_id, &
  227. (/ 2,1 /), &
  228. PRISM_Out, &
  229. (/ 1,MAXGRID,1,1 /), &
  230. PRISM_Real, &
  231. ierror )
  232. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_snod_id =",f_snod_id
  233. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  234. call oasis_def_var( f_st1l_id, &
  235. f_st1l_name, &
  236. part_id, &
  237. (/ 2,1 /), &
  238. PRISM_Out, &
  239. (/ 1,MAXGRID,1,1 /), &
  240. PRISM_Real, &
  241. ierror )
  242. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_st1l_id =",f_st1l_id
  243. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  244. call oasis_def_var( f_st2l_id, &
  245. f_st2l_name, &
  246. part_id, &
  247. (/ 2,1 /), &
  248. PRISM_Out, &
  249. (/ 1,MAXGRID,1,1 /), &
  250. PRISM_Real, &
  251. ierror )
  252. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_st2l_id =",f_st2l_id
  253. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  254. call oasis_def_var( f_st3l_id, &
  255. f_st3l_name, &
  256. part_id, &
  257. (/ 2,1 /), &
  258. PRISM_Out, &
  259. (/ 1,MAXGRID,1,1 /), &
  260. PRISM_Real, &
  261. ierror )
  262. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_st3l_id =",f_st3l_id
  263. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  264. call oasis_def_var( f_st4l_id, &
  265. f_st4l_name, &
  266. part_id, &
  267. (/ 2,1 /), &
  268. PRISM_Out, &
  269. (/ 1,MAXGRID,1,1 /), &
  270. PRISM_Real, &
  271. ierror )
  272. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_st4l_id =",f_st4l_id
  273. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  274. call oasis_def_var( f_sm1l_id, &
  275. f_sm1l_name, &
  276. part_id, &
  277. (/ 2,1 /), &
  278. PRISM_Out, &
  279. (/ 1,MAXGRID,1,1 /), &
  280. PRISM_Real, &
  281. ierror )
  282. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_sm1l_id =",f_sm1l_id
  283. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  284. call oasis_def_var( f_sm2l_id, &
  285. f_sm2l_name, &
  286. part_id, &
  287. (/ 2,1 /), &
  288. PRISM_Out, &
  289. (/ 1,MAXGRID,1,1 /), &
  290. PRISM_Real, &
  291. ierror )
  292. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_sm2l_id =",f_sm2l_id
  293. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  294. call oasis_def_var( f_sm3l_id, &
  295. f_sm3l_name, &
  296. part_id, &
  297. (/ 2,1 /), &
  298. PRISM_Out, &
  299. (/ 1,MAXGRID,1,1 /), &
  300. PRISM_Real, &
  301. ierror )
  302. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_sm3l_id =",f_sm3l_id
  303. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  304. call oasis_def_var( f_sm4l_id, &
  305. f_sm4l_name, &
  306. part_id, &
  307. (/ 2,1 /), &
  308. PRISM_Out, &
  309. (/ 1,MAXGRID,1,1 /), &
  310. PRISM_Real, &
  311. ierror )
  312. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_sm4l_id =",f_sm4l_id
  313. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  314. call oasis_def_var( f_radi_id, &
  315. f_radi_name, &
  316. part_id, &
  317. (/ 2,1 /), &
  318. PRISM_Out, &
  319. (/ 1,MAXGRID,1,1 /), &
  320. PRISM_Real, &
  321. ierror )
  322. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_radi_id =",f_radi_id
  323. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  324. ! VEGLTYPE
  325. call oasis_def_var( f_vegltype_id, &
  326. f_vegltype_name, &
  327. part_id, &
  328. (/ 2,1 /), &
  329. PRISM_Out, &
  330. (/ 1,MAXGRID,1,1 /), &
  331. PRISM_Real, &
  332. ierror )
  333. write (*,'(A,I3)') "*II* sparring: f_vegltype_id =",f_vegltype_id
  334. write (*,'(A,I3)') "*II* sparring: returned ierror=",ierror
  335. ! LLAI
  336. call oasis_def_var( f_llai_id, &
  337. f_llai_name, &
  338. part_id, &
  339. (/ 2,1 /), &
  340. PRISM_In, &
  341. (/ 1,MAXGRID,1,1 /), &
  342. PRISM_Real, &
  343. ierror )
  344. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_llai_id =",f_llai_id
  345. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  346. ! HLAI
  347. call oasis_def_var( f_hlai_id, &
  348. f_hlai_name, &
  349. part_id, &
  350. (/ 2,1 /), &
  351. PRISM_In, &
  352. (/ 1,MAXGRID,1,1 /), &
  353. PRISM_Real, &
  354. ierror )
  355. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_hlai_id =",f_hlai_id
  356. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  357. ! TYPH
  358. call oasis_def_var( f_typh_id, &
  359. f_typh_name, &
  360. part_id, &
  361. (/ 2,1 /), &
  362. PRISM_In, &
  363. (/ 1,MAXGRID,1,1 /), &
  364. PRISM_Real, &
  365. ierror )
  366. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_typh_id =",f_typh_id
  367. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  368. ! VEGH
  369. call oasis_def_var( f_vggh_id, &
  370. f_vggh_name, &
  371. part_id, &
  372. (/ 2,1 /), &
  373. PRISM_In, &
  374. (/ 1,MAXGRID,1,1 /), &
  375. PRISM_Real, &
  376. ierror )
  377. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_vggh_id =",f_vggh_id
  378. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  379. ! ecev3 TYPL
  380. call oasis_def_var( f_typl_id, &
  381. f_typl_name, &
  382. part_id, &
  383. (/ 2,1 /), &
  384. PRISM_In, &
  385. (/ 1,MAXGRID,1,1 /), &
  386. PRISM_Real, &
  387. ierror )
  388. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_typl_id =",f_typl_id
  389. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  390. ! ecev3 VEGL
  391. call oasis_def_var( f_vggl_id, &
  392. f_vggl_name, &
  393. part_id, &
  394. (/ 2,1 /), &
  395. PRISM_In, &
  396. (/ 1,MAXGRID,1,1 /), &
  397. PRISM_Real, &
  398. ierror )
  399. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned f_vggl_id =",f_vggl_id
  400. write (*,'(A,I3)') "*II* sparring: oasis_def_var returned ierror =",ierror
  401. write (*,'(A)') "*II* sparring: before call oasis_enddef(ierror)"
  402. call oasis_enddef(ierror)
  403. write (*,'(A,I3)') "*II* sparring: oasis_enddef returned ierror =",ierror
  404. ! FIXED FIELDS
  405. write (*,'(A)') "*II* sparring: Reading vegl and vegh"
  406. ! VEGL
  407. ! call read_fixedfiels(MAXGRID,1,nc_vegl_file,nc_vegl_name,&
  408. ! f_vegl_data,nc_vegl_fileid,nc_vegl_varid)
  409. ! VEGH
  410. ! call read_fixedfiels(MAXGRID,1,nc_vegh_file,nc_vegh_name,&
  411. ! f_vegh_data,nc_vegh_fileid,nc_vegh_varid)
  412. write (*,'(A)') "*II* sparring: Beginning time loop"
  413. t_step_full = 0
  414. ! Repetitions of forcing
  415. do lyr = 1, num_loops
  416. ! Year loop
  417. do loopyr = start_year, start_year+num_years-1
  418. yr = loopyr
  419. if (loopyr < 1870) yr = loopyr + 20
  420. ! if (loopyr < 1870 .and. loopyr > 1859) yr = loopyr + 10
  421. ! Leap year?
  422. isleapyear = .false.
  423. if (mod(yr,4) .eq. 0) isleapyear = .true.
  424. if (mod(yr,100) .eq. 0) isleapyear = .false.
  425. if (mod(yr,400) .eq. 0) isleapyear = .true.
  426. ! Create file names
  427. write(unit=yearstr, fmt='(I4)') yr
  428. nc_temp_file = nc_file_path//nc_temp_name//"_"//yearstr//nc_file_tail
  429. write (*,'(A)') nc_temp_file
  430. nc_precs_file = nc_file_path//nc_precs_name//"_"//yearstr//nc_file_tail
  431. write (*,'(A)') nc_precs_file
  432. nc_precc_file = nc_file_path//nc_precc_name//"_"//yearstr//nc_file_tail
  433. write (*,'(A)') nc_precc_file
  434. nc_snowfall_file=nc_file_path//nc_snowfall_name//"_"//yearstr//nc_file_tail
  435. write (*,'(A)') nc_snowfall_file
  436. nc_st1l_file=nc_file_path//nc_st1l_name//"_"//yearstr//nc_file_tail
  437. write (*,'(A)') nc_st1l_file
  438. nc_st2l_file=nc_file_path//nc_st2l_name//"_"//yearstr//nc_file_tail
  439. write (*,'(A)') nc_st2l_file
  440. !nc_st3l_file = nc_file_path // nc_st3l_name // "_" // yearstr
  441. !write (*,'(A)') nc_st3l_file
  442. !nc_st4l_file = nc_file_path // nc_st4l_name // "_" // yearstr // ".nc"
  443. !write (*,'(A)') nc_st4l_file
  444. nc_sm1l_file=nc_file_path//nc_sm1l_name//"_"//yearstr//nc_file_tail
  445. write (*,'(A)') nc_sm1l_file
  446. nc_sm2l_file = nc_file_path//nc_sm2l_name//"_"//yearstr//nc_file_tail
  447. write (*,'(A)') nc_sm2l_file
  448. nc_sm3l_file = nc_file_path//nc_sm3l_name//"_"//yearstr//nc_file_tail
  449. write (*,'(A)') nc_sm3l_file
  450. nc_sm4l_file = nc_file_path // nc_sm4l_name //"_"//yearstr//nc_file_tail
  451. write (*,'(A)') nc_sm4l_file
  452. nc_radi_file = nc_file_path // nc_radi_name//"_"//yearstr//nc_file_tail
  453. write (*,'(A)') nc_radi_file
  454. if (isleapyear .eq. .true.) then
  455. t_max = t_max_leap
  456. else
  457. t_max = t_max_year
  458. endif
  459. ! Day/6-hr loop for each year
  460. write (*,'(A,I5)') "*II* sparring: t_max =",t_max
  461. do t_step=0,t_max-1
  462. t = t_step_full*86400
  463. ! reading climate data from NetCDF file
  464. ! PM - changed to 6,12 from 2,6
  465. write (*,'(A,I6,A,I12)') "*II* sparring before read_ifstest: Time step t = ",t_step," - time t=",t
  466. ! PM to _pi version
  467. call read_ifstest_pi(MAXGRID,1,t_step,t_max,nc_temp_file,nc_temp_name,&
  468. f_temp_data,nc_temp_fileid,nc_temp_varid)
  469. call read_ifstest_pi(MAXGRID,1,t_step,t_max,nc_precs_file,nc_precs_name,&
  470. f_precs_data,nc_precs_fileid,nc_precs_varid)
  471. call read_ifstest_pi(MAXGRID,1,t_step,t_max,nc_precc_file,nc_precc_name,&
  472. f_precc_data,nc_precc_fileid,nc_precc_varid)
  473. ! PM - changed to 6,12 from 2,6
  474. write (*,'(A,I6,A,I12)') "*II* sparring after precip: Time step t = ",t_step," - time t=",t
  475. call read_ifstest_pi_depth(MAXGRID,1,t_step,t_max,nc_st1l_file,nc_st1l_name,&
  476. f_st1l_data,nc_st1l_fileid,nc_st1l_varid)
  477. call read_ifstest_pi_depth(MAXGRID,1,t_step,t_max,nc_st2l_file,nc_st2l_name,&
  478. f_st2l_data,nc_st2l_fileid,nc_st2l_varid)
  479. ! PM - changed to 6,12 from 2,6
  480. !write (*,'(A,I6,A,I12)') "*II* sparring after st1l and st2l: Time step t = ",t_step," - time t=",t
  481. !call read_ifstest_pi(MAXGRID,1,t_step,t_max,nc_st3l_file,nc_st3l_name,&
  482. ! f_st3l_data,nc_st3l_fileid,nc_st3l_varid)
  483. !call read_ifstest_pi(MAXGRID,1,t_step,t_max,nc_st4l_file,nc_st4l_name,&
  484. ! f_st4l_data,nc_st4l_fileid,nc_st4l_varid)
  485. call read_ifstest_pi_depth(MAXGRID,1,t_step,t_max,nc_sm1l_file,nc_sm1l_varname,&
  486. f_sm1l_data,nc_sm1l_fileid,nc_sm1l_varid)
  487. call read_ifstest_pi_depth(MAXGRID,1,t_step,t_max,nc_sm2l_file,nc_sm2l_varname,&
  488. f_sm2l_data,nc_sm2l_fileid,nc_sm2l_varid)
  489. call read_ifstest_pi_depth(MAXGRID,1,t_step,t_max,nc_sm3l_file,nc_sm3l_varname,&
  490. f_sm3l_data,nc_sm3l_fileid,nc_sm3l_varid)
  491. call read_ifstest_pi_depth(MAXGRID,1,t_step,t_max,nc_sm4l_file,nc_sm4l_varname,&
  492. f_sm4l_data,nc_sm4l_fileid,nc_sm4l_varid)
  493. ! PM - changed to 6,12 from 2,6
  494. write (*,'(A,I6,A,I12)') "*II* sparring after SM files: Time step t = ",t_step," - time t=",t
  495. call read_ifstest_pi(MAXGRID,1,t_step,t_max,nc_snowfall_file,nc_snowfall_name,&
  496. f_snowfall_data,nc_snowfall_fileid,nc_snowfall_varid)
  497. call read_ifstest_pi(MAXGRID,1,t_step,t_max,nc_radi_file,nc_radi_name,&
  498. f_radi_data,nc_radi_fileid,nc_radi_varid)
  499. ! Sum precipitation and snow components
  500. ! Replace ST3L and ST4L with values from ST2L
  501. do cell = 1, MAXGRID
  502. ! Total precip includes snow here
  503. f_prec_data(cell,1) = 4 * 1000.0 *(f_precs_data(cell,1) + f_precc_data(cell,1) + f_snowfall_data(cell,1))
  504. ! AMIP data have units m/6h average, so *4 *
  505. ! 1000 to get mm/day
  506. ! Now * 1000 and / 1000 to go to kg m-2 day-1,
  507. ! and / 86400.0 to get to kg m-2 s-1
  508. ! PM_Apr2012 - convert m to kg m-2 s-1 to mimic ECE - we'll convert back in LPJG
  509. f_prec_data(cell,1)=f_prec_data(cell,1)/86400.0
  510. f_st3l_data(cell,1) = f_st2l_data(cell,1)
  511. f_st4l_data(cell,1) = f_st2l_data(cell,1)
  512. ! Snow
  513. f_snoc_data(cell,1) = 0.0
  514. f_snod_data(cell,1) = 330.0
  515. ! PM_Apr2012 - change J m-2 to W m-2 to be consistent with ECE. We'll remove the / in LPJG.
  516. f_radi_data(cell,1) = 4* f_radi_data(cell,1) / 86400.0
  517. enddo
  518. do cell = 1, MAXGRID
  519. ! Enforce vegltype as grassland
  520. f_vegltype_data(cell,1) = 2;
  521. enddo
  522. ! PM - changed to 6,12 from 2,6
  523. write (*,'(A,I6,A,I12)') "*II* sparring after ifstest: Time step t = ",t_step," - time t=",t
  524. ! -----------------------------------------------------------------------------------
  525. ! *** PUT variables
  526. ! -----------------------------------------------------------------------------------
  527. write (*,'(A,I6,A,I12)') "*II* sparringPUT : Time step t = ",t_step," - time t=",t
  528. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_temp_id =",f_temp_id
  529. call oasis_put(f_temp_id,t,f_temp_data,ierror)
  530. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  531. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_radi_id =",f_radi_id
  532. call oasis_put(f_radi_id,t,f_radi_data,ierror)
  533. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  534. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_sm1l_id =",f_sm1l_id
  535. call oasis_put(f_sm1l_id,t,f_sm1l_data,ierror)
  536. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  537. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_sm2l_id =",f_sm2l_id
  538. call oasis_put(f_sm2l_id,t,f_sm2l_data,ierror)
  539. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  540. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_sm3l_id =",f_sm3l_id
  541. call oasis_put(f_sm3l_id,t,f_sm3l_data,ierror)
  542. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  543. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_sm4l_id =",f_sm4l_id
  544. call oasis_put(f_sm4l_id,t,f_sm4l_data,ierror)
  545. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  546. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_st1l_id =",f_st1l_id
  547. call oasis_put(f_st1l_id,t,f_st1l_data,ierror)
  548. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  549. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_st2l_id =",f_st2l_id
  550. call oasis_put(f_st2l_id,t,f_st2l_data,ierror)
  551. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  552. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_st3l_id =",f_st3l_id
  553. call oasis_put(f_st3l_id,t,f_st3l_data,ierror)
  554. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  555. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_st4l_id =",f_st4l_id
  556. call oasis_put(f_st4l_id,t,f_st4l_data,ierror)
  557. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  558. ! Snow mass/unit surface (kg/m2)
  559. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_snoc_id =",f_snoc_id
  560. call oasis_put(f_snoc_id,t,f_snoc_data,ierror)
  561. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  562. ! Snow density (kg/m3)
  563. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_snod_id =",f_snod_id
  564. call oasis_put(f_snod_id,t,f_snod_data,ierror)
  565. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  566. ! Veg low
  567. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_vegl_id =",f_vegl_id
  568. call oasis_put(f_vegl_id,t,f_vegl_data,ierror)
  569. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  570. ! Veg type low
  571. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_vegltype_id =",f_vegltype_id
  572. call oasis_put(f_vegltype_id,t,f_vegltype_data,ierror)
  573. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  574. ! Veg high
  575. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_vegh_id =",f_vegh_id
  576. call oasis_put(f_vegh_id,t,f_vegh_data,ierror)
  577. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  578. write (*,'(A,I3)') "*II* sparring: calling oasis_put with f_prec_id =",f_prec_id
  579. call oasis_put(f_prec_id,t,f_prec_data,ierror)
  580. write (*,'(A,I3)') "*II* sparring: oasis_put returned ierror =",ierror
  581. ! -----------------------------------------------------------------------------------
  582. ! *** GET variables
  583. ! -----------------------------------------------------------------------------------
  584. write (*,'(A,I6,A,I12)') "*II* sparringGET : Time step t = ",t_step," - time t=",t
  585. write (*,'(A,I3)') "*II* sparring: calling oasis_get with f_llai_id =",f_llai_id
  586. call oasis_get(f_llai_id,t,f_llai_data,ierror)
  587. write (*,'(A,I3)') "*II* sparring: oasis_get returned ierror =",ierror
  588. write (*,'(A,I3)') "*II* sparring: calling oasis_get with f_hlai_id =",f_hlai_id
  589. call oasis_get(f_hlai_id,t,f_hlai_data,ierror)
  590. write (*,'(A,I3)') "*II* sparring: oasis_get returned ierror =",ierror
  591. write (*,'(A,I3)') "*II* sparring: calling oasis_get with f_typh_id =",f_typh_id
  592. call oasis_get(f_typh_id,t,f_typh_data,ierror)
  593. write (*,'(A,I3)') "*II* sparring: oasis_get returned ierror =",ierror
  594. write (*,'(A,I3)') "*II* sparring: calling oasis_get with f_vggh_id =",f_vggh_id
  595. call oasis_get(f_vggh_id,t,f_vggh_data,ierror)
  596. write (*,'(A,I3)') "*II* sparring: oasis_get returned ierror =",ierror
  597. ! ecev3
  598. write (*,'(A,I3)') "*II* sparring: calling oasis_get with f_typl_id =",f_typl_id
  599. call oasis_get(f_typl_id,t,f_typl_data,ierror)
  600. write (*,'(A,I3)') "*II* sparring: oasis_get returned ierror =",ierror
  601. ! ecev3
  602. write (*,'(A,I3)') "*II* sparring: calling oasis_get with f_vggl_id =",f_vggl_id
  603. call oasis_get(f_vggl_id,t,f_vggl_data,ierror)
  604. write (*,'(A,I3)') "*II* sparring: oasis_get returned ierror =",ierror
  605. ! checking whether the incoming LAI data are ok:
  606. write(*,*)"*II* sparring: LLAI obtained from OASIS for test gridcell (g=8000) is ",f_llai_data(8000,1)
  607. write(*,*)"*II* sparring: HLAI obtained from OASIS for test gridcell (g=8000) is ",f_hlai_data(8000,1)
  608. write(*,*)"*II* sparring: TYPH obtained from OASIS for test gridcell (g=8000) is ",f_typh_data(8000,1)
  609. write(*,*)"*II* sparring: VEGH obtained from OASIS for test gridcell (g=8000) is ",f_vggh_data(8000,1)
  610. write(*,*)"*II* sparring: TYPL obtained from OASIS for test gridcell (g=8000) is ",f_typl_data(8000,1)
  611. write(*,*)"*II* sparring: VEGL obtained from OASIS for test gridcell (g=8000) is ",f_vggl_data(8000,1)
  612. write (*,'(A,I6,A,I12)') "*II* sparring DIAGS LAI check: Time step t = ",t_step," - time t=",t
  613. ! Check for min/max LAI
  614. minhlai=0
  615. maxhlai=0
  616. minllai=0
  617. maxllai=0
  618. meanhlai=0
  619. meanllai=0
  620. meanvegl=0
  621. meanvegh=0
  622. maxcvh=-1
  623. maxcvl=-1
  624. maxtvh=-1
  625. maxtvl=-1
  626. cover=0.0
  627. do cell = 1, MAXGRID
  628. if (f_llai_data(cell,1)>maxllai)then
  629. maxllai=f_llai_data(cell,1)
  630. endif
  631. meanllai = meanllai + f_llai_data(cell,1)/MAXGRID
  632. if (f_llai_data(cell,1)<minllai)then
  633. minllai=f_llai_data(cell,1)
  634. endif
  635. if (f_hlai_data(cell,1)>maxhlai)then
  636. maxhlai=f_hlai_data(cell,1)
  637. endif
  638. if (f_hlai_data(cell,1)<minhlai)then
  639. minhlai=f_hlai_data(cell,1)
  640. endif
  641. meanhlai = meanhlai + f_hlai_data(cell,1)/MAXGRID
  642. if (f_vggl_data(cell,1)>maxcvl)then
  643. maxcvl=f_vggl_data(cell,1)
  644. endif
  645. if (f_vggh_data(cell,1)>maxcvh)then
  646. maxcvh=f_vggh_data(cell,1)
  647. endif
  648. meanvegl = meanvegl + f_vegl_data(cell,1)/MAXGRID
  649. meanvegh = meanvegh + f_vegh_data(cell,1)/MAXGRID
  650. if (f_typl_data(cell,1)>maxtvl)then
  651. maxtvl=f_typl_data(cell,1)
  652. endif
  653. if (f_typh_data(cell,1)>maxtvh)then
  654. maxtvh=f_typh_data(cell,1)
  655. endif
  656. cover=f_vggl_data(cell,1)+f_vggh_data(cell,1)
  657. if (cover>1.001) then
  658. write(*,*)"*II* sparring: COVER ERROR!",cover
  659. endif
  660. enddo
  661. write(*,*)"*II* sparring DIAGS: MAX HLAI :",maxhlai
  662. write(*,*)"*II* sparring: MIN HLAI :",minhlai
  663. write(*,*)"*II* sparring: MAX LLAI :",maxllai
  664. write(*,*)"*II* sparring: MIN LLAI :",minllai
  665. write(*,*)"*II* sparring: MEAN LLAI :",meanllai
  666. write(*,*)"*II* sparring: MEAN HLAI :",meanhlai
  667. write(*,*)"*II* sparring: MEAN VEGL :",meanvegl
  668. write(*,*)"*II* sparring: MEAN VEGH :",meanvegh
  669. write(*,*)"*II* sparring: MAX VEGL :",maxcvl
  670. write(*,*)"*II* sparring: MAX VEGH :",maxcvh
  671. write(*,*)"*II* sparring: MAX TYPL :",maxtvl
  672. write(*,*)"*II* sparring: MAX TYPH :",maxtvh
  673. write (*,*) "*II* sparring: Finished dayloop!",t_step, t_max
  674. ! Increase the full simulation counter
  675. t_step_full = t_step_full + 1
  676. ! End of dayloop
  677. enddo
  678. write (*,*) "*II* sparring: End of year!",loopyr
  679. ! End of year loop
  680. enddo
  681. write (*,'(A)') "*II* sparring: Finished time loop!"
  682. ! End of repetition loop
  683. enddo
  684. write (*,'(A)') "*II* sparring: oasis_terminate..."
  685. call oasis_terminate(ierror)
  686. write (*,'(A,I3)') "*II* sparring: oasis_terminate returned ierror =",ierror
  687. end program SPARRING
  688. ! PM - for pre-Industrial nc files.
  689. ! now reads new_ files
  690. ! ---------------------------------------------------------------------------------------------------------------
  691. subroutine read_ifstest_pi(NX,NY,t_step,t_max,filename,parname, &
  692. data_in,fileid,varid)
  693. ! NetCDF
  694. use netcdf
  695. implicit none
  696. integer::NX,NY,t_step,t_max
  697. character(len=*)::filename
  698. character(len=*)::parname
  699. double precision::data_in(NX,NY)
  700. integer::fileid
  701. integer::varid
  702. ! for older dpic_ files:
  703. !integer::start(2),count(2)
  704. !start=(/1,t_step+1/)
  705. !count=(/NX,NY/)
  706. ! for new_ files:
  707. integer::start(3),count(3)
  708. start=(/1,1,t_step+1/)
  709. count=(/NX,NY,1/)
  710. ! read file properties in first occasion
  711. if(t_step==0)then
  712. call check(nf90_open(filename,NF90_NOWRITE,fileid))
  713. call check(nf90_inq_varid(fileid,parname,varid))
  714. endif
  715. ! read field for given timestep
  716. call check(nf90_get_var(fileid,varid,data_in,start=start,count=count))
  717. ! close NetCDF file
  718. if(t_step==t_max-1)then
  719. call check(nf90_close(fileid))
  720. endif
  721. end
  722. ! PM - for pre-Industrial nc files with DEPTH
  723. ! ---------------------------------------------------------------------------------------------------------------
  724. subroutine read_ifstest_pi_depth(NX,NY,t_step,t_max,filename,parname, &
  725. data_in,fileid,varid)
  726. ! NetCDF
  727. use netcdf
  728. implicit none
  729. integer::NX,NY,t_step,t_max
  730. character(len=*)::filename
  731. character(len=*)::parname
  732. double precision::data_in(NX,NY)
  733. integer::fileid
  734. integer::varid
  735. ! double precision::data_in(NX,NY)
  736. ! integer::fileid
  737. ! integer::varid
  738. !integer::start(3),count(3)
  739. !start=(/1,1,t_step+1/)
  740. !count=(/NX,NY,1/)
  741. ! new_ files
  742. integer::start(4),count(4)
  743. start=(/1,1,1,t_step+1/)
  744. count=(/NX,NY,1,1/)
  745. ! read file properties in first occasion
  746. if(t_step==0)then
  747. call check(nf90_open(filename,NF90_NOWRITE,fileid))
  748. call check(nf90_inq_varid(fileid,parname,varid))
  749. endif
  750. ! read field for given timestep
  751. call check(nf90_get_var(fileid,varid,data_in,start=start,count=count))
  752. ! close NetCDF file
  753. if(t_step==t_max-1)then
  754. call check(nf90_close(fileid))
  755. endif
  756. end
  757. ! PM - for fixed nc files.
  758. ! ---------------------------------------------------------------------------------------------------------------
  759. subroutine read_fixedfiels(NX,NY,filename,parname,data_in,fileid,varid)
  760. ! NetCDF
  761. use netcdf
  762. implicit none
  763. integer::NX,NY
  764. character(len=*)::filename
  765. character(len=*)::parname
  766. double precision::data_in(NX,NY)
  767. integer::fileid
  768. integer::varid
  769. integer::start(2),count(2)
  770. start=(/1,1/)
  771. count=(/NX,NY/)
  772. ! read file properties in first occasion
  773. call check(nf90_open(filename,NF90_NOWRITE,fileid))
  774. call check(nf90_inq_varid(fileid,parname,varid))
  775. ! read field
  776. call check(nf90_get_var(fileid,varid,data_in,start=start,count=count))
  777. ! close NetCDF file
  778. call check(nf90_close(fileid))
  779. end
  780. ! ---------------------------------------------------------------------------------------------------------------
  781. subroutine read_ifstest(NX,NY,t_step,t_max,filename,parname, &
  782. data_in,fileid,varid)
  783. ! NetCDF
  784. use netcdf
  785. implicit none
  786. integer::NX,NY,t_step,t_max
  787. character(len=*)::filename
  788. character(len=*)::parname
  789. double precision::data_in(NX,NY)
  790. integer::fileid
  791. integer::varid
  792. integer::start(3),count(3)
  793. start=(/1,1,t_step+1/)
  794. count=(/NX,NY,1/)
  795. ! read file properties in first occasion
  796. if(t_step==0)then
  797. call check(nf90_open(filename,NF90_NOWRITE,fileid))
  798. call check(nf90_inq_varid(fileid,parname,varid))
  799. endif
  800. ! read field for given timestep
  801. call check(nf90_get_var(fileid,varid,data_in,start=start,count=count))
  802. ! close NetCDF file
  803. if(t_step==t_max-1)then
  804. call check(nf90_close(fileid))
  805. endif
  806. end
  807. ! ---------------------------------------------------------------------------------------------------------------
  808. subroutine check(status)
  809. use netcdf
  810. integer, intent ( in) :: status
  811. if(status /= nf90_noerr) then
  812. print *, trim(nf90_strerror(status))
  813. stop "Stopped"
  814. end if
  815. end subroutine check
  816. ! ---------------------------------------------------------------------------------------------------------------