lpjg_forcing_ifs.F90 44 KB

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