global_cycle  1.11.0
read_write_data.f90
Go to the documentation of this file.
1 
5 
8 MODULE read_write_data
9 
10  USE netcdf
11 
12  PRIVATE
13 
14 ! DATA STRUCTURE TO HOLD ALL NSST RECORDS.
15 
16  TYPE, PUBLIC :: nsst_data
17  REAL, ALLOCATABLE :: C_0(:)
18  REAL, ALLOCATABLE :: C_D(:)
19  REAL, ALLOCATABLE :: D_CONV(:)
20  REAL, ALLOCATABLE :: DT_COOL(:)
21  REAL, ALLOCATABLE :: IFD(:)
22  REAL, ALLOCATABLE :: QRAIN(:)
23  REAL, ALLOCATABLE :: TREF(:)
24  REAL, ALLOCATABLE :: TFINC(:)
25  REAL, ALLOCATABLE :: W_0(:)
26  REAL, ALLOCATABLE :: W_D(:)
27  REAL, ALLOCATABLE :: XS(:)
28  REAL, ALLOCATABLE :: XT(:)
29  REAL, ALLOCATABLE :: XTTS(:)
30  REAL, ALLOCATABLE :: XU(:)
31  REAL, ALLOCATABLE :: XV(:)
32  REAL, ALLOCATABLE :: XZ(:)
33  REAL, ALLOCATABLE :: XZTS(:)
34  REAL, ALLOCATABLE :: Z_C(:)
35  REAL, ALLOCATABLE :: ZM(:)
36  END TYPE nsst_data
37 
38  INTEGER, PUBLIC :: idim_gaus
40  INTEGER, PUBLIC :: jdim_gaus
42  INTEGER, ALLOCATABLE, PUBLIC :: slmsk_gaus(:,:)
44 
45  INTEGER, ALLOCATABLE, PUBLIC :: soilsnow_gaus(:,:)
48 
49  REAL, ALLOCATABLE, PUBLIC :: dtref_gaus(:,:)
51 
52  REAL, ALLOCATABLE, PUBLIC :: stc_inc_gaus(:,:,:)
54 
55  REAL, ALLOCATABLE, PUBLIC :: slc_inc_gaus(:,:,:)
57 
58  PUBLIC :: read_data
59  PUBLIC :: read_gsi_data
60  PUBLIC :: read_lat_lon_orog
61  PUBLIC :: write_data
62  public :: read_tf_clim_grb,get_tf_clm_dim
63  public :: read_salclm_gfs_nc,get_dim_nc
64 
65  CONTAINS
66 
119 
120  subroutine write_data(lensfc,idim,jdim,lsoil, &
121  do_nsst,nsst,slifcs,tsffcs,vegfcs,swefcs, &
122  tg3fcs,zorfcs,albfcs,alffcs, &
123  cnpfcs,f10m,t2m,q2m,vetfcs, &
124  sotfcs,ustar,fmm,fhh,sicfcs, &
125  sihfcs,sitfcs,tprcp,srflag, &
126  swdfcs,vmnfcs,vmxfcs,slpfcs, &
127  absfcs,slcfcs,smcfcs,stcfcs)
128 
129  use mpi
130 
131  implicit none
132 
133  integer, intent(in) :: lensfc, lsoil
134  integer, intent(in) :: idim, jdim
135 
136  logical, intent(in) :: do_nsst
137 
138  real, intent(in), optional :: slifcs(lensfc),tsffcs(lensfc)
139  real, intent(in), optional :: swefcs(lensfc),tg3fcs(lensfc)
140  real, intent(in), optional :: zorfcs(lensfc),albfcs(lensfc,4)
141  real, intent(in), optional :: alffcs(lensfc,2),cnpfcs(lensfc)
142  real, intent(in), optional :: f10m(lensfc),t2m(lensfc)
143  real, intent(in), optional :: q2m(lensfc),vegfcs(lensfc)
144  real, intent(in), optional :: vetfcs(lensfc),sotfcs(lensfc)
145  real, intent(in), optional :: ustar(lensfc),fmm(lensfc)
146  real, intent(in), optional :: fhh(lensfc), sicfcs(lensfc)
147  real, intent(in), optional :: sihfcs(lensfc), sitfcs(lensfc)
148  real, intent(in), optional :: tprcp(lensfc), srflag(lensfc)
149  real, intent(in), optional :: swdfcs(lensfc), vmnfcs(lensfc)
150  real, intent(in), optional :: vmxfcs(lensfc), slpfcs(lensfc)
151  real, intent(in), optional :: absfcs(lensfc), slcfcs(lensfc,lsoil)
152  real, intent(in), optional :: smcfcs(lensfc,lsoil), stcfcs(lensfc,lsoil)
153 
154  type(nsst_data), intent(in) :: nsst
155 
156  integer :: dim_x, dim_y, dim_time, dims_3d(3)
157 
158  real :: dum2d(idim,jdim), dum3d(idim,jdim,lsoil)
159 
160  character(len=50) :: fnbgso
161  character(len=3) :: rankch
162 
163  integer :: myrank, error, ncid, id_var
164 
165  call mpi_comm_rank(mpi_comm_world, myrank, error)
166 
167  write(rankch, '(i3.3)') (myrank+1)
168 
169  fnbgso = "./fnbgso." // rankch
170 
171  print*
172  print*,"update OUTPUT SFC DATA TO: ",trim(fnbgso)
173 
174  error=nf90_open(trim(fnbgso),nf90_write,ncid)
175  CALL netcdf_err(error, 'OPENING FILE: '//trim(fnbgso) )
176 
177  if(present(slifcs)) then
178  error=nf90_inq_varid(ncid, "slmsk", id_var)
179  call netcdf_err(error, 'reading slmsk id' )
180  dum2d = reshape(slifcs, (/idim,jdim/))
181  error = nf90_put_var( ncid, id_var, dum2d)
182  call netcdf_err(error, 'writing slmsk record' )
183  call remove_checksum(ncid, id_var)
184  endif
185 
186  if(present(tsffcs)) then
187  error=nf90_inq_varid(ncid, "tsea", id_var)
188  call netcdf_err(error, 'reading tsea id' )
189  dum2d = reshape(tsffcs, (/idim,jdim/))
190  error = nf90_put_var( ncid, id_var, dum2d)
191  call netcdf_err(error, 'writing tsea record' )
192  call remove_checksum(ncid, id_var)
193  endif
194 
195  if(present(swefcs)) then
196  error=nf90_inq_varid(ncid, "sheleg", id_var)
197  call netcdf_err(error, 'reading sheleg id' )
198  dum2d = reshape(swefcs, (/idim,jdim/))
199  error = nf90_put_var( ncid, id_var, dum2d)
200  call netcdf_err(error, 'writing sheleg record' )
201  call remove_checksum(ncid, id_var)
202  endif
203 
204  if(present(tg3fcs)) then
205  error=nf90_inq_varid(ncid, "tg3", id_var)
206  call netcdf_err(error, 'reading tg3 id' )
207  dum2d = reshape(tg3fcs, (/idim,jdim/))
208  error = nf90_put_var( ncid, id_var, dum2d)
209  call netcdf_err(error, 'writing tg3 record' )
210  call remove_checksum(ncid, id_var)
211  endif
212 
213  if(present(zorfcs)) then
214  error=nf90_inq_varid(ncid, "zorl", id_var)
215  call netcdf_err(error, 'reading zorl id' )
216  dum2d = reshape(zorfcs, (/idim,jdim/))
217  error = nf90_put_var( ncid, id_var, dum2d)
218  call netcdf_err(error, 'writing zorl record' )
219  call remove_checksum(ncid, id_var)
220  endif
221 
222  if(present(albfcs)) then
223  error=nf90_inq_varid(ncid, "alvsf", id_var)
224  call netcdf_err(error, 'reading alvsf id' )
225  dum2d = reshape(albfcs(:,1), (/idim,jdim/))
226  error = nf90_put_var( ncid, id_var, dum2d)
227  call netcdf_err(error, 'writing alvsf record' )
228  call remove_checksum(ncid, id_var)
229 
230  error=nf90_inq_varid(ncid, "alvwf", id_var)
231  call netcdf_err(error, 'reading alvwf id' )
232  dum2d = reshape(albfcs(:,2), (/idim,jdim/))
233  error = nf90_put_var( ncid, id_var, dum2d)
234  call netcdf_err(error, 'writing alvwf record' )
235  call remove_checksum(ncid, id_var)
236 
237  error=nf90_inq_varid(ncid, "alnsf", id_var)
238  call netcdf_err(error, 'reading alnsf id' )
239  dum2d = reshape(albfcs(:,3), (/idim,jdim/))
240  error = nf90_put_var( ncid, id_var, dum2d)
241  call netcdf_err(error, 'writing alnsf record' )
242  call remove_checksum(ncid, id_var)
243 
244  error=nf90_inq_varid(ncid, "alnwf", id_var)
245  call netcdf_err(error, 'reading alnwf id' )
246  dum2d = reshape(albfcs(:,4), (/idim,jdim/))
247  error = nf90_put_var( ncid, id_var, dum2d)
248  call netcdf_err(error, 'writing alnwf record' )
249  call remove_checksum(ncid, id_var)
250  endif
251 
252  if(present(alffcs)) then
253  error=nf90_inq_varid(ncid, "facsf", id_var)
254  call netcdf_err(error, 'reading facsf id' )
255  dum2d = reshape(alffcs(:,1), (/idim,jdim/))
256  error = nf90_put_var( ncid, id_var, dum2d)
257  call netcdf_err(error, 'writing facsf record' )
258  call remove_checksum(ncid, id_var)
259 
260  error=nf90_inq_varid(ncid, "facwf", id_var)
261  call netcdf_err(error, 'reading facwf id' )
262  dum2d = reshape(alffcs(:,2), (/idim,jdim/))
263  error = nf90_put_var( ncid, id_var, dum2d)
264  call netcdf_err(error, 'writing facwf record' )
265  call remove_checksum(ncid, id_var)
266  endif
267 
268  if(present(vegfcs)) then
269  error=nf90_inq_varid(ncid, "vfrac", id_var)
270  call netcdf_err(error, 'reading vfrac id' )
271  dum2d = reshape(vegfcs, (/idim,jdim/))
272  error = nf90_put_var( ncid, id_var, dum2d)
273  call netcdf_err(error, 'writing vegfcs record' )
274  call remove_checksum(ncid, id_var)
275  endif
276 
277  if(present(cnpfcs)) then
278  error=nf90_inq_varid(ncid, "canopy", id_var)
279  call netcdf_err(error, 'reading canopy id' )
280  dum2d = reshape(cnpfcs, (/idim,jdim/))
281  error = nf90_put_var( ncid, id_var, dum2d)
282  call netcdf_err(error, 'writing canopy record' )
283  call remove_checksum(ncid, id_var)
284  endif
285 
286  if(present(f10m)) then
287  error=nf90_inq_varid(ncid, "f10m", id_var)
288  call netcdf_err(error, 'reading f10m id' )
289  dum2d = reshape(f10m, (/idim,jdim/))
290  error = nf90_put_var( ncid, id_var, dum2d)
291  call netcdf_err(error, 'writing f10m record' )
292  call remove_checksum(ncid, id_var)
293  endif
294 
295  if(present(t2m)) then
296  error=nf90_inq_varid(ncid, "t2m", id_var)
297  call netcdf_err(error, 'reading t2m id' )
298  dum2d = reshape(t2m, (/idim,jdim/))
299  error = nf90_put_var( ncid, id_var, dum2d)
300  call netcdf_err(error, 'writing t2m record' )
301  call remove_checksum(ncid, id_var)
302  endif
303 
304  if(present(q2m)) then
305  error=nf90_inq_varid(ncid, "q2m", id_var)
306  call netcdf_err(error, 'reading q2m id' )
307  dum2d = reshape(q2m, (/idim,jdim/))
308  error = nf90_put_var( ncid, id_var, dum2d)
309  call netcdf_err(error, 'writing q2m record' )
310  call remove_checksum(ncid, id_var)
311  endif
312 
313  if(present(vetfcs)) then
314  error=nf90_inq_varid(ncid, "vtype", id_var)
315  call netcdf_err(error, 'reading vtype id' )
316  dum2d = reshape(vetfcs, (/idim,jdim/))
317  error = nf90_put_var( ncid, id_var, dum2d)
318  call netcdf_err(error, 'writing vtype record' )
319  call remove_checksum(ncid, id_var)
320  endif
321 
322  if(present(sotfcs)) then
323  error=nf90_inq_varid(ncid, "stype", id_var)
324  call netcdf_err(error, 'reading stype id' )
325  dum2d = reshape(sotfcs, (/idim,jdim/))
326  error = nf90_put_var( ncid, id_var, dum2d)
327  call netcdf_err(error, 'writing stype record' )
328  call remove_checksum(ncid, id_var)
329  endif
330 
331  if(present(ustar)) then
332  error=nf90_inq_varid(ncid, "uustar", id_var)
333  call netcdf_err(error, 'reading uustar id' )
334  dum2d = reshape(ustar, (/idim,jdim/))
335  error = nf90_put_var( ncid, id_var, dum2d)
336  call netcdf_err(error, 'writing uustar record' )
337  call remove_checksum(ncid, id_var)
338  endif
339 
340  if(present(fmm)) then
341  error=nf90_inq_varid(ncid, "ffmm", id_var)
342  call netcdf_err(error, 'reading ffmm id' )
343  dum2d = reshape(fmm, (/idim,jdim/))
344  error = nf90_put_var( ncid, id_var, dum2d)
345  call netcdf_err(error, 'writing ffmm record' )
346  call remove_checksum(ncid, id_var)
347  endif
348 
349  if(present(fhh)) then
350  error=nf90_inq_varid(ncid, "ffhh", id_var)
351  call netcdf_err(error, 'reading ffhh id' )
352  dum2d = reshape(fhh, (/idim,jdim/))
353  error = nf90_put_var( ncid, id_var, dum2d)
354  call netcdf_err(error, 'writing ffhh record' )
355  call remove_checksum(ncid, id_var)
356  endif
357 
358  if(present(sicfcs)) then
359  error=nf90_inq_varid(ncid, "fice", id_var)
360  call netcdf_err(error, 'reading fice id' )
361  dum2d = reshape(sicfcs, (/idim,jdim/))
362  error = nf90_put_var( ncid, id_var, dum2d)
363  call netcdf_err(error, 'writing fice record' )
364  call remove_checksum(ncid, id_var)
365  endif
366 
367  if(present(sihfcs)) then
368  error=nf90_inq_varid(ncid, "hice", id_var)
369  call netcdf_err(error, 'reading hice id' )
370  dum2d = reshape(sihfcs, (/idim,jdim/))
371  error = nf90_put_var( ncid, id_var, dum2d)
372  call netcdf_err(error, 'writing hice record' )
373  call remove_checksum(ncid, id_var)
374  endif
375 
376  if(present(sitfcs)) then
377  error=nf90_inq_varid(ncid, "tisfc", id_var)
378  call netcdf_err(error, 'reading tisfc id' )
379  dum2d = reshape(sitfcs, (/idim,jdim/))
380  error = nf90_put_var( ncid, id_var, dum2d)
381  call netcdf_err(error, 'writing tisfc record' )
382  call remove_checksum(ncid, id_var)
383  endif
384 
385  if(present(tprcp)) then
386  error=nf90_inq_varid(ncid, "tprcp", id_var)
387  call netcdf_err(error, 'reading tprcp id' )
388  dum2d = reshape(tprcp, (/idim,jdim/))
389  error = nf90_put_var( ncid, id_var, dum2d)
390  call netcdf_err(error, 'writing tprcp record' )
391  call remove_checksum(ncid, id_var)
392  endif
393 
394  if(present(srflag)) then
395  error=nf90_inq_varid(ncid, "srflag", id_var)
396  call netcdf_err(error, 'reading srflag id' )
397  dum2d = reshape(srflag, (/idim,jdim/))
398  error = nf90_put_var( ncid, id_var, dum2d)
399  call netcdf_err(error, 'writing srflag record' )
400  call remove_checksum(ncid, id_var)
401  endif
402 
403  if(present(swdfcs)) then
404  error=nf90_inq_varid(ncid, "snwdph", id_var)
405  call netcdf_err(error, 'reading snwdph id' )
406  dum2d = reshape(swdfcs, (/idim,jdim/))
407  error = nf90_put_var( ncid, id_var, dum2d)
408  call netcdf_err(error, 'writing snwdph record' )
409  call remove_checksum(ncid, id_var)
410  endif
411 
412  if(present(vmnfcs)) then
413  error=nf90_inq_varid(ncid, "shdmin", id_var)
414  call netcdf_err(error, 'reading shdmin id' )
415  dum2d = reshape(vmnfcs, (/idim,jdim/))
416  error = nf90_put_var( ncid, id_var, dum2d)
417  call netcdf_err(error, 'writing shdmin record' )
418  call remove_checksum(ncid, id_var)
419  endif
420 
421  if(present(vmxfcs)) then
422  error=nf90_inq_varid(ncid, "shdmax", id_var)
423  call netcdf_err(error, 'reading shdmax id' )
424  dum2d = reshape(vmxfcs, (/idim,jdim/))
425  error = nf90_put_var( ncid, id_var, dum2d)
426  call netcdf_err(error, 'writing shdmax record' )
427  call remove_checksum(ncid, id_var)
428  endif
429 
430  if(present(slpfcs)) then
431  error=nf90_inq_varid(ncid, "slope", id_var)
432  call netcdf_err(error, 'reading slope id' )
433  dum2d = reshape(slpfcs, (/idim,jdim/))
434  error = nf90_put_var( ncid, id_var, dum2d)
435  call netcdf_err(error, 'writing slope record' )
436  call remove_checksum(ncid, id_var)
437  endif
438 
439  if(present(absfcs)) then
440  error=nf90_inq_varid(ncid, "snoalb", id_var)
441  call netcdf_err(error, 'reading snoalb id' )
442  dum2d = reshape(absfcs, (/idim,jdim/))
443  error = nf90_put_var( ncid, id_var, dum2d)
444  call netcdf_err(error, 'writing snoalb record' )
445  call remove_checksum(ncid, id_var)
446  endif
447 
448  if(present(slcfcs)) then
449  error=nf90_inq_varid(ncid, "slc", id_var)
450  call netcdf_err(error, 'reading slc id' )
451  dum3d = reshape(slcfcs, (/idim,jdim,lsoil/))
452  error = nf90_put_var( ncid, id_var, dum3d)
453  call netcdf_err(error, 'writing slc record' )
454  call remove_checksum(ncid, id_var)
455  endif
456 
457  if(present(smcfcs)) then
458  error=nf90_inq_varid(ncid, "smc", id_var)
459  call netcdf_err(error, 'reading smc id' )
460  dum3d = reshape(smcfcs, (/idim,jdim,lsoil/))
461  error = nf90_put_var( ncid, id_var, dum3d)
462  call netcdf_err(error, 'writing smc record' )
463  call remove_checksum(ncid, id_var)
464  endif
465 
466  if(present(stcfcs)) then
467  error=nf90_inq_varid(ncid, "stc", id_var)
468  call netcdf_err(error, 'reading stc id' )
469  dum3d = reshape(stcfcs, (/idim,jdim,lsoil/))
470  error = nf90_put_var( ncid, id_var, dum3d)
471  call netcdf_err(error, 'writing stc record' )
472  call remove_checksum(ncid, id_var)
473  endif
474 
475  if(do_nsst) then
476 
477  error=nf90_inq_varid(ncid, "tref", id_var)
478  call netcdf_err(error, 'reading tref id' )
479  dum2d = reshape(nsst%tref, (/idim,jdim/))
480  error = nf90_put_var( ncid, id_var, dum2d)
481  call netcdf_err(error, 'WRITING TREF RECORD' )
482  call remove_checksum(ncid, id_var)
483 
484  error=nf90_inq_varid(ncid, "z_c", id_var)
485  call netcdf_err(error, 'reading z_c id' )
486  dum2d = reshape(nsst%z_c, (/idim,jdim/))
487  error = nf90_put_var( ncid, id_var, dum2d)
488  call netcdf_err(error, 'WRITING Z_C RECORD' )
489  call remove_checksum(ncid, id_var)
490 
491  error=nf90_inq_varid(ncid, "c_0", id_var)
492  call netcdf_err(error, 'reading c_0 id' )
493  dum2d = reshape(nsst%c_0, (/idim,jdim/))
494  error = nf90_put_var( ncid, id_var, dum2d)
495  call netcdf_err(error, 'WRITING C_0 RECORD' )
496  call remove_checksum(ncid, id_var)
497 
498  error=nf90_inq_varid(ncid, "c_d", id_var)
499  call netcdf_err(error, 'reading c_d id' )
500  dum2d = reshape(nsst%c_d, (/idim,jdim/))
501  error = nf90_put_var( ncid, id_var, dum2d)
502  call netcdf_err(error, 'WRITING C_D RECORD' )
503  call remove_checksum(ncid, id_var)
504 
505  error=nf90_inq_varid(ncid, "w_0", id_var)
506  call netcdf_err(error, 'reading w_0 id' )
507  dum2d = reshape(nsst%w_0, (/idim,jdim/))
508  error = nf90_put_var( ncid, id_var, dum2d)
509  call netcdf_err(error, 'WRITING W_0 RECORD' )
510  call remove_checksum(ncid, id_var)
511 
512  error=nf90_inq_varid(ncid, "w_d", id_var)
513  call netcdf_err(error, 'reading w_d id' )
514  dum2d = reshape(nsst%w_d, (/idim,jdim/))
515  error = nf90_put_var( ncid, id_var, dum2d)
516  call netcdf_err(error, 'WRITING W_D RECORD' )
517  call remove_checksum(ncid, id_var)
518 
519  error=nf90_inq_varid(ncid, "xt", id_var)
520  call netcdf_err(error, 'reading xt id' )
521  dum2d = reshape(nsst%xt, (/idim,jdim/))
522  error = nf90_put_var( ncid, id_var, dum2d)
523  call netcdf_err(error, 'WRITING XT RECORD' )
524  call remove_checksum(ncid, id_var)
525 
526  error=nf90_inq_varid(ncid, "xs", id_var)
527  call netcdf_err(error, 'reading xs id' )
528  dum2d = reshape(nsst%xs, (/idim,jdim/))
529  error = nf90_put_var( ncid, id_var, dum2d)
530  call netcdf_err(error, 'WRITING XS RECORD' )
531  call remove_checksum(ncid, id_var)
532 
533  error=nf90_inq_varid(ncid, "xu", id_var)
534  call netcdf_err(error, 'reading xu id' )
535  dum2d = reshape(nsst%xu, (/idim,jdim/))
536  error = nf90_put_var( ncid, id_var, dum2d)
537  call netcdf_err(error, 'WRITING XU RECORD' )
538  call remove_checksum(ncid, id_var)
539 
540  error=nf90_inq_varid(ncid, "xv", id_var)
541  call netcdf_err(error, 'reading xv id' )
542  dum2d = reshape(nsst%xv, (/idim,jdim/))
543  error = nf90_put_var( ncid, id_var, dum2d)
544  call netcdf_err(error, 'WRITING XV RECORD' )
545  call remove_checksum(ncid, id_var)
546 
547  error=nf90_inq_varid(ncid, "xz", id_var)
548  call netcdf_err(error, 'reading xz id' )
549  dum2d = reshape(nsst%xz, (/idim,jdim/))
550  error = nf90_put_var( ncid, id_var, dum2d)
551  call netcdf_err(error, 'WRITING XZ RECORD' )
552  call remove_checksum(ncid, id_var)
553 
554  error=nf90_inq_varid(ncid, "zm", id_var)
555  call netcdf_err(error, 'reading zm id' )
556  dum2d = reshape(nsst%zm, (/idim,jdim/))
557  error = nf90_put_var( ncid, id_var, dum2d)
558  call netcdf_err(error, 'WRITING ZM RECORD' )
559  call remove_checksum(ncid, id_var)
560 
561  error=nf90_inq_varid(ncid, "xtts", id_var)
562  call netcdf_err(error, 'reading xtts id' )
563  dum2d = reshape(nsst%xtts, (/idim,jdim/))
564  error = nf90_put_var( ncid, id_var, dum2d)
565  call netcdf_err(error, 'WRITING XTTS RECORD' )
566  call remove_checksum(ncid, id_var)
567 
568  error=nf90_inq_varid(ncid, "xzts", id_var)
569  call netcdf_err(error, 'reading xzts id' )
570  dum2d = reshape(nsst%xzts, (/idim,jdim/))
571  error = nf90_put_var( ncid, id_var, dum2d)
572  call netcdf_err(error, 'WRITING XZTS RECORD' )
573  call remove_checksum(ncid, id_var)
574 
575  error=nf90_inq_varid(ncid, "d_conv", id_var)
576  call netcdf_err(error, 'reading d_conv id' )
577  dum2d = reshape(nsst%d_conv, (/idim,jdim/))
578  error = nf90_put_var( ncid, id_var, dum2d)
579  call netcdf_err(error, 'WRITING D_CONV RECORD' )
580  call remove_checksum(ncid, id_var)
581 
582  error=nf90_inq_varid(ncid, "ifd", id_var)
583  call netcdf_err(error, 'reading idf id' )
584  dum2d = reshape(nsst%ifd, (/idim,jdim/))
585  error = nf90_put_var( ncid, id_var, dum2d)
586  call netcdf_err(error, 'WRITING IFD RECORD' )
587  call remove_checksum(ncid, id_var)
588 
589  error=nf90_inq_varid(ncid, "dt_cool", id_var)
590  call netcdf_err(error, 'reading dt_cool id' )
591  dum2d = reshape(nsst%dt_cool, (/idim,jdim/))
592  error = nf90_put_var( ncid, id_var, dum2d)
593  call netcdf_err(error, 'WRITING DT_COOL RECORD' )
594  call remove_checksum(ncid, id_var)
595 
596  error=nf90_inq_varid(ncid, "qrain", id_var)
597  call netcdf_err(error, 'reading qrain id' )
598  dum2d = reshape(nsst%qrain, (/idim,jdim/))
599  error = nf90_put_var( ncid, id_var, dum2d)
600  call netcdf_err(error, 'WRITING QRAIN RECORD' )
601  call remove_checksum(ncid, id_var)
602 
603 ! Some files don't include 'tfinc', which is just diagnostic.
604 ! If missing, then add it to the restart file.
605  error=nf90_inq_varid(ncid, "tfinc", id_var)
606  if (error /= 0) then
607  error=nf90_inq_dimid(ncid, "xaxis_1", dim_x)
608  call netcdf_err(error, 'finding xaxis_1' )
609  error=nf90_inq_dimid(ncid, "yaxis_1", dim_y)
610  call netcdf_err(error, 'finding yaxis_1' )
611  error=nf90_inq_dimid(ncid, "Time", dim_time)
612  call netcdf_err(error, 'finding Time' )
613  dims_3d(1) = dim_x
614  dims_3d(2) = dim_y
615  dims_3d(3) = dim_time
616  error=nf90_redef(ncid)
617  error = nf90_def_var(ncid, 'tfinc', nf90_double, dims_3d, id_var)
618  call netcdf_err(error, 'DEFINING tfinc' )
619  error = nf90_put_att(ncid, id_var, "long_name", "tfinc")
620  call netcdf_err(error, 'DEFINING tfinc LONG NAME' )
621  error = nf90_put_att(ncid, id_var, "units", "none")
622  call netcdf_err(error, 'DEFINING tfinc UNITS' )
623  error=nf90_enddef(ncid)
624  endif
625  dum2d = reshape(nsst%tfinc, (/idim,jdim/))
626  error = nf90_put_var( ncid, id_var, dum2d)
627  call netcdf_err(error, 'WRITING TFINC RECORD' )
628 
629  endif
630 
631  error = nf90_close(ncid)
632 
633  end subroutine write_data
634 
641  subroutine remove_checksum(ncid, id_var)
642 
643  implicit none
644 
645  integer, intent(in) :: ncid, id_var
646 
647  integer :: error
648 
649  error=nf90_inquire_attribute(ncid, id_var, 'checksum')
650 
651  if (error == 0) then ! attribute was found
652 
653  error = nf90_redef(ncid)
654  call netcdf_err(error, 'entering define mode' )
655 
656  error=nf90_del_att(ncid, id_var, 'checksum')
657  call netcdf_err(error, 'deleting checksum' )
658 
659  error= nf90_enddef(ncid)
660  call netcdf_err(error, 'ending define mode' )
661 
662  endif
663 
664  end subroutine remove_checksum
665 
679  SUBROUTINE read_lat_lon_orog(RLA,RLO,OROG,OROG_UF,&
680  TILE_NUM,IDIM,JDIM,IJDIM)
681 
682  USE mpi
683 
684  IMPLICIT NONE
685 
686  INTEGER, INTENT(IN) :: idim, jdim, ijdim
687 
688  CHARACTER(LEN=5), INTENT(OUT) :: tile_num
689 
690  REAL, INTENT(OUT) :: rla(ijdim),rlo(ijdim)
691  REAL, INTENT(OUT) :: orog(ijdim),orog_uf(ijdim)
692 
693  CHARACTER(LEN=50) :: fnorog, fngrid
694  CHARACTER(LEN=3) :: rankch
695 
696  INTEGER :: error, ncid, ncid_orog
697  INTEGER :: i, ii, j, jj, myrank
698  INTEGER :: id_dim, id_var, nx, ny
699 
700  REAL, ALLOCATABLE :: dummy(:,:), geolat(:,:), geolon(:,:)
701  REAL(KIND=4), ALLOCATABLE :: dummy4(:,:)
702 
703  CALL mpi_comm_rank(mpi_comm_world, myrank, error)
704 
705  WRITE(rankch, '(I3.3)') (myrank+1)
706 
707  fngrid = "./fngrid." // rankch
708 
709  print*
710  print*, "READ FV3 GRID INFO FROM: "//trim(fngrid)
711 
712  error=nf90_open(trim(fngrid),nf90_nowrite,ncid)
713  CALL netcdf_err(error, 'OPENING FILE: '//trim(fngrid) )
714 
715  error=nf90_inq_dimid(ncid, 'nx', id_dim)
716  CALL netcdf_err(error, 'ERROR READING NX ID' )
717 
718  error=nf90_inquire_dimension(ncid,id_dim,len=nx)
719  CALL netcdf_err(error, 'ERROR READING NX' )
720 
721  error=nf90_inq_dimid(ncid, 'ny', id_dim)
722  CALL netcdf_err(error, 'ERROR READING NY ID' )
723 
724  error=nf90_inquire_dimension(ncid,id_dim,len=ny)
725  CALL netcdf_err(error, 'ERROR READING NY' )
726 
727  IF ((nx/2) /= idim .OR. (ny/2) /= jdim) THEN
728  print*,'FATAL ERROR: DIMENSIONS IN FILE: ',(nx/2),(ny/2)
729  print*,'DO NOT MATCH GRID DIMENSIONS: ',idim,jdim
730  CALL mpi_abort(mpi_comm_world, 130, error)
731  ENDIF
732 
733  ALLOCATE(geolon(nx+1,ny+1))
734  ALLOCATE(geolat(nx+1,ny+1))
735 
736  error=nf90_inq_varid(ncid, 'x', id_var)
737  CALL netcdf_err(error, 'ERROR READING X ID' )
738  error=nf90_get_var(ncid, id_var, geolon)
739  CALL netcdf_err(error, 'ERROR READING X RECORD' )
740 
741  error=nf90_inq_varid(ncid, 'y', id_var)
742  CALL netcdf_err(error, 'ERROR READING Y ID' )
743  error=nf90_get_var(ncid, id_var, geolat)
744  CALL netcdf_err(error, 'ERROR READING Y RECORD' )
745 
746  ALLOCATE(dummy(idim,jdim))
747 
748  DO j = 1, jdim
749  DO i = 1, idim
750  ii = 2*i
751  jj = 2*j
752  dummy(i,j) = geolon(ii,jj)
753  ENDDO
754  ENDDO
755 
756  rlo = reshape(dummy, (/ijdim/))
757 
758  DEALLOCATE(geolon)
759 
760  DO j = 1, jdim
761  DO i = 1, idim
762  ii = 2*i
763  jj = 2*j
764  dummy(i,j) = geolat(ii,jj)
765  ENDDO
766  ENDDO
767 
768  rla = reshape(dummy, (/ijdim/))
769 
770  DEALLOCATE(geolat, dummy)
771 
772  error=nf90_inq_varid(ncid, 'tile', id_var)
773  CALL netcdf_err(error, 'ERROR READING TILE ID' )
774  error=nf90_get_var(ncid, id_var, tile_num)
775  CALL netcdf_err(error, 'ERROR READING TILE RECORD' )
776 
777  error = nf90_close(ncid)
778 
779  fnorog = "./fnorog." // rankch
780 
781  print*
782  print*, "READ FV3 OROG INFO FROM: "//trim(fnorog)
783 
784  error=nf90_open(trim(fnorog),nf90_nowrite,ncid_orog)
785  CALL netcdf_err(error, 'OPENING FILE: '//trim(fnorog) )
786 
787  ALLOCATE(dummy4(idim,jdim))
788 
789  error=nf90_inq_varid(ncid_orog, 'orog_raw', id_var)
790  CALL netcdf_err(error, 'ERROR READING orog_raw ID' )
791  error=nf90_get_var(ncid_orog, id_var, dummy4)
792  CALL netcdf_err(error, 'ERROR READING orog_raw RECORD' )
793  orog_uf = reshape(dummy4, (/ijdim/))
794 
795  error=nf90_inq_varid(ncid_orog, 'orog_filt', id_var)
796  CALL netcdf_err(error, 'ERROR READING orog_filt ID' )
797  error=nf90_get_var(ncid_orog, id_var, dummy4)
798  CALL netcdf_err(error, 'ERROR READING orog_filt RECORD' )
799  orog = reshape(dummy4, (/ijdim/))
800 
801  DEALLOCATE(dummy4)
802 
803  error = nf90_close(ncid_orog)
804 
805  END SUBROUTINE read_lat_lon_orog
806 
813  SUBROUTINE netcdf_err( ERR, STRING )
814 
815  USE mpi
816 
817  IMPLICIT NONE
818 
819  INTEGER, INTENT(IN) :: ERR
820  CHARACTER(LEN=*), INTENT(IN) :: STRING
821  CHARACTER(LEN=80) :: ERRMSG
822  INTEGER :: IRET
823 
824  IF( err == nf90_noerr )RETURN
825  errmsg = nf90_strerror(err)
826  print*,''
827  print*,'FATAL ERROR: ', trim(string), ': ', trim(errmsg)
828  print*,'STOP.'
829  CALL mpi_abort(mpi_comm_world, 999, iret)
830 
831  RETURN
832  END SUBROUTINE netcdf_err
833 
846  SUBROUTINE read_gsi_data(GSI_FILE, FILE_TYPE, LSOIL)
847 
848  IMPLICIT NONE
849 
850  CHARACTER(LEN=*), INTENT(IN) :: gsi_file
851  CHARACTER(LEN=3), INTENT(IN) :: file_type
852  INTEGER, INTENT(IN), OPTIONAL :: lsoil
853 
854  INTEGER :: error, id_dim, ncid
855  INTEGER :: id_var, j
856 
857  INTEGER(KIND=1), ALLOCATABLE :: idummy(:,:)
858 
859  REAL(KIND=8), ALLOCATABLE :: dummy(:,:)
860 
861  CHARACTER(LEN=1) :: k_ch
862  CHARACTER(LEN=10) :: incvar
863  CHARACTER(LEN=80) :: err_msg
864  INTEGER :: k, i
865 
866  print*
867  print*, "READ INPUT GSI DATA FROM: "//trim(gsi_file)
868 
869  error=nf90_open(trim(gsi_file),nf90_nowrite,ncid)
870  CALL netcdf_err(error, 'OPENING FILE: '//trim(gsi_file) )
871 
872  error=nf90_inq_dimid(ncid, 'latitude', id_dim)
873  CALL netcdf_err(error, 'READING latitude ID' )
874  error=nf90_inquire_dimension(ncid,id_dim,len=jdim_gaus)
875  CALL netcdf_err(error, 'READING latitude length' )
876  jdim_gaus = jdim_gaus - 2 ! WILL IGNORE POLE POINTS
877 
878  error=nf90_inq_dimid(ncid, 'longitude', id_dim)
879  CALL netcdf_err(error, 'READING longitude ID' )
880  error=nf90_inquire_dimension(ncid,id_dim,len=idim_gaus)
881  CALL netcdf_err(error, 'READING longitude length' )
882 
883  IF (file_type=='NST') then
884  ALLOCATE(dummy(idim_gaus,jdim_gaus+2))
885  ALLOCATE(dtref_gaus(idim_gaus,jdim_gaus))
886 
887  error=nf90_inq_varid(ncid, "dtf", id_var)
888  CALL netcdf_err(error, 'READING dtf ID' )
889  error=nf90_get_var(ncid, id_var, dummy)
890  CALL netcdf_err(error, 'READING dtf' )
891 
892  ALLOCATE(idummy(idim_gaus,jdim_gaus+2))
893  ALLOCATE(slmsk_gaus(idim_gaus,jdim_gaus))
894 
895  error=nf90_inq_varid(ncid, "msk", id_var)
896  CALL netcdf_err(error, 'READING msk ID' )
897  error=nf90_get_var(ncid, id_var, idummy)
898  CALL netcdf_err(error, 'READING msk' )
899 
900  ! REMOVE POLE POINTS.
901 
902  DO j = 1, jdim_gaus
903  slmsk_gaus(:,j) = idummy(:,j+1)
904  dtref_gaus(:,j) = dummy(:,j+1)
905  ENDDO
906 
907  ELSEIF (file_type=='LND') then
908 
909  ALLOCATE(dummy(idim_gaus,jdim_gaus+2))
910  ALLOCATE(stc_inc_gaus(lsoil,idim_gaus,jdim_gaus))
911  ALLOCATE(slc_inc_gaus(lsoil,idim_gaus,jdim_gaus))
912 
913  ! read in soil temperature increments in each layer
914  DO k = 1, lsoil
915  WRITE(k_ch, '(I1)') k
916 
917  incvar = "soilt"//k_ch//"_inc"
918  error=nf90_inq_varid(ncid, incvar, id_var)
919  err_msg = "reading "//incvar//" ID"
920  CALL netcdf_err(error, trim(err_msg))
921  error=nf90_get_var(ncid, id_var, dummy)
922  err_msg = "reading "//incvar//" data"
923  CALL netcdf_err(error, err_msg)
924 
925  DO j = 1, jdim_gaus
926  stc_inc_gaus(k,:,j) = dummy(:,j+1)
927  ENDDO
928 
929  incvar = "slc"//k_ch//"_inc"
930  error=nf90_inq_varid(ncid, incvar, id_var)
931  err_msg = "reading "//incvar//" ID"
932  CALL netcdf_err(error, trim(err_msg))
933  error=nf90_get_var(ncid, id_var, dummy)
934  err_msg = "reading "//incvar//" data"
935  CALL netcdf_err(error, err_msg)
936 
937  DO j = 1, jdim_gaus
938  slc_inc_gaus(k,:,j) = dummy(:,j+1)
939  ENDDO
940 
941  ENDDO
942 
943  ALLOCATE(idummy(idim_gaus,jdim_gaus+2))
944  ALLOCATE(soilsnow_gaus(idim_gaus,jdim_gaus))
945 
946  error=nf90_inq_varid(ncid, "soilsnow_mask", id_var)
947  CALL netcdf_err(error, 'READING soilsnow_mask ID' )
948  error=nf90_get_var(ncid, id_var, idummy)
949  CALL netcdf_err(error, 'READING soilsnow_mask' )
950 
951  ! REMOVE POLE POINTS.
952 
953  DO j = 1, jdim_gaus
954  soilsnow_gaus(:,j) = idummy(:,j+1)
955  ENDDO
956 
957 
958  ELSE
959  print *, 'WARNING: FILE_TYPE', file_type, 'not recognised.', &
960  ', no increments read in'
961  ENDIF
962 
963  IF(ALLOCATED(dummy)) DEALLOCATE(dummy)
964  IF(ALLOCATED(idummy)) DEALLOCATE(idummy)
965 
966  error = nf90_close(ncid)
967 
968  END SUBROUTINE read_gsi_data
969 
1018  SUBROUTINE read_data(LSOIL,LENSFC,DO_NSST,INC_FILE,IS_NOAHMP, &
1019  TSFFCS,SMCFCS,SWEFCS,STCFCS, &
1020  TG3FCS,ZORFCS, &
1021  CVFCS,CVBFCS,CVTFCS,ALBFCS, &
1022  VEGFCS,SLIFCS,CNPFCS,F10M, &
1023  VETFCS,SOTFCS,ALFFCS, &
1024  USTAR,FMM,FHH, &
1025  SIHFCS,SICFCS,SITFCS, &
1026  TPRCP,SRFLAG,SNDFCS, &
1027  VMNFCS,VMXFCS,SLCFCS, &
1028  SLPFCS,ABSFCS,T2M,Q2M,SLMASK, &
1029  ZSOIL,NSST)
1030  USE mpi
1031 
1032  IMPLICIT NONE
1033 
1034  INTEGER, INTENT(IN) :: lsoil, lensfc
1035  LOGICAL, INTENT(IN) :: do_nsst, inc_file
1036 
1037  LOGICAL, OPTIONAL, INTENT(OUT) :: is_noahmp
1038 
1039  REAL, OPTIONAL, INTENT(OUT) :: cvfcs(lensfc), cvbfcs(lensfc)
1040  REAL, OPTIONAL, INTENT(OUT) :: cvtfcs(lensfc), albfcs(lensfc,4)
1041  REAL, OPTIONAL, INTENT(OUT) :: slifcs(lensfc), cnpfcs(lensfc)
1042  REAL, OPTIONAL, INTENT(OUT) :: vegfcs(lensfc), f10m(lensfc)
1043  REAL, OPTIONAL, INTENT(OUT) :: vetfcs(lensfc), sotfcs(lensfc)
1044  REAL, OPTIONAL, INTENT(OUT) :: tsffcs(lensfc), swefcs(lensfc)
1045  REAL, OPTIONAL, INTENT(OUT) :: tg3fcs(lensfc), zorfcs(lensfc)
1046  REAL, OPTIONAL, INTENT(OUT) :: alffcs(lensfc,2), ustar(lensfc)
1047  REAL, OPTIONAL, INTENT(OUT) :: fmm(lensfc), fhh(lensfc)
1048  REAL, OPTIONAL, INTENT(OUT) :: sihfcs(lensfc), sicfcs(lensfc)
1049  REAL, OPTIONAL, INTENT(OUT) :: sitfcs(lensfc), tprcp(lensfc)
1050  REAL, OPTIONAL, INTENT(OUT) :: srflag(lensfc), sndfcs(lensfc)
1051  REAL, OPTIONAL, INTENT(OUT) :: vmnfcs(lensfc), vmxfcs(lensfc)
1052  REAL, OPTIONAL, INTENT(OUT) :: slpfcs(lensfc), absfcs(lensfc)
1053  REAL, OPTIONAL, INTENT(OUT) :: t2m(lensfc), q2m(lensfc), slmask(lensfc)
1054  REAL, OPTIONAL, INTENT(OUT) :: slcfcs(lensfc,lsoil)
1055  REAL, OPTIONAL, INTENT(OUT) :: smcfcs(lensfc,lsoil)
1056  REAL, OPTIONAL, INTENT(OUT) :: stcfcs(lensfc,lsoil)
1057  REAL(KIND=4), OPTIONAL, INTENT(OUT) :: zsoil(lsoil)
1058 
1059  TYPE(nsst_data), OPTIONAL :: nsst ! intent(out) will crash
1060  ! because subtypes are allocated in main.
1061 
1062  CHARACTER(LEN=50) :: fnbgsi
1063  CHARACTER(LEN=3) :: rankch
1064 
1065  INTEGER :: error, error2, ncid, myrank
1066  INTEGER :: idim, jdim, id_dim
1067  INTEGER :: id_var, ierr
1068 
1069  REAL(KIND=8), ALLOCATABLE :: dummy(:,:), dummy3d(:,:,:)
1070 
1071  CALL mpi_comm_rank(mpi_comm_world, myrank, error)
1072 
1073  WRITE(rankch, '(I3.3)') (myrank+1)
1074 
1075  IF (inc_file) THEN
1076  fnbgsi = "./xainc." // rankch
1077  ELSE
1078  fnbgsi = "./fnbgsi." // rankch
1079  ENDIF
1080 
1081  print*
1082  print*, "READ INPUT SFC DATA FROM: "//trim(fnbgsi)
1083 
1084  error=nf90_open(trim(fnbgsi),nf90_nowrite,ncid)
1085  CALL netcdf_err(error, 'OPENING FILE: '//trim(fnbgsi) )
1086 
1087  error=nf90_inq_dimid(ncid, 'xaxis_1', id_dim)
1088  CALL netcdf_err(error, 'READING xaxis_1' )
1089  error=nf90_inquire_dimension(ncid,id_dim,len=idim)
1090  CALL netcdf_err(error, 'READING xaxis_1' )
1091 
1092  error=nf90_inq_dimid(ncid, 'yaxis_1', id_dim)
1093  CALL netcdf_err(error, 'READING yaxis_1' )
1094  error=nf90_inquire_dimension(ncid,id_dim,len=jdim)
1095  CALL netcdf_err(error, 'READING yaxis_1' )
1096 
1097  IF ((idim*jdim) /= lensfc) THEN
1098  print*,'FATAL ERROR: DIMENSIONS WRONG.'
1099  CALL mpi_abort(mpi_comm_world, 88, ierr)
1100  ENDIF
1101 
1102 ! Check for records that indicate the restart file is
1103 ! for the Noah-MP land surface model.
1104 
1105  IF(PRESENT(is_noahmp))THEN
1106  error=nf90_inq_varid(ncid, "canliqxy", id_var)
1107  error2=nf90_inq_varid(ncid, "tsnoxy", id_var)
1108  is_noahmp=.false.
1109  IF(error == 0 .AND. error2 == 0) THEN
1110  is_noahmp=.true.
1111  print*,"- WILL PROCESS FOR NOAH-MP LSM."
1112  ENDIF
1113  ENDIF
1114 
1115  ALLOCATE(dummy(idim,jdim))
1116 
1117  IF (PRESENT(tsffcs)) THEN
1118  error=nf90_inq_varid(ncid, "tsea", id_var)
1119  CALL netcdf_err(error, 'READING tsea ID' )
1120  error=nf90_get_var(ncid, id_var, dummy)
1121  CALL netcdf_err(error, 'READING tsea' )
1122  tsffcs = reshape(dummy, (/lensfc/))
1123  ENDIF
1124 
1125  IF (PRESENT(swefcs)) THEN
1126  error=nf90_inq_varid(ncid, "sheleg", id_var)
1127  CALL netcdf_err(error, 'READING sheleg ID' )
1128  error=nf90_get_var(ncid, id_var, dummy)
1129  CALL netcdf_err(error, 'READING sheleg' )
1130  swefcs = reshape(dummy, (/lensfc/))
1131  ENDIF
1132 
1133  IF (PRESENT(tg3fcs)) THEN
1134  error=nf90_inq_varid(ncid, "tg3", id_var)
1135  CALL netcdf_err(error, 'READING tg3 ID' )
1136  error=nf90_get_var(ncid, id_var, dummy)
1137  CALL netcdf_err(error, 'READING tg3' )
1138  tg3fcs = reshape(dummy, (/lensfc/))
1139  ENDIF
1140 
1141  IF (PRESENT(zorfcs)) THEN
1142  error=nf90_inq_varid(ncid, "zorl", id_var)
1143  CALL netcdf_err(error, 'READING zorl ID' )
1144  error=nf90_get_var(ncid, id_var, dummy)
1145  CALL netcdf_err(error, 'READING zorl' )
1146  zorfcs = reshape(dummy, (/lensfc/))
1147  ENDIF
1148 
1149  IF (PRESENT(albfcs)) THEN
1150 
1151  error=nf90_inq_varid(ncid, "alvsf", id_var)
1152  CALL netcdf_err(error, 'READING alvsf ID' )
1153  error=nf90_get_var(ncid, id_var, dummy)
1154  CALL netcdf_err(error, 'READING alvsf' )
1155  albfcs(:,1) = reshape(dummy, (/lensfc/))
1156 
1157  error=nf90_inq_varid(ncid, "alvwf", id_var)
1158  CALL netcdf_err(error, 'READING alvwf ID' )
1159  error=nf90_get_var(ncid, id_var, dummy)
1160  CALL netcdf_err(error, 'READING alvwf' )
1161  albfcs(:,2) = reshape(dummy, (/lensfc/))
1162 
1163  error=nf90_inq_varid(ncid, "alnsf", id_var)
1164  CALL netcdf_err(error, 'READING alnsf ID' )
1165  error=nf90_get_var(ncid, id_var, dummy)
1166  CALL netcdf_err(error, 'READING alnsf' )
1167  albfcs(:,3) = reshape(dummy, (/lensfc/))
1168 
1169  error=nf90_inq_varid(ncid, "alnwf", id_var)
1170  CALL netcdf_err(error, 'READING alnwf ID' )
1171  error=nf90_get_var(ncid, id_var, dummy)
1172  CALL netcdf_err(error, 'READING alnwf' )
1173  albfcs(:,4) = reshape(dummy, (/lensfc/))
1174 
1175  ENDIF
1176 
1177  IF (PRESENT(slifcs)) THEN
1178  error=nf90_inq_varid(ncid, "slmsk", id_var)
1179  CALL netcdf_err(error, 'READING slmsk ID' )
1180  error=nf90_get_var(ncid, id_var, dummy)
1181  CALL netcdf_err(error, 'READING slmsk' )
1182  slifcs = reshape(dummy, (/lensfc/))
1183  slmask = slifcs
1184  WHERE (slmask > 1.5) slmask=0.0 ! remove sea ice
1185  ENDIF
1186 
1187  IF (PRESENT(cnpfcs)) THEN
1188  error=nf90_inq_varid(ncid, "canopy", id_var)
1189  CALL netcdf_err(error, 'READING canopy ID' )
1190  error=nf90_get_var(ncid, id_var, dummy)
1191  CALL netcdf_err(error, 'READING canopy' )
1192  cnpfcs = reshape(dummy, (/lensfc/))
1193  ENDIF
1194 
1195  IF (PRESENT(vegfcs)) THEN
1196  error=nf90_inq_varid(ncid, "vfrac", id_var)
1197  CALL netcdf_err(error, 'READING vfrac ID' )
1198  error=nf90_get_var(ncid, id_var, dummy)
1199  CALL netcdf_err(error, 'READING vfrac' )
1200  vegfcs = reshape(dummy, (/lensfc/))
1201  ENDIF
1202 
1203  IF (PRESENT(f10m)) THEN
1204  error=nf90_inq_varid(ncid, "f10m", id_var)
1205  CALL netcdf_err(error, 'READING f10m ID' )
1206  error=nf90_get_var(ncid, id_var, dummy)
1207  CALL netcdf_err(error, 'READING f10m' )
1208  f10m = reshape(dummy, (/lensfc/))
1209  ENDIF
1210 
1211  IF (PRESENT(vetfcs)) THEN
1212  error=nf90_inq_varid(ncid, "vtype", id_var)
1213  CALL netcdf_err(error, 'READING vtype ID' )
1214  error=nf90_get_var(ncid, id_var, dummy)
1215  CALL netcdf_err(error, 'READING vtype' )
1216  vetfcs = reshape(dummy, (/lensfc/))
1217  ENDIF
1218 
1219  IF (PRESENT(sotfcs)) THEN
1220  error=nf90_inq_varid(ncid, "stype", id_var)
1221  CALL netcdf_err(error, 'READING stype ID' )
1222  error=nf90_get_var(ncid, id_var, dummy)
1223  CALL netcdf_err(error, 'READING stype' )
1224  sotfcs = reshape(dummy, (/lensfc/))
1225  ENDIF
1226 
1227  IF (PRESENT(alffcs)) THEN
1228  error=nf90_inq_varid(ncid, "facsf", id_var)
1229  CALL netcdf_err(error, 'READING facsf ID' )
1230  error=nf90_get_var(ncid, id_var, dummy)
1231  CALL netcdf_err(error, 'READING facsf' )
1232  alffcs(:,1) = reshape(dummy, (/lensfc/))
1233 
1234  error=nf90_inq_varid(ncid, "facwf", id_var)
1235  CALL netcdf_err(error, 'READING facwf ID' )
1236  error=nf90_get_var(ncid, id_var, dummy)
1237  CALL netcdf_err(error, 'READING facwf' )
1238  alffcs(:,2) = reshape(dummy, (/lensfc/))
1239  ENDIF
1240 
1241  IF (PRESENT(ustar)) THEN
1242  error=nf90_inq_varid(ncid, "uustar", id_var)
1243  CALL netcdf_err(error, 'READING uustar ID' )
1244  error=nf90_get_var(ncid, id_var, dummy)
1245  CALL netcdf_err(error, 'READING uustar' )
1246  ustar = reshape(dummy, (/lensfc/))
1247  ENDIF
1248 
1249  IF (PRESENT(fmm)) THEN
1250  error=nf90_inq_varid(ncid, "ffmm", id_var)
1251  CALL netcdf_err(error, 'READING ffmm ID' )
1252  error=nf90_get_var(ncid, id_var, dummy)
1253  CALL netcdf_err(error, 'READING ffmm' )
1254  fmm = reshape(dummy, (/lensfc/))
1255  ENDIF
1256 
1257  IF (PRESENT(fhh)) THEN
1258  error=nf90_inq_varid(ncid, "ffhh", id_var)
1259  CALL netcdf_err(error, 'READING ffhh ID' )
1260  error=nf90_get_var(ncid, id_var, dummy)
1261  CALL netcdf_err(error, 'READING ffhh' )
1262  fhh = reshape(dummy, (/lensfc/))
1263  ENDIF
1264 
1265  IF (PRESENT(sihfcs)) THEN
1266  error=nf90_inq_varid(ncid, "hice", id_var)
1267  CALL netcdf_err(error, 'READING hice ID' )
1268  error=nf90_get_var(ncid, id_var, dummy)
1269  CALL netcdf_err(error, 'READING hice' )
1270  sihfcs = reshape(dummy, (/lensfc/))
1271  ENDIF
1272 
1273  IF (PRESENT(sicfcs)) THEN
1274  error=nf90_inq_varid(ncid, "fice", id_var)
1275  CALL netcdf_err(error, 'READING fice ID' )
1276  error=nf90_get_var(ncid, id_var, dummy)
1277  CALL netcdf_err(error, 'READING fice' )
1278  sicfcs = reshape(dummy, (/lensfc/))
1279  ENDIF
1280 
1281  IF (PRESENT(sitfcs)) THEN
1282  error=nf90_inq_varid(ncid, "tisfc", id_var)
1283  CALL netcdf_err(error, 'READING tisfc ID' )
1284  error=nf90_get_var(ncid, id_var, dummy)
1285  CALL netcdf_err(error, 'READING tisfc' )
1286  sitfcs = reshape(dummy, (/lensfc/))
1287  ENDIF
1288 
1289  IF (PRESENT(tprcp)) THEN
1290  error=nf90_inq_varid(ncid, "tprcp", id_var)
1291  CALL netcdf_err(error, 'READING tprcp ID' )
1292  error=nf90_get_var(ncid, id_var, dummy)
1293  CALL netcdf_err(error, 'READING tprcp' )
1294  tprcp = reshape(dummy, (/lensfc/))
1295  ENDIF
1296 
1297  IF (PRESENT(srflag)) THEN
1298  error=nf90_inq_varid(ncid, "srflag", id_var)
1299  CALL netcdf_err(error, 'READING srflag ID' )
1300  error=nf90_get_var(ncid, id_var, dummy)
1301  CALL netcdf_err(error, 'READING srflag' )
1302  srflag = reshape(dummy, (/lensfc/))
1303  ENDIF
1304 
1305  IF (PRESENT(sndfcs)) THEN
1306  error=nf90_inq_varid(ncid, "snwdph", id_var)
1307  CALL netcdf_err(error, 'READING snwdph ID' )
1308  error=nf90_get_var(ncid, id_var, dummy)
1309  CALL netcdf_err(error, 'READING snwdph' )
1310  sndfcs = reshape(dummy, (/lensfc/))
1311  ENDIF
1312 
1313  IF (PRESENT(vmnfcs)) THEN
1314  error=nf90_inq_varid(ncid, "shdmin", id_var)
1315  CALL netcdf_err(error, 'READING shdmin ID' )
1316  error=nf90_get_var(ncid, id_var, dummy)
1317  CALL netcdf_err(error, 'READING shdmin' )
1318  vmnfcs = reshape(dummy, (/lensfc/))
1319  ENDIF
1320 
1321  IF (PRESENT(vmxfcs)) THEN
1322  error=nf90_inq_varid(ncid, "shdmax", id_var)
1323  CALL netcdf_err(error, 'READING shdmax ID' )
1324  error=nf90_get_var(ncid, id_var, dummy)
1325  CALL netcdf_err(error, 'READING shdmax' )
1326  vmxfcs = reshape(dummy, (/lensfc/))
1327  ENDIF
1328 
1329  IF (PRESENT(slpfcs)) THEN
1330  error=nf90_inq_varid(ncid, "slope", id_var)
1331  CALL netcdf_err(error, 'READING slope ID' )
1332  error=nf90_get_var(ncid, id_var, dummy)
1333  CALL netcdf_err(error, 'READING slope' )
1334  slpfcs = reshape(dummy, (/lensfc/))
1335  ENDIF
1336 
1337  IF (PRESENT(absfcs)) THEN
1338  error=nf90_inq_varid(ncid, "snoalb", id_var)
1339  CALL netcdf_err(error, 'READING snoalb ID' )
1340  error=nf90_get_var(ncid, id_var, dummy)
1341  CALL netcdf_err(error, 'READING snoalb' )
1342  absfcs = reshape(dummy, (/lensfc/))
1343  ENDIF
1344 
1345  IF (PRESENT(t2m)) THEN
1346  error=nf90_inq_varid(ncid, "t2m", id_var)
1347  CALL netcdf_err(error, 'READING t2m ID' )
1348  error=nf90_get_var(ncid, id_var, dummy)
1349  CALL netcdf_err(error, 'READING t2m' )
1350  t2m = reshape(dummy, (/lensfc/))
1351  ENDIF
1352 
1353  IF (PRESENT(q2m)) THEN
1354  error=nf90_inq_varid(ncid, "q2m", id_var)
1355  CALL netcdf_err(error, 'READING q2m ID' )
1356  error=nf90_get_var(ncid, id_var, dummy)
1357  CALL netcdf_err(error, 'READING q2m' )
1358  q2m = reshape(dummy, (/lensfc/))
1359  ENDIF
1360 
1361  nsst_read : IF(do_nsst) THEN
1362 
1363  print*
1364  print*,"WILL READ NSST RECORDS."
1365 
1366  error=nf90_inq_varid(ncid, "c_0", id_var)
1367  CALL netcdf_err(error, 'READING c_0 ID' )
1368  error=nf90_get_var(ncid, id_var, dummy)
1369  CALL netcdf_err(error, 'READING c_0' )
1370  nsst%C_0 = reshape(dummy, (/lensfc/))
1371 
1372  error=nf90_inq_varid(ncid, "c_d", id_var)
1373  CALL netcdf_err(error, 'READING c_d ID' )
1374  error=nf90_get_var(ncid, id_var, dummy)
1375  CALL netcdf_err(error, 'READING c_d' )
1376  nsst%C_D = reshape(dummy, (/lensfc/))
1377 
1378  error=nf90_inq_varid(ncid, "d_conv", id_var)
1379  CALL netcdf_err(error, 'READING d_conv ID' )
1380  error=nf90_get_var(ncid, id_var, dummy)
1381  CALL netcdf_err(error, 'READING d_conv' )
1382  nsst%D_CONV = reshape(dummy, (/lensfc/))
1383 
1384  error=nf90_inq_varid(ncid, "dt_cool", id_var)
1385  CALL netcdf_err(error, 'READING dt_cool ID' )
1386  error=nf90_get_var(ncid, id_var, dummy)
1387  CALL netcdf_err(error, 'READING dt_cool' )
1388  nsst%DT_COOL = reshape(dummy, (/lensfc/))
1389 
1390  error=nf90_inq_varid(ncid, "ifd", id_var)
1391  CALL netcdf_err(error, 'READING ifd ID' )
1392  error=nf90_get_var(ncid, id_var, dummy)
1393  CALL netcdf_err(error, 'READING ifd' )
1394  nsst%IFD = reshape(dummy, (/lensfc/))
1395 
1396  error=nf90_inq_varid(ncid, "qrain", id_var)
1397  CALL netcdf_err(error, 'READING qrain ID' )
1398  error=nf90_get_var(ncid, id_var, dummy)
1399  CALL netcdf_err(error, 'READING qrain' )
1400  nsst%QRAIN = reshape(dummy, (/lensfc/))
1401 
1402  error=nf90_inq_varid(ncid, "tref", id_var)
1403  CALL netcdf_err(error, 'READING tref ID' )
1404  error=nf90_get_var(ncid, id_var, dummy)
1405  CALL netcdf_err(error, 'READING tref' )
1406  nsst%TREF = reshape(dummy, (/lensfc/))
1407 
1408  error=nf90_inq_varid(ncid, "w_0", id_var)
1409  CALL netcdf_err(error, 'READING w_0 ID' )
1410  error=nf90_get_var(ncid, id_var, dummy)
1411  CALL netcdf_err(error, 'READING w_0' )
1412  nsst%W_0 = reshape(dummy, (/lensfc/))
1413 
1414  error=nf90_inq_varid(ncid, "w_d", id_var)
1415  CALL netcdf_err(error, 'READING w_d ID' )
1416  error=nf90_get_var(ncid, id_var, dummy)
1417  CALL netcdf_err(error, 'READING w_d' )
1418  nsst%W_D = reshape(dummy, (/lensfc/))
1419 
1420  error=nf90_inq_varid(ncid, "xs", id_var)
1421  CALL netcdf_err(error, 'READING xs ID' )
1422  error=nf90_get_var(ncid, id_var, dummy)
1423  CALL netcdf_err(error, 'READING xs' )
1424  nsst%XS = reshape(dummy, (/lensfc/))
1425 
1426  error=nf90_inq_varid(ncid, "xt", id_var)
1427  CALL netcdf_err(error, 'READING xt ID' )
1428  error=nf90_get_var(ncid, id_var, dummy)
1429  CALL netcdf_err(error, 'READING xt' )
1430  nsst%XT = reshape(dummy, (/lensfc/))
1431 
1432  error=nf90_inq_varid(ncid, "xtts", id_var)
1433  CALL netcdf_err(error, 'READING xtts ID' )
1434  error=nf90_get_var(ncid, id_var, dummy)
1435  CALL netcdf_err(error, 'READING xtts' )
1436  nsst%XTTS = reshape(dummy, (/lensfc/))
1437 
1438  error=nf90_inq_varid(ncid, "xu", id_var)
1439  CALL netcdf_err(error, 'READING xu ID' )
1440  error=nf90_get_var(ncid, id_var, dummy)
1441  CALL netcdf_err(error, 'READING xu' )
1442  nsst%XU = reshape(dummy, (/lensfc/))
1443 
1444  error=nf90_inq_varid(ncid, "xv", id_var)
1445  CALL netcdf_err(error, 'READING xv ID' )
1446  error=nf90_get_var(ncid, id_var, dummy)
1447  CALL netcdf_err(error, 'READING xv' )
1448  nsst%XV = reshape(dummy, (/lensfc/))
1449 
1450  error=nf90_inq_varid(ncid, "xz", id_var)
1451  CALL netcdf_err(error, 'READING xz ID' )
1452  error=nf90_get_var(ncid, id_var, dummy)
1453  CALL netcdf_err(error, 'READING xz' )
1454  nsst%XZ = reshape(dummy, (/lensfc/))
1455 
1456  error=nf90_inq_varid(ncid, "xzts", id_var)
1457  CALL netcdf_err(error, 'READING xzts ID' )
1458  error=nf90_get_var(ncid, id_var, dummy)
1459  CALL netcdf_err(error, 'READING xzts' )
1460  nsst%XZTS = reshape(dummy, (/lensfc/))
1461 
1462  error=nf90_inq_varid(ncid, "z_c", id_var)
1463  CALL netcdf_err(error, 'READING z_c ID' )
1464  error=nf90_get_var(ncid, id_var, dummy)
1465  CALL netcdf_err(error, 'READING z_c' )
1466  nsst%Z_C = reshape(dummy, (/lensfc/))
1467 
1468  error=nf90_inq_varid(ncid, "zm", id_var)
1469  CALL netcdf_err(error, 'READING zm ID' )
1470  error=nf90_get_var(ncid, id_var, dummy)
1471  CALL netcdf_err(error, 'READING zm' )
1472  nsst%ZM = reshape(dummy, (/lensfc/))
1473 
1474  END IF nsst_read
1475 
1476  DEALLOCATE(dummy)
1477 
1478  ALLOCATE(dummy3d(idim,jdim,lsoil))
1479 
1480  IF (PRESENT(smcfcs)) THEN
1481  error=nf90_inq_varid(ncid, "smc", id_var)
1482  CALL netcdf_err(error, 'READING smc ID' )
1483  error=nf90_get_var(ncid, id_var, dummy3d)
1484  CALL netcdf_err(error, 'READING smc' )
1485  smcfcs = reshape(dummy3d, (/lensfc,lsoil/))
1486  ENDIF
1487 
1488  IF (PRESENT(slcfcs)) THEN
1489  error=nf90_inq_varid(ncid, "slc", id_var)
1490  CALL netcdf_err(error, 'READING slc ID' )
1491  error=nf90_get_var(ncid, id_var, dummy3d)
1492  CALL netcdf_err(error, 'READING slc' )
1493  slcfcs = reshape(dummy3d, (/lensfc,lsoil/))
1494  ENDIF
1495 
1496  IF (PRESENT(stcfcs)) THEN
1497  error=nf90_inq_varid(ncid, "stc", id_var)
1498  CALL netcdf_err(error, 'READING stc ID' )
1499  error=nf90_get_var(ncid, id_var, dummy3d)
1500  CALL netcdf_err(error, 'READING stc' )
1501  stcfcs = reshape(dummy3d, (/lensfc,lsoil/))
1502  ENDIF
1503 
1504  DEALLOCATE(dummy3d)
1505 
1506 ! cloud fields not in warm restart files. set to zero?
1507 
1508  IF (PRESENT(cvfcs)) cvfcs = 0.0
1509  IF (PRESENT(cvtfcs)) cvtfcs = 0.0
1510  IF (PRESENT(cvbfcs)) cvbfcs = 0.0
1511 
1512 ! soil layer thicknesses not in warm restart files. hardwire
1513 ! for now.
1514 
1515  IF (PRESENT(zsoil)) THEN
1516  zsoil(1) = -0.1
1517  zsoil(2) = -0.4
1518  zsoil(3) = -1.0
1519  zsoil(4) = -2.0
1520  ENDIF
1521 
1522  error = nf90_close(ncid)
1523 
1524  END SUBROUTINE read_data
1525 
1542 subroutine read_tf_clim_grb(file_sst,sst,rlats_sst,rlons_sst,mlat_sst,mlon_sst,mon)
1543 
1544  use mpi
1545 
1546  implicit none
1547 
1548 ! declare passed variables and arrays
1549  character(*) , intent(in ) :: file_sst
1550  integer , intent(in ) :: mon,mlat_sst,mlon_sst
1551  real, dimension(mlat_sst) , intent( out) :: rlats_sst
1552  real, dimension(mlon_sst) , intent( out) :: rlons_sst
1553  real, dimension(mlon_sst,mlat_sst) , intent( out) :: sst
1554 
1555 ! declare local parameters
1556  integer,parameter:: lu_sst = 21 ! fortran unit number of grib sst file
1557  real, parameter :: deg2rad = 3.141593/180.0
1558 
1559 ! declare local variables and arrays
1560  logical(1), allocatable, dimension(:) :: lb
1561 
1562  integer :: nlat_sst
1563  integer :: nlon_sst
1564  integer :: iret,ni,nj
1565  integer :: mscan,kb1,ierr
1566  integer :: jincdir,i,iincdir,kb2,kb3,kf,kg,k,j,jf
1567  integer, dimension(22):: jgds,kgds
1568  integer, dimension(25):: jpds,kpds
1569 
1570  real :: xsst0
1571  real :: ysst0
1572  real :: dres
1573  real, allocatable, dimension(:) :: f
1574 
1575 !************+******************************************************************************
1576 !
1577 ! open sst analysis file (grib)
1578  write(*,*) ' sstclm : ',file_sst
1579  call baopenr(lu_sst,trim(file_sst),iret)
1580  if (iret /= 0 ) then
1581  write(6,*)'FATAL ERROR in read_tf_clm_grb: error opening sst file.'
1582  CALL mpi_abort(mpi_comm_world, 111, ierr)
1583  endif
1584 
1585 ! define sst variables for read
1586  j=-1
1587  jpds=-1
1588  jgds=-1
1589  jpds(5)=11 ! sst variable
1590  jpds(6)=1 ! surface
1591  jpds(9) = mon
1592  call getgbh(lu_sst,0,j,jpds,jgds,kg,kf,k,kpds,kgds,iret)
1593 
1594  nlat_sst = kgds(3) ! number points on longitude circle (360)
1595  nlon_sst = kgds(2) ! number points on latitude circle (720)
1596 
1597 ! write(*,*) 'nlat_sst, nlon_sst, mon : ',nlat_sst, nlon_sst, mon
1598 ! write(*,*) 'mlat_sst, mlon_sst : ',mlat_sst, mlon_sst
1599 
1600 ! allocate arrays
1601  allocate(lb(nlat_sst*nlon_sst))
1602  allocate(f(nlat_sst*nlon_sst))
1603  jf=nlat_sst*nlon_sst
1604 
1605 ! read in the analysis
1606  call getgb(lu_sst,0,jf,j,jpds,jgds,kf,k,kpds,kgds,lb,f,iret)
1607  if (iret /= 0) then
1608  write(6,*)'FATAL ERROR in read_tf_clm_grb: error reading sst analysis data record.'
1609  deallocate(lb,f)
1610  CALL mpi_abort(mpi_comm_world, 111, ierr)
1611  endif
1612 
1613  if ( (nlat_sst /= mlat_sst) .or. (nlon_sst /= mlon_sst) ) then
1614  write(6,*)'FATAL ERROR in read_rtg_org: inconsistent dimensions. mlat_sst,mlon_sst=',&
1615  mlat_sst,mlon_sst,' -versus- nlat_sst,nlon_sst=',nlat_sst,nlon_sst
1616  deallocate(lb,f)
1617  CALL mpi_abort(mpi_comm_world, 111, ierr)
1618  endif
1619 
1620 !
1621 ! get xlats and xlons
1622 !
1623  dres = 180.0/real(nlat_sst)
1624  ysst0 = 0.5*dres-90.0
1625  xsst0 = 0.5*dres
1626 
1627 ! get lat_sst & lon_sst
1628  do j = 1, nlat_sst
1629  rlats_sst(j) = ysst0 + real(j-1)*dres
1630  enddo
1631 
1632  do i = 1, nlon_sst
1633  rlons_sst(i) = (xsst0 + real(i-1)*dres)
1634  enddo
1635 
1636 ! load dimensions and grid specs. check for unusual values
1637  ni=kgds(2) ! 720 for 0.5 x 0.5
1638  nj=kgds(3) ! 360 for 0.5 x 0.5 resolution
1639 
1640  mscan=kgds(11)
1641  kb1=ibits(mscan,7,1) ! i scan direction
1642  kb2=ibits(mscan,6,1) ! j scan direction
1643  kb3=ibits(mscan,5,1) ! (i,j) or (j,i)
1644 
1645 ! get i and j scanning directions from kb1 and kb2.
1646 ! 0 yields +1, 1 yields -1. +1 is west to east, -1 is east to west.
1647  iincdir = 1-kb1*2
1648 
1649 ! 0 yields -1, 1 yields +1. +1 is south to north, -1 is north to south.
1650  jincdir = kb2*2 - 1
1651 
1652 ! write(*,*) 'read_tf_clim_grb,iincdir,jincdir : ',iincdir,jincdir
1653  do k=1,kf
1654 
1655 ! kb3 from scan mode indicates if i points are consecutive
1656 ! or if j points are consecutive
1657  if(kb3==0)then ! (i,j)
1658  i=(ni+1)*kb1+(mod(k-1,ni)+1)*iincdir
1659  j=(nj+1)*(1-kb2)+jincdir*((k-1)/ni+1)
1660  else ! (j,i)
1661  j=(nj+1)*(1-kb2)+(mod(k-1,nj)+1)*jincdir
1662  i=(ni+1)*kb1+iincdir*((k-1)/nj+1)
1663  endif
1664  sst(i,j) = f(k)
1665  end do
1666 
1667  deallocate(lb,f)
1668 
1669  call baclose(lu_sst,iret)
1670  if (iret /= 0 ) then
1671  write(6,*)'FATAL ERROR in read_tf_clm_grb: error closing sst file.'
1672  CALL mpi_abort(mpi_comm_world, 121, ierr)
1673  endif
1674 
1675 end subroutine read_tf_clim_grb
1676 
1684 subroutine get_tf_clm_dim(file_sst,mlat_sst,mlon_sst)
1685  use mpi
1686 
1687  implicit none
1688 
1689 ! declare passed variables and arrays
1690  character(*) , intent(in ) :: file_sst
1691  integer , intent(out) :: mlat_sst,mlon_sst
1692 
1693 ! declare local parameters
1694  integer,parameter:: lu_sst = 21 ! fortran unit number of grib sst file
1695 
1696  integer :: iret
1697  integer :: mscan,kb1
1698  integer :: kf,kg,k,j,ierr
1699  integer, dimension(22):: jgds,kgds
1700  integer, dimension(25):: jpds,kpds
1701 
1702 !************+******************************************************************************
1703 !
1704 ! open sst analysis file (grib)
1705  call baopenr(lu_sst,trim(file_sst),iret)
1706  if (iret /= 0 ) then
1707  write(6,*)'FATAL ERROR in get_tf_clm_dim: error opening sst file.'
1708  CALL mpi_abort(mpi_comm_world, 111, ierr)
1709  endif
1710 
1711 ! define sst variables for read
1712  j=-1
1713  jpds=-1
1714  jgds=-1
1715  jpds(5)=11 ! sst variable
1716  jpds(6)=1 ! surface
1717  jpds(9) = 1
1718  call getgbh(lu_sst,0,j,jpds,jgds,kg,kf,k,kpds,kgds,iret)
1719 
1720  mlat_sst = kgds(3) ! number points on longitude circle (360)
1721  mlon_sst = kgds(2) ! number points on latitude circle (720)
1722 
1723  write(*,*) 'mlat_sst, mlon_sst : ',mlat_sst, mlon_sst
1724 
1725  call baclose(lu_sst,iret)
1726  if (iret /= 0 ) then
1727  write(6,*)'FATAL ERROR in get_tf_clm_dim: error closing sst file.'
1728  CALL mpi_abort(mpi_comm_world, 121, ierr)
1729  endif
1730 end subroutine get_tf_clm_dim
1731 
1743 subroutine read_salclm_gfs_nc(filename,sal,xlats,xlons,nlat,nlon,itime)
1744  use netcdf
1745  implicit none
1746 
1747  ! This is the name of the data file we will read.
1748  character (len=*), intent(in) :: filename
1749  integer, intent(in) :: nlat,nlon
1750  integer, intent(in) :: itime
1751  real, dimension(nlat), intent(out) :: xlats
1752  real, dimension(nlon), intent(out) :: xlons
1753  real, dimension(nlon,nlat), intent(out) :: sal
1754 ! Local variables
1755  integer :: ncid,ntime
1756 
1757  integer, parameter :: ndims = 3
1758  character (len = *), parameter :: lat_name = "latitude"
1759  character (len = *), parameter :: lon_name = "longitude"
1760  character (len = *), parameter :: t_name = "time"
1761  character (len = *), parameter :: sal_name="sal"
1762  integer :: no_fill,fill_value
1763  integer :: time_varid,lon_varid, lat_varid, z_varid, sal_varid
1764 
1765  ! The start and count arrays will tell the netCDF library where to read our data.
1766  integer, dimension(ndims) :: start, count
1767 
1768  character (len = *), parameter :: units = "units"
1769  character (len = *), parameter :: sal_units = "psu"
1770  ! PSU (Practical SalinitUnit). 1 PSU = 1g/kg
1771  character (len = *), parameter :: time_units = "months"
1772  character (len = *), parameter :: lat_units = "degrees_north"
1773  character (len = *), parameter :: lon_units = "degrees_east"
1774 
1775  integer :: missv
1776 ! Loop indices
1777  integer :: i,j
1778 
1779 ! Open the file.
1780  call nc_check( nf90_open(filename, nf90_nowrite, ncid) )
1781 
1782 ! Get the varids of time, latitude, longitude & depth coordinate variables.
1783  call nc_check( nf90_inq_varid(ncid, t_name, time_varid) )
1784  call nc_check( nf90_inq_varid(ncid, lat_name, lat_varid) )
1785  call nc_check( nf90_inq_varid(ncid, lon_name, lon_varid) )
1786 
1787 ! Read the time, latitude and longitude data.
1788 ! call nc_check( nf90_get_var(ncid, time_varid, ntime) )
1789  call nc_check( nf90_get_var(ncid, lat_varid, xlats) )
1790  call nc_check( nf90_get_var(ncid, lon_varid, xlons) )
1791 
1792 ! Get the varids of the sal netCDF variables.
1793  call nc_check( nf90_inq_varid(ncid, sal_name,sal_varid) )
1794 
1795 ! Read 1 record of nlat*nlon values, starting at the beginning
1796 ! of the record (the (1, 1, 1, rec) element in the netCDF file).
1797  start = (/ 1, 1, itime /)
1798  count = (/ nlon, nlat, 1 /)
1799 
1800 ! write(*,*) 'read_salclm_gfs_nc itime : ',itime
1801 ! Read the sal data from the file, one record at a time.
1802  call nc_check( nf90_get_var(ncid, sal_varid, sal, start, count) )
1803 
1804 ! Close the file. This frees up any internal netCDF resources
1805 ! associated with the file.
1806  call nc_check( nf90_close(ncid) )
1807 
1808 ! If we got this far, everything worked as expected. Yipee!
1809 ! print *,"*** SUCCESS reading file ", filename, "!"
1810 
1811 end subroutine read_salclm_gfs_nc
1812 
1819 subroutine get_dim_nc(filename,nlat,nlon)
1820  use netcdf
1821  implicit none
1822 
1823  character (len=*), intent(in) :: filename
1824  integer, intent(out) :: nlat,nlon
1825 ! Local variables
1826  character (len = *), parameter :: lat_name = "latitude"
1827  character (len = *), parameter :: lon_name = "longitude"
1828  integer :: ncid
1829  integer :: latdimid,londimid
1830 
1831 ! Open the file.
1832  call nc_check( nf90_open(filename, nf90_nowrite, ncid) )
1833 
1834 ! Get dimensions
1835  call nc_check( nf90_inq_dimid(ncid,lat_name,latdimid) )
1836  call nc_check( nf90_inq_dimid(ncid,lon_name,londimid) )
1837  call nc_check( nf90_inquire_dimension(ncid,latdimid,len=nlat) )
1838  call nc_check( nf90_inquire_dimension(ncid,londimid,len=nlon) )
1839 
1840 ! write(*,'(a,1x,a6,2I8)') 'get_dim_nc, file, nlat, nlon : ',filename,nlat,nlon
1841 
1842 ! Close the file. This frees up any internal netCDF resources
1843 ! associated with the file.
1844  call nc_check( nf90_close(ncid) )
1845 
1846 ! If we got this far, everything worked as expected. Yipee!
1847 ! print *,"*** SUCCESS get dimensions from nc file ", filename, "!"
1848 
1849 end subroutine get_dim_nc
1850 
1856 subroutine nc_check(status)
1857 
1858  use mpi
1859  use netcdf
1860 
1861  integer, intent ( in) :: status
1862  integer :: ierr
1863 
1864  if(status /= nf90_noerr) then
1865  print *, 'FATAL ERROR:'
1866  print *, trim(nf90_strerror(status))
1867  CALL mpi_abort(mpi_comm_world, 122, ierr)
1868  end if
1869 end subroutine nc_check
1870 
1871  END MODULE read_write_data