UPP  11.0.0
 All Data Structures Files Functions Variables Pages
INITPOST_NETCDF.f
Go to the documentation of this file.
1 
5 
35 ! and 2D diag. output (d2d_chem) for GEFS-Aerosols and CCPP-Chem model.
40  SUBROUTINE initpost_netcdf(ncid2d,ncid3d)
41 
42 
43  use netcdf
44  use vrbls4d, only: dust, salt, suso, soot, waso, smoke, fv3dust, coarsepm, &
45  no3,nh4, pp25, pp10
46  use vrbls3d, only: t, q, uh, vh, pmid, pint, alpint, dpres, zint, zmid, o3, &
47  qqr, qqs, cwm, qqi, qqw, omga, rhomid, q2, cfr, rlwtt, rswtt, tcucn, &
48  tcucns, train, el_pbl, exch_h, vdifftt, vdiffmois, dconvmois, nradtt, &
49  o3vdiff, o3prod, o3tndy, mwpv, unknown, vdiffzacce, zgdrag,cnvctummixing, &
50  vdiffmacce, mgdrag, cnvctvmmixing, ncnvctcfrac, cnvctumflx, cnvctdmflx, &
51  cnvctzgdrag, sconvmois, cnvctmgdrag, cnvctdetmflx, duwt, duem, dusd, dudp, &
52  dusv,ssem,sssd,ssdp,sswt,sssv,bcem,bcsd,bcdp,bcwt,bcsv,ocem,ocsd,ocdp,ocwt,ocsv, &
53  wh, qqg, ref_10cm, qqnifa, qqnwfa, avgpmtf, avgozcon, aextc55, taod5503d, &
54  effri, effrl, effrs
55 
56  use vrbls2d, only: f, pd, fis, pblh, ustar, z0, ths, qs, twbs, qwbs, avgcprate, &
57  cprate, avgprec, prec, lspa, sno, sndepac, si, cldefi, th10, q10, tshltr, pshltr, &
58  tshltr, albase, avgalbedo, avgtcdc, czen, czmean, mxsnal, landfrac, radot, sigt4, &
59  cfrach, cfracl, cfracm, avgcfrach, qshltr, avgcfracl, avgcfracm, cnvcfr, &
60  islope, cmc, grnflx, vegfrc, acfrcv, ncfrcv, acfrst, ncfrst, ssroff, &
61  bgroff, rlwin, rlwtoa, cldwork, alwin, alwout, alwtoa, rswin, rswinc, &
62  rswout, aswin, auvbin, auvbinc, aswout, aswtoa, sfcshx, sfclhx, subshx, &
63  snopcx, sfcux, sfcvx, sfcuxi, sfcvxi, sfcuvx, gtaux, gtauy, potevp, u10, v10, smstav,&
64  smstot, ivgtyp, isltyp, sfcevp, sfcexc, acsnow, acsnom, sst, thz0, qz0, &
65  uz0, vz0, ptop, htop, pbot, hbot, ptopl, pbotl, ttopl, ptopm, pbotm, ttopm, &
66  ptoph, pboth, pblcfr, ttoph, runoff, tecan, tetran, tedir, twa, maxtshltr, &
67  mintshltr, maxrhshltr, fdnsst, acgraup, graup_bucket, acfrain, frzrn_bucket, &
68  snow_acm, snow_bkt, snownc, graupelnc, qrmax, &
69  minrhshltr, dzice, smcwlt, suntime, fieldcapa, htopd, hbotd, htops, hbots, &
70  cuppt, dusmass, ducmass, dusmass25, ducmass25, aswintoa,rel_vort_maxhy1, &
71  maxqshltr, minqshltr, acond, sr, u10h, v10h,refd_max, w_up_max, w_dn_max, &
72  up_heli_max,up_heli_min,up_heli_max03,up_heli_min03,rel_vort_max01,u10max, v10max, &
73  avgedir,avgecan,paha,pahi,avgetrans,avgesnow,avgprec_cont,avgcprate_cont,rel_vort_max, &
74  avisbeamswin,avisdiffswin,airbeamswin,airdiffswin,refdm10c_max,wspd10max, &
75  alwoutc,alwtoac,aswoutc,aswtoac,alwinc,aswinc,avgpotevp,snoavg, &
76  ti,aod550,du_aod550,ss_aod550,su_aod550,oc_aod550,bc_aod550,prate_max,maod,dustpm10, &
77  dustcb,bccb,occb,sulfcb,sscb,dustallcb,ssallcb,dustpm,sspm,pp25cb,pp10cb,no3cb,nh4cb,&
78  pwat, ebb, hwp, aqm_aod550, ltg1_max,ltg2_max,ltg3_max
79  use soil, only: sldpth, sllevel, sh2o, smc, stc
80  use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice
81  use physcons_post, only: grav => con_g, fv => con_fvirt, rgas => con_rd, &
82  eps => con_eps, epsm1 => con_epsm1
83  use params_mod, only: erad, dtr, tfrz, h1, d608, rd, p1000, capa,pi
84  use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, qs0, sqs, sthe, &
85  ttblq, rdpq, rdtheq, stheq, the0q, the0
86  use ctlblk_mod, only: me, mpi_comm_comp, icnt, idsp, jsta, jend, ihrst, idat, sdat, ifhr, &
87  ifmin, filename, tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, td3d, restrt, sdat, &
88  jend_m, imin, imp_physics, dt, spval, pdtop, pt, qmin, nbin_du, nphs, dtq2, ardlw,&
89  ardsw, asrfc, avrain, avcnvc, theat, gdsdegr, spl, lsm, alsl, im, jm, im_jm, lm, &
90  jsta_2l, jend_2u, nsoil, lp1, icu_physics, ivegsrc, novegtype, nbin_ss, nbin_bc, &
91  nbin_oc, nbin_su, nbin_no3, nbin_nh4, gocart_on,gccpp_on, nasa_on,pt_tbl,hyb_sigp,&
92  filenameflux, filenameaer, &
93  isf_surface_physics,rdaod, d2d_chem, modelname, aqf_on, &
94  ista, iend, ista_2l, iend_2u,iend_m
95  use gridspec_mod, only: maptype, gridtype, latstart, latlast, lonstart, lonlast, cenlon, &
96  dxval, dyval, truelat2, truelat1, psmapf, cenlat,lonstartv, lonlastv, cenlonv, &
97  latstartv, latlastv,cenlatv,latstart_r,latlast_r,lonstart_r,lonlast_r, standlon, &
98  latse,lonse,latnw,lonnw
99  use upp_physics, only: fpvsnew
100 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
101  implicit none
102 !
103 ! type(nemsio_gfile) :: nfile,ffile,rfile
104  integer,parameter :: nvar2d=48
105 ! character(nemsio_charkind) :: name2d(nvar2d)
106  integer :: nvar3d, numdims
107 ! character(nemsio_charkind), allocatable :: name3din(:), name3dout(:)
108 ! character(nemsio_charkind) :: varname,levtype
109 !
110 ! INCLUDE/SET PARAMETERS.
111 !
112  include "mpif.h"
113 
114 ! integer,parameter:: MAXPTS=1000000 ! max im*jm points
115 !
116 ! real,parameter:: con_g =9.80665e+0! gravity
117 ! real,parameter:: con_rv =4.6150e+2 ! gas constant H2O
118 ! real,parameter:: con_rd =2.8705e+2 ! gas constant air
119 ! real,parameter:: con_fvirt =con_rv/con_rd-1.
120 ! real,parameter:: con_eps =con_rd/con_rv
121 ! real,parameter:: con_epsm1 =con_rd/con_rv-1
122 !
123 ! This version of INITPOST shows how to initialize, open, read from, and
124 ! close a NetCDF dataset. In order to change it to read an internal (binary)
125 ! dataset, do a global replacement of _ncd_ with _int_.
126 
127  real, parameter :: gravi = 1.0/grav
128  character(len=20) :: varname, vcoordname
129  integer :: status, fldsize, fldst, recn, recn_vvel
130  character startdate*19,sysdepinfo*80,cgar*1
131  character startdate2(19)*4, flatlon*40
132  logical :: read_lonlat=.true.
133 !
134 ! NOTE: SOME INTEGER VARIABLES ARE READ INTO DUMMY ( A REAL ). THIS IS OK
135 ! AS LONG AS REALS AND INTEGERS ARE THE SAME SIZE.
136 !
137 ! ALSO, EXTRACT IS CALLED WITH DUMMY ( A REAL ) EVEN WHEN THE NUMBERS ARE
138 ! INTEGERS - THIS IS OK AS LONG AS INTEGERS AND REALS ARE THE SAME SIZE.
139  LOGICAL runb,singlrst,subpost,nest,hydro,ioomg,ioall
140  logical, parameter :: debugprint = .false., zerout = .false.
141 ! logical, parameter :: debugprint = .true., zerout = .false.
142  logical :: convert_rad_to_deg=.false.
143  CHARACTER*32 varcharval
144 ! CHARACTER*40 CONTRL,FILALL,FILMST,FILTMP,FILTKE,FILUNV,FILCLD,FILRAD,FILSFC
145  CHARACTER*4 resthr
146  CHARACTER fname*255,envar*50
147  INTEGER idate(8),jdate(8),jpds(200),jgds(200),kpds(200),kgds(200)
148 ! LOGICAL*1 LB(IM,JM)
149 !
150 ! INCLUDE COMMON BLOCKS.
151 !
152 ! DECLARE VARIABLES.
153 !
154 ! REAL fhour
155  integer nfhour ! forecast hour from nems io file
156  integer fhzero !bucket
157  real dtp !physics time step
158  real dz
159  REAL rinc(5)
160 
161  REAL dummy(im,jm)
162 !jw
163  integer ii,jj,js,je,iyear,imn,iday,itmp,ioutcount,istatus, &
164  i,j,l,ll,k,kf,irtn,igdout,n,index,nframe, &
165  nframed2,iunitd3d,ierr,idum,iret,nrec,idrt
166  integer ncid3d,ncid2d,varid,nhcas,varid_bl,iret_bl
167  real tstart,tlmh,tsph,es,fact,soilayert,soilayerb,zhour,dum, &
168  tvll,pmll,tv, tx1, tx2
169 
170  character*20,allocatable :: recname(:)
171  integer, allocatable :: reclev(:), kmsk(:,:)
172  real, allocatable :: glat1d(:), glon1d(:), qstl(:)
173  real, allocatable :: wrk1(:,:), wrk2(:,:)
174  real, allocatable :: p2d(:,:), t2d(:,:), q2d(:,:), &
175  qs2d(:,:), cw2d(:,:), cfr2d(:,:)
176  real, dimension(lm+1) :: ak5, bk5
177  real*8, allocatable :: pm2d(:,:), pi2d(:,:)
178  real, allocatable :: tmp(:)
179  real :: buf(ista_2l:iend_2u,jsta_2l:jend_2u)
180  real :: buf2(ista_2l:iend_2u,jsta_2l:jend_2u)
181  real :: buf3d(ista_2l:iend_2u,jsta_2l:jend_2u,lm)
182  real :: chem_2d(ista_2l:iend_2u,jsta_2l:jend_2u)
183  real :: chemt(ista_2l:iend_2u,jsta_2l:jend_2u,lm)
184  real :: dt1(ista_2l:iend_2u,jsta_2l:jend_2u,lm)
185  real :: dt2(ista_2l:iend_2u,jsta_2l:jend_2u,lm)
186  real :: dt3(ista_2l:iend_2u,jsta_2l:jend_2u,lm)
187  real :: dt4(ista_2l:iend_2u,jsta_2l:jend_2u,lm)
188  real :: dt5(ista_2l:iend_2u,jsta_2l:jend_2u,lm)
189 
190 ! real buf(ista_2l:iend_2u,jsta_2l:jend_2u),bufsoil(im,nsoil,jsta_2l:jend_2u) &
191 ! ,buf3d(ista_2l:iend_2u,jsta_2l:jend_2u,lm),buf3d2(im,lp1,jsta_2l:jend_2u)
192 
193  real lat
194  integer isa, jsa, latghf, jtem, idvc, idsl, nvcoord, ip1, nn, npass
195 
196  integer, parameter :: npass2=5, npass3=30
197  real, parameter :: third=1.0/3.0
198  INTEGER, DIMENSION(2) :: ij4min, ij4max
199  REAL :: omgmin, omgmax
200  real, allocatable :: d2d(:,:), u2d(:,:), v2d(:,:), omga2d(:,:)
201  REAL, ALLOCATABLE :: ps2d(:,:),psx2d(:,:),psy2d(:,:)
202  real, allocatable :: div3d(:,:,:)
203  real(kind=4),allocatable :: vcrd(:,:)
204  real :: dum_const
205  real, allocatable :: ext550(:,:,:)
206 
207  if (modelname == 'FV3R') then
208  allocate(ext550(ista_2l:iend_2u,jsta_2l:jend_2u,lm))
209  endif
210 
211 !***********************************************************************
212 ! START INIT HERE.
213 !
214  WRITE(6,*)'INITPOST: ENTER INITPOST_NETCDF'
215  WRITE(6,*)'me=',me, &
216  'jsta_2l=',jsta_2l,'jend_2u=', &
217  jend_2u,'im=',im, &
218  'ista_2l=',ista_2l,'iend_2u=',iend_2u, &
219  'ista=',ista,'iend=',iend, &
220  'iend_m=',iend_m
221 !
222  isa = (ista+iend) / 2
223  jsa = (jsta+jend) / 2
224 
225 !$omp parallel do private(i,j)
226  do j = jsta_2l, jend_2u
227  do i= ista_2l, iend_2u
228  buf(i,j) = spval
229  enddo
230  enddo
231 
232  status=nf90_get_att(ncid3d,nf90_global,'ak',ak5)
233  if(status/=0)then
234  print*,'ak not found; assigning missing value'
235  ak5=spval
236  else
237  if(me==0)print*,'ak5= ',ak5
238  end if
239  status=nf90_get_att(ncid3d,nf90_global,'idrt',idrt)
240  if(status/=0)then
241  print*,'idrt not in netcdf file,reading grid'
242  status=nf90_get_att(ncid3d,nf90_global,'grid',varcharval)
243  if(status/=0)then
244  print*,'idrt and grid not in netcdf file, set default to latlon'
245  idrt=0
246  maptype=0
247  else
248  if(trim(varcharval)=='rotated_latlon')then
249  maptype=207
250  idrt=207
251  status=nf90_get_att(ncid3d,nf90_global,'cen_lon',dum_const)
252  if(status/=0)then
253  print*,'cen_lon not found; assigning missing value'
254  cenlon=spval
255  else
256  if(dum_const<0.)then
257  cenlon=nint((dum_const+360.)*gdsdegr)
258  else
259  cenlon=dum_const*gdsdegr
260  end if
261  end if
262  status=nf90_get_att(ncid3d,nf90_global,'cen_lat',dum_const)
263  if(status/=0)then
264  print*,'cen_lat not found; assigning missing value'
265  cenlat=spval
266  else
267  cenlat=dum_const*gdsdegr
268  end if
269 
270  status=nf90_get_att(ncid3d,nf90_global,'lon1',dum_const)
271  if(status/=0)then
272  print*,'lonstart_r not found; assigning missing value'
273  lonstart_r=spval
274  else
275  if(dum_const<0.)then
276  lonstart_r=nint((dum_const+360.)*gdsdegr)
277  else
278  lonstart_r=dum_const*gdsdegr
279  end if
280  end if
281  status=nf90_get_att(ncid3d,nf90_global,'lat1',dum_const)
282  if(status/=0)then
283  print*,'latstart_r not found; assigning missing value'
284  latstart_r=spval
285  else
286  latstart_r=dum_const*gdsdegr
287  end if
288 
289  status=nf90_get_att(ncid3d,nf90_global,'lon2',dum_const)
290  if(status/=0)then
291  print*,'lonlast_r not found; assigning missing value'
292  lonlast_r=spval
293  else
294  if(dum_const<0.)then
295  lonlast_r=nint((dum_const+360.)*gdsdegr)
296  else
297  lonlast_r=dum_const*gdsdegr
298  end if
299  end if
300  status=nf90_get_att(ncid3d,nf90_global,'lat2',dum_const)
301  if(status/=0)then
302  print*,'latlast_r not found; assigning missing value'
303  latlast_r=spval
304  else
305  latlast_r=dum_const*gdsdegr
306  end if
307 
308  status=nf90_get_att(ncid3d,nf90_global,'dlon',dum_const)
309  if(status/=0)then
310  print*,'dlmd not found; assigning missing value'
311  dxval=spval
312  else
313  dxval=dum_const*gdsdegr
314  end if
315  status=nf90_get_att(ncid3d,nf90_global,'dlat',dum_const)
316  if(status/=0)then
317  print*,'dphd not found; assigning missing value'
318  dyval=spval
319  else
320  dyval=dum_const*gdsdegr
321  end if
322 
323 ! print*,'lonstart,latstart,cenlon,cenlat,dyval,dxval', &
324 ! lonstart,latstart,cenlon,cenlat,dyval,dxval
325 
326 ! Jili Dong add support for regular lat lon (2019/03/22) start
327  else if(trim(varcharval)=='latlon')then
328  maptype=0
329  idrt=0
330 
331  status=nf90_get_att(ncid3d,nf90_global,'lon1',dum_const)
332  if(status/=0)then
333  print*,'lonstart not found; assigning missing value'
334  lonstart=spval
335  else
336  if(dum_const<0.)then
337  lonstart=nint((dum_const+360.)*gdsdegr)
338  else
339  lonstart=dum_const*gdsdegr
340  end if
341  end if
342  status=nf90_get_att(ncid3d,nf90_global,'lat1',dum_const)
343  if(status/=0)then
344  print*,'latstart not found; assigning missing value'
345  latstart=spval
346  else
347  latstart=dum_const*gdsdegr
348  end if
349 
350  status=nf90_get_att(ncid3d,nf90_global,'lon2',dum_const)
351  if(status/=0)then
352  print*,'lonlast not found; assigning missing value'
353  lonlast=spval
354  else
355  if(dum_const<0.)then
356  lonlast=nint((dum_const+360.)*gdsdegr)
357  else
358  lonlast=dum_const*gdsdegr
359  end if
360  end if
361  status=nf90_get_att(ncid3d,nf90_global,'lat2',dum_const)
362  if(status/=0)then
363  print*,'latlast not found; assigning missing value'
364  latlast=spval
365  else
366  latlast=dum_const*gdsdegr
367  end if
368 
369  status=nf90_get_att(ncid3d,nf90_global,'dlon',dum_const)
370  if(status/=0)then
371  print*,'dlmd not found; assigning missing value'
372  dxval=spval
373  else
374  dxval=dum_const*gdsdegr
375  end if
376  status=nf90_get_att(ncid3d,nf90_global,'dlat',dum_const)
377  if(status/=0)then
378  print*,'dphd not found; assigning missing value'
379  dyval=spval
380  else
381  dyval=dum_const*gdsdegr
382  end if
383 
384  print*,'lonstart,latstart,dyval,dxval', &
385  lonstart,lonlast,latstart,latlast,dyval,dxval
386 
387 ! Jili Dong add support for regular lat lon (2019/03/22) end
388 
389  ELSE IF (trim(varcharval)=='lambert_conformal')then
390 
391  maptype=1
392  idrt=1
393  status=nf90_get_att(ncid3d,nf90_global,'cen_lon',dum_const)
394  if(status/=0)then
395  print*,'cen_lon not found; assigning missing value'
396  cenlon=spval
397  else
398  if(dum_const<0.)then
399  cenlon=nint((dum_const+360.)*gdsdegr)
400  else
401  cenlon=dum_const*gdsdegr
402  end if
403  end if
404  status=nf90_get_att(ncid3d,nf90_global,'cen_lat',dum_const)
405  if(status/=0)then
406  print*,'cen_lat not found; assigning missing value'
407  cenlat=spval
408  else
409  cenlat=dum_const*gdsdegr
410  end if
411 
412  status=nf90_get_att(ncid3d,nf90_global,'lon1',dum_const)
413  if(status/=0)then
414  print*,'lonstart not found; assigning missing value'
415  lonstart=spval
416  else
417  if(dum_const<0.)then
418  lonstart=nint((dum_const+360.)*gdsdegr)
419  else
420  lonstart=dum_const*gdsdegr
421  end if
422  end if
423  status=nf90_get_att(ncid3d,nf90_global,'lat1',dum_const)
424  if(status/=0)then
425  print*,'latstart not found; assigning missing value'
426  latstart=spval
427  else
428  latstart=dum_const*gdsdegr
429  end if
430 
431  status=nf90_get_att(ncid3d,nf90_global,'stdlat1',dum_const)
432  if(status/=0)then
433  print*,'stdlat1 not found; assigning missing value'
434  truelat1=spval
435  else
436  truelat1=dum_const*gdsdegr
437  end if
438  status=nf90_get_att(ncid3d,nf90_global,'stdlat2',dum_const)
439  if(status/=0)then
440  print*,'stdlat2 not found; assigning missing value'
441  truelat2=spval
442  else
443  truelat2=dum_const*gdsdegr
444  end if
445 
446  status=nf90_get_att(ncid3d,nf90_global,'dx',dum_const)
447  if(status/=0)then
448  print*,'dx not found; assigning missing value'
449  dxval=spval
450  else
451  dxval=dum_const*1.e3
452  end if
453  status=nf90_get_att(ncid3d,nf90_global,'dy',dum_const)
454  if(status/=0)then
455  print*,'dphd not found; assigning missing value'
456  dyval=spval
457  else
458  dyval=dum_const*1.e3
459  end if
460 
461  standlon = cenlon
462  print*,'lonstart,latstart,cenlon,cenlat,truelat1,truelat2, &
463  stadlon,dyval,dxval', &
464  lonstart,latstart,cenlon,cenlat,truelat1,truelat2,standlon,dyval,dxval
465 
466  else if(trim(varcharval)=='gaussian')then
467  maptype=4
468  idrt=4
469  else ! setting default maptype
470  maptype=0
471  idrt=0
472  end if
473  end if
474  end if
475  if(me==0)print*,'idrt MAPTYPE= ',idrt,maptype
476 ! STEP 1. READ MODEL OUTPUT FILE
477 !
478 !
479 !***
480 !
481 ! LMH and LMV always = LM for sigma-type vert coord
482 
483 !$omp parallel do private(i,j)
484  do j = jsta_2l, jend_2u
485  do i = ista_2l, iend_2u
486  lmv(i,j) = lm
487  lmh(i,j) = lm
488  end do
489  end do
490 
491 ! HTM VTM all 1 for sigma-type vert coord
492 
493 !$omp parallel do private(i,j,l)
494  do l = 1, lm
495  do j = jsta_2l, jend_2u
496  do i = ista_2l, iend_2u
497  htm(i,j,l) = 1.0
498  vtm(i,j,l) = 1.0
499  end do
500  end do
501  end do
502 
503  status=nf90_get_att(ncid3d,nf90_global,'nhcas',nhcas)
504  if(status/=0)then
505  print*,'nhcas not in netcdf file, set default to nonhydro'
506  nhcas=0
507  end if
508  if(me==0)print*,'nhcas= ',nhcas
509  if (nhcas == 0 ) then !non-hydrostatic case
510  nrec=18
511  allocate (recname(nrec))
512  recname=[character(len=20) :: 'ugrd','vgrd','spfh','tmp','o3mr', &
513  'presnh','dzdt', 'clwmr','dpres', &
514  'delz','icmr','rwmr', &
515  'snmr','grle','smoke','dust', &
516  'coarsepm','ext550']
517  else
518  nrec=8
519  allocate (recname(nrec))
520  recname=[character(len=20) :: 'ugrd','vgrd','tmp','spfh','o3mr', &
521  'hypres', 'clwmr','dpres']
522  endif
523 
524 ! write(*,*)'nrec=',nrec
525  !allocate(recname(nrec),reclevtyp(nrec),reclev(nrec))
526  allocate(glat1d(jm),glon1d(im))
527 
528 ! hardwire idate for now
529 ! idate=(/2017,08,07,00,0,0,0,0/)
530 ! get cycle start time
531  status=nf90_inq_varid(ncid3d,'time',varid)
532  if(status/=0)then
533  print*,'time not in netcdf file, stopping'
534  stop 1
535  else
536  status=nf90_get_att(ncid3d,varid,'units',varcharval)
537  if(status/=0)then
538  print*,'time unit not available'
539  else
540  print*,'time unit read from netcdf file= ',varcharval
541 ! assume use hours as unit
542 ! idate_loc=index(varcharval,'since')+6
543  read(varcharval,101)idate(1),idate(2),idate(3),idate(4),idate(5)
544  end if
545 ! Status=nf90_inquire_dimension(ncid3d,varid,len=ntimes)
546 ! allocate(fhours(ntimes))
547 ! status = nf90_inq_varid(ncid3d,varid,fhours)
548 ! Status=nf90_get_var(ncid3d,varid,nfhour,start=(/1/), &
549 ! count=(/1/))
550 ! if(Status/=0)then
551 ! print*,'forecast hour not in netcdf file, stopping'
552 ! STOP 1
553 ! end if
554  end if
555  101 format(t13,i4,1x,i2,1x,i2,1x,i2,1x,i2)
556  print*,'idate= ',idate(1:5)
557 
558 ! Jili Dong check output format for coordinate reading
559  status=nf90_inq_varid(ncid3d,'grid_xt',varid)
560  status=nf90_inquire_variable(ncid3d,varid,ndims = numdims)
561  if(numdims==1.and.modelname=="FV3R") then
562  read_lonlat=.true.
563  else
564  read_lonlat=.false.
565  end if
566 
567 
568 ! Jili Dong add support for new write component output
569 ! get longitude
570  if (read_lonlat) then
571  status=nf90_inq_varid(ncid3d,'lon',varid)
572  status=nf90_inquire_variable(ncid3d,varid,ndims = numdims)
573  if(debugprint)print*,'number of dim for gdlon ',numdims
574  else
575  status=nf90_inq_varid(ncid3d,'grid_xt',varid)
576  status=nf90_inquire_variable(ncid3d,varid,ndims = numdims)
577  if(debugprint)print*,'number of dim for gdlon ',numdims
578  end if
579  if(numdims==1)then
580  status=nf90_get_var(ncid3d,varid,glon1d)
581  do j=jsta,jend
582  do i=ista,iend
583  gdlon(i,j) = real(glon1d(i),kind=4)
584  end do
585  end do
586  lonstart = nint(glon1d(1)*gdsdegr)
587  lonlast = nint(glon1d(im)*gdsdegr)
588 
589 ! Jili Dong add support for regular lat lon (2019/03/22) start
590  if (maptype == 0) then
591  if(lonstart<0.)then
592  lonstart=lonstart+360.*gdsdegr
593  end if
594  if(lonlast<0.)then
595  lonlast=lonlast+360.*gdsdegr
596  end if
597  end if
598 ! Jili Dong add support for regular lat lon (2019/03/22) end
599 
600  else if(numdims==2)then
601  status=nf90_get_var(ncid3d,varid,dummy)
602  if(maxval(abs(dummy))<2.0*pi)convert_rad_to_deg=.true.
603  if(convert_rad_to_deg)then
604  do j=jsta,jend
605  do i=ista,iend
606  gdlon(i,j) = real(dummy(i,j),kind=4)*180./pi
607  end do
608  end do
609  else
610  do j=jsta,jend
611  do i=ista,iend
612  gdlon(i,j) = real(dummy(i,j),kind=4)
613  end do
614  end do
615  end if
616  if(convert_rad_to_deg)then
617  lonstart = nint(dummy(1,1)*gdsdegr)*180./pi
618  lonlast = nint(dummy(im,jm)*gdsdegr)*180./pi
619  lonse = nint(dummy(im,1)*gdsdegr)*180./pi
620  lonnw = nint(dummy(1,jm)*gdsdegr)*180./pi
621  else
622  lonstart = nint(dummy(1,1)*gdsdegr)
623  lonlast = nint(dummy(im,jm)*gdsdegr)
624  lonse = nint(dummy(im,1)*gdsdegr)
625  lonnw = nint(dummy(1,jm)*gdsdegr)
626  end if
627 
628 ! Jili Dong add support for regular lat lon (2019/03/22) start
629  if (maptype == 0) then
630  if(lonstart<0.)then
631  lonstart=lonstart+360.*gdsdegr
632  end if
633  if(lonlast<0.)then
634  lonlast=lonlast+360.*gdsdegr
635  end if
636  end if
637 ! Jili Dong add support for regular lat lon (2019/03/22) end
638 
639  end if
640  print*,'lonstart,lonlast ',lonstart,lonlast
641 ! Jili Dong add support for new write component output
642 ! get latitude
643  if (read_lonlat) then
644  status=nf90_inq_varid(ncid3d,'lat',varid)
645  status=nf90_inquire_variable(ncid3d,varid,ndims = numdims)
646  if(debugprint)print*,'number of dim for gdlat ',numdims
647  else
648  status=nf90_inq_varid(ncid3d,'grid_yt',varid)
649  status=nf90_inquire_variable(ncid3d,varid,ndims = numdims)
650  if(debugprint)print*,'number of dim for gdlat ',numdims
651  end if
652  if(numdims==1)then
653  status=nf90_get_var(ncid3d,varid,glat1d)
654  do j=jsta,jend
655  do i=ista,iend
656  gdlat(i,j) = real(glat1d(j),kind=4)
657  end do
658  end do
659  latstart = nint(glat1d(1)*gdsdegr)
660  latlast = nint(glat1d(jm)*gdsdegr)
661  else if(numdims==2)then
662  status=nf90_get_var(ncid3d,varid,dummy)
663  if(maxval(abs(dummy))<pi)convert_rad_to_deg=.true.
664  if(convert_rad_to_deg)then
665  do j=jsta,jend
666  do i=ista,iend
667  gdlat(i,j) = real(dummy(i,j),kind=4)*180./pi
668  end do
669  end do
670  else
671  do j=jsta,jend
672  do i=ista,iend
673  gdlat(i,j) = real(dummy(i,j),kind=4)
674  end do
675  end do
676  end if
677  if(convert_rad_to_deg)then
678  latstart = nint(dummy(1,1)*gdsdegr)*180./pi
679  latlast = nint(dummy(im,jm)*gdsdegr)*180./pi
680  latse = nint(dummy(im,1)*gdsdegr)*180./pi
681  latnw = nint(dummy(1,jm)*gdsdegr)*180./pi
682  else
683  latstart = nint(dummy(1,1)*gdsdegr)
684  latlast = nint(dummy(im,jm)*gdsdegr)
685  latse = nint(dummy(im,1)*gdsdegr)
686  latnw = nint(dummy(1,jm)*gdsdegr)
687  end if
688  end if
689  print*,'laststart,latlast = ',latstart,latlast
690  if(debugprint)print*,'me sample gdlon gdlat= ' &
691  ,me,gdlon(isa,jsa),gdlat(isa,jsa)
692 
693 ! Specify grid staggering type
694  gridtype = 'A'
695  maptype=idrt
696  if (me == 0) print *, 'maptype and gridtype is ', &
697  maptype,gridtype
698 
699  if(gridtype == 'A')then
700  lonstartv=lonstart
701  lonlastv=lonlast
702  latstartv=latstart
703  latlastv=latlast
704  cenlatv=cenlat
705  cenlonv=cenlon
706  end if
707 
708  if(debugprint)then
709  if (me == 0)then
710  do i=1,nrec
711  print *,'recname=',trim(recname(i))
712  end do
713  end if
714  end if
715 
716 
717  deallocate(glat1d,glon1d)
718 
719  print*,'idate = ',(idate(i),i=1,7)
720 ! print*,'nfhour = ',nfhour
721 
722 ! sample print point
723  ii = im/2
724  jj = jm/2
725 
726  print *,me,'max(gdlat)=', maxval(gdlat), &
727  'max(gdlon)=', maxval(gdlon)
728  CALL exch(gdlat(ista_2l,jsta_2l))
729  CALL exch(gdlon(ista_2l,jsta_2l))
730  print *,'after call EXCH,me=',me
731 
732 !$omp parallel do private(i,j,ip1)
733  do j = jsta, jend_m
734  do i = ista, iend_m
735  ip1 = i + 1
736 ! if (ip1 > im) ip1 = ip1 - im
737  if(maptype==207)then
738  dx(i,j) = erad*dxval*dtr/gdsdegr
739  else
740  dx(i,j) = erad*cos(gdlat(i,j)*dtr) *(gdlon(ip1,j)-gdlon(i,j))*dtr
741  endif
742  if(maptype==207)then
743  dy(i,j)= erad*dyval*dtr/gdsdegr
744  else
745  dy(i,j) = erad*(gdlat(i,j+1)-gdlat(i,j))*dtr ! like A*DPH
746  endif
747 ! F(I,J)=1.454441e-4*sin(gdlat(i,j)*DTR) ! 2*omeg*sin(phi)
748 ! if (i == ii .and. j == jj) print*,'sample LATLON, DY, DY=' &
749 ! ,i,j,GDLAT(I,J),GDLON(I,J),DX(I,J),DY(I,J)
750  end do
751  end do
752  if(debugprint)print*,'me sample dx dy= ' &
753  ,me,dx(isa,jsa),dy(isa,jsa)
754 !$omp parallel do private(i,j)
755  do j=jsta,jend
756  do i=ista,iend
757  f(i,j) = 1.454441e-4*sin(gdlat(i,j)*dtr) ! 2*omeg*sin(phi)
758  end do
759  end do
760 
761  iyear = idate(1)
762  imn = idate(2)
763  iday = idate(3)
764  ihrst = idate(4)
765  imin = idate(5)
766  jdate = 0
767  idate = 0
768 !
769  print*,'start yr mo day hr min =',iyear,imn,iday,ihrst,imin
770  print*,'processing yr mo day hr min=' &
771  ,idat(3),idat(1),idat(2),idat(4),idat(5)
772 !
773  idate(1) = iyear
774  idate(2) = imn
775  idate(3) = iday
776  idate(5) = ihrst
777  idate(6) = imin
778  sdat(1) = imn
779  sdat(2) = iday
780  sdat(3) = iyear
781  jdate(1) = idat(3)
782  jdate(2) = idat(1)
783  jdate(3) = idat(2)
784  jdate(5) = idat(4)
785  jdate(6) = idat(5)
786 !
787  print *,' idate=',idate
788  print *,' jdate=',jdate
789 !
790  CALL w3difdat(jdate,idate,0,rinc)
791 !
792  print *,' rinc=',rinc
793  ifhr = nint(rinc(2)+rinc(1)*24.)
794  print *,' ifhr=',ifhr
795  ifmin = nint(rinc(3))
796 ! if(ifhr /= nint(fhour))print*,'find wrong Grib file';stop
797  print*,' in INITPOST ifhr ifmin fileName=',ifhr,ifmin,filename
798 
799 ! Getting tstart
800  tstart = 0.
801  print*,'tstart= ',tstart
802 
803 ! Getiing restart
804 
805  restrt = .true. ! set RESTRT as default
806 
807  IF(tstart > 1.0e-2)THEN
808  ifhr = ifhr+nint(tstart)
809  rinc = 0
810  idate = 0
811  rinc(2) = -1.0*ifhr
812  call w3movdat(rinc,jdate,idate)
813  sdat(1) = idate(2)
814  sdat(2) = idate(3)
815  sdat(3) = idate(1)
816  ihrst = idate(5)
817  print*,'new forecast hours for restrt run= ',ifhr
818  print*,'new start yr mo day hr min =',sdat(3),sdat(1) &
819  ,sdat(2),ihrst,imin
820  END IF
821 
822 ! GFS does not need DT to compute accumulated fields, set it to one
823 ! VarName='DT'
824  dt = 1
825 
826  hbm2 = 1.0
827 
828 ! start reading 3d netcdf output
829  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
830  spval,recname(1),uh(ista_2l,jsta_2l,1),lm)
831  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
832  spval,recname(2),vh(ista_2l,jsta_2l,1),lm)
833  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
834  spval,recname(3),q(ista_2l,jsta_2l,1),lm)
835  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
836  spval,recname(4),t(ista_2l,jsta_2l,1),lm)
837  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
838  spval,recname(5),o3(ista_2l,jsta_2l,1),lm)
839  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
840  spval,recname(7),wh(ista_2l,jsta_2l,1),lm)
841  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
842  spval,recname(8),qqw(ista_2l,jsta_2l,1),lm)
843  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
844  spval,recname(9),dpres(ista_2l,jsta_2l,1),lm)
845  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
846  spval,recname(10),buf3d(ista_2l,jsta_2l,1),lm)
847  do l=1,lm
848  do j=jsta,jend
849  do i=ista,iend
850  cwm(i,j,l)=spval
851 ! dong add missing value
852  if (wh(i,j,l) < spval) then
853  omga(i,j,l)=(-1.)*wh(i,j,l)*dpres(i,j,l)/abs(buf3d(i,j,l))
854  else
855  omga(i,j,l) = spval
856  end if
857 ! if(t(i,j,l)>1000.)print*,'bad T ',t(i,j,l)
858  enddo
859  enddo
860  enddo
861  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
862  spval,recname(11),qqi(ista_2l,jsta_2l,1),lm)
863  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
864  spval,recname(12),qqr(ista_2l,jsta_2l,1),lm)
865  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
866  spval,recname(13),qqs(ista_2l,jsta_2l,1),lm)
867  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
868  spval,recname(14),qqg(ista_2l,jsta_2l,1),lm)
869 ! read for regional FV3
870  if (modelname == 'FV3R') then
871  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
872  spval,recname(15),smoke(ista_2l,jsta_2l,1,1),lm)
873  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
874  spval,recname(16),fv3dust(ista_2l,jsta_2l,1,1),lm)
875  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
876  spval,recname(17),coarsepm(ista_2l,jsta_2l,1,1),lm)
877  call read_netcdf_3d_para(ncid2d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
878  spval,recname(18),ext550(ista_2l,jsta_2l,1),lm)
879  endif
880 
881 ! Compute max QRAIN in the column to be used later in precip type computation
882  do j = jsta_2l, jend_2u
883  do i = 1, im
884  qrmax(i,j)=0.
885  end do
886  end do
887 
888 ! calculate CWM from FV3 output
889  do l=1,lm
890  do j=jsta,jend
891  do i=ista,iend
892  qrmax(i,j)=max(qrmax(i,j),qqr(i,j,l))
893  cwm(i,j,l)=qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l)
894  enddo
895  enddo
896  if(debugprint)print*,'sample l,t,q,u,v,w= ',isa,jsa,l &
897  ,t(isa,jsa,l),q(isa,jsa,l),uh(isa,jsa,l),vh(isa,jsa,l) &
898  ,wh(isa,jsa,l)
899  if(debugprint)print*,'sample l cwm for FV3',l, &
900  cwm(isa,jsa,l)
901  end do
902 
903 ! instantaneous 3D cloud fraction
904  if ( imp_physics==11) then !GFDL MP
905  varname='cld_amt'
906  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
907  spval,varname,cfr(ista_2l,jsta_2l,1),lm)
908  else
909 
910  iret_bl = nf90_inq_varid(ncid2d,'cldfra_bl',varid_bl)
911  iret = nf90_inq_varid(ncid2d,'cldfra',varid)
912 
913  if(iret_bl==nf90_noerr .and. iret==nf90_noerr) then
914  write(*,*) 'WARNING: BOTH cldfra_bl AND cldfra ARE AVAILABLE. USING cldfra.'
915  varname='cldfra'
916  else if(iret_bl==nf90_noerr) then
917  varname='cldfra_bl'
918  else if(iret==nf90_noerr) then
919  varname='cldfra'
920  else
921  varname='nope'
922  endif
923 
924  if(varname /= 'nope') then
925  call read_netcdf_3d_para(ncid2d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
926  spval,varname,cfr(ista_2l,jsta_2l,1),lm)
927  endif
928  endif
929 ! do l=1,lm
930 ! if(debugprint)print*,'sample ',VarName,'isa,jsa,l =' &
931 ! ,cfr(isa,jsa,l),isa,jsa,l
932 ! enddo
933 
934 ! WL add cieffr for Thompson scheme cloud ice effective radius
935  varname='cieffr'
936  call read_netcdf_3d_para(ncid2d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
937  spval,varname,effri(ista_2l,jsta_2l,1),lm)
938 
939 ! WL add cleffr for Thompson scheme cloud water effective radius
940  varname='cleffr'
941  call read_netcdf_3d_para(ncid2d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
942  spval,varname,effrl(ista_2l,jsta_2l,1),lm)
943 
944 ! WL add cseffr for Thompson scheme snow effective radius
945  varname='cseffr'
946  call read_netcdf_3d_para(ncid2d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
947  spval,varname,effrs(ista_2l,jsta_2l,1),lm)
948 
949 !=====================================
950 ! For AQF Hourly average field PM2.5
951 !=====================================
952 
953  if (aqf_on) then
954 
955  ! *********** VarName need to be in lower case ************
956  ! === It will cause problem if not use the lower case =====
957  ! *********************************************************
958 
959  !-- rename input o3_ave and pm25_ave to NCO grib2 name OZCON and PMTF
960 
961  varname='o3_ave'
962  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
963  spval,varname,avgozcon(ista_2l,jsta_2l,1),lm)
964 
965  varname='pm25_ave'
966  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
967  spval,varname,avgpmtf(ista_2l,jsta_2l,1),lm)
968 
969  varname='aod'
970  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
971  spval,varname,aqm_aod550(ista_2l,jsta_2l))
972 
973  endif ! -- aqf_on
974 !============================
975 
976 ! read for regional FV3
977  if (modelname == 'FV3R') then
978 ! max hourly updraft velocity
979  varname='upvvelmax'
980  call read_netcdf_2d_para(ncid3d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
981  spval,varname,w_up_max(ista_2l,jsta_2l))
982  if(debugprint)print*,'sample ',varname,' = ',w_up_max(isa,jsa)
983 ! max hourly downdraft velocity
984  varname='dnvvelmax'
985  call read_netcdf_2d_para(ncid3d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
986  spval,varname,w_dn_max(ista_2l,jsta_2l))
987  if(debugprint)print*,'sample ',varname,' = ',w_dn_max(isa,jsa)
988 ! max hourly updraft helicity
989  varname='uhmax25'
990  call read_netcdf_2d_para(ncid3d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
991  spval,varname,up_heli_max(ista_2l,jsta_2l))
992  if(debugprint)print*,'sample ',varname,' = ',up_heli_max(isa,jsa)
993 ! min hourly updraft helicity
994  varname='uhmin25'
995  call read_netcdf_2d_para(ncid3d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
996  spval,varname,up_heli_min(ista_2l,jsta_2l))
997  if(debugprint)print*,'sample ',varname,' = ',up_heli_min(isa,jsa)
998 ! max hourly 0-3km updraft helicity
999  varname='uhmax03'
1000  call read_netcdf_2d_para(ncid3d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1001  spval,varname,up_heli_max03(ista_2l,jsta_2l))
1002  if(debugprint)print*,'sample ',varname,' = ',up_heli_max03(isa,jsa)
1003 ! min hourly 0-3km updraft helicity
1004  varname='uhmin03'
1005  call read_netcdf_2d_para(ncid3d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1006  spval,varname,up_heli_min03(ista_2l,jsta_2l))
1007  if(debugprint)print*,'sample ',varname,' = ',up_heli_min03(isa,jsa)
1008 
1009 ! max 0-1km relative vorticity max
1010  varname='maxvort01'
1011  call read_netcdf_2d_para(ncid3d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1012  spval,varname,rel_vort_max01(ista_2l,jsta_2l))
1013  if(debugprint)print*,'sample ',varname,' = ',rel_vort_max01(isa,jsa)
1014 ! max 0-2km relative vorticity max
1015  varname='maxvort02'
1016  call read_netcdf_2d_para(ncid3d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1017  spval,varname,rel_vort_max(ista_2l,jsta_2l))
1018  if(debugprint)print*,'sample ',varname,' =',rel_vort_max(isa,jsa)
1019 ! max hybrid lev 1 relative vorticity max
1020  varname='maxvorthy1'
1021  call read_netcdf_2d_para(ncid3d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1022  spval,varname,rel_vort_maxhy1(ista_2l,jsta_2l))
1023  if(debugprint)print*,'sample ',varname,' =',rel_vort_maxhy1(isa,jsa)
1024 ! biomass burning emissions
1025  varname='ebb_smoke_hr'
1026  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1027  spval,varname,ebb(ista_2l,jsta_2l))
1028  if(debugprint)print*,'sample ',varname,' =',ebb(isa,jsa)
1029 ! hourly wildfire potential
1030  varname='hwp'
1031  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1032  spval,varname,hwp(ista_2l,jsta_2l))
1033  if(debugprint)print*,'sample ',varname,' =',hwp(isa,jsa)
1034  endif
1035 
1036 ! lightning threat index 1
1037  varname='ltg1_max'
1038  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1039  spval,varname,ltg1_max(ista_2l,jsta_2l))
1040  if(debugprint)print*,'sample ',varname,' =',ltg1_max(isa,jsa)
1041 
1042 ! lightning threat index 2
1043  varname='ltg2_max'
1044  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1045  spval,varname,ltg2_max(ista_2l,jsta_2l))
1046  if(debugprint)print*,'sample ',varname,' =',ltg2_max(isa,jsa)
1047 
1048 ! lightning threat index 3
1049  varname='ltg3_max'
1050  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1051  spval,varname,ltg3_max(ista_2l,jsta_2l))
1052  if(debugprint)print*,'sample ',varname,' =',ltg3_max(isa,jsa)
1053 
1054 ! surface pressure
1055  varname='pressfc'
1056  call read_netcdf_2d_para(ncid3d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1057  spval,varname,pint(ista_2l,jsta_2l,lp1))
1058  do j=jsta,jend
1059  do i=ista,iend
1060 ! if(pint(i,j,lp1)>1.0E6 .or. pint(ista_2l,jsta_2l,lp1)<50000.) &
1061 ! print*,'bad psfc ',i,j,pint(i,j,lp1)
1062  end do
1063  end do
1064  if(debugprint)print*,'sample ',varname,' =',pint(isa,jsa,lp1)
1065 
1066  pt = ak5(1)
1067 
1068  do j=jsta,jend
1069  do i=ista,iend
1070  pint(i,j,1)= pt
1071  end do
1072  end do
1073 
1074  do l=2,lp1
1075  do j=jsta,jend
1076  do i=ista,iend
1077  if (dpres(i,j,l-1)<spval .and. pint(i,j,l-1)<spval) then
1078  pint(i,j,l)= pint(i,j,l-1) + dpres(i,j,l-1)
1079  else
1080  pint(i,j,l)=spval
1081  endif
1082  enddo
1083  enddo
1084 ! if (me == 0) print*,'sample model pint,pmid' ,ii,jj,l &
1085 ! ,pint(ii,jj,l),pmid(ii,jj,l)
1086  end do
1087 
1088 !compute pmid from averaged two layer pint
1089  do l=lm,1,-1
1090  do j=jsta,jend
1091  do i=ista,iend
1092  if (pint(i,j,l)<spval .and. pint(i,j,l+1)<spval) then
1093  pmid(i,j,l)=0.5*(pint(i,j,l)+pint(i,j,l+1))
1094  else
1095  pmid(i,j,l)=spval
1096  endif
1097  enddo
1098  enddo
1099  enddo
1100 
1101 ! surface height from FV3
1102 ! dong set missing value for zint
1103 ! zint=spval
1104  varname='hgtsfc'
1105  call read_netcdf_2d_para(ncid3d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1106  spval,varname,zint(ista_2l,jsta_2l,lp1))
1107  if(debugprint)print*,'sample ',varname,' =',zint(isa,jsa,lp1)
1108  do j=jsta,jend
1109  do i=ista,iend
1110  if (zint(i,j,lp1) /= spval) then
1111  fis(i,j) = zint(i,j,lp1) * grav
1112  else
1113  fis(i,j) = spval
1114  endif
1115  enddo
1116  enddo
1117 
1118  do l=lm,1,-1
1119  do j=jsta,jend
1120  do i=ista,iend
1121  if(zint(i,j,l+1)/=spval .and. buf3d(i,j,l)/=spval)then
1122 !make sure delz is positive
1123  zint(i,j,l)=zint(i,j,l+1)+abs(buf3d(i,j,l))
1124 ! if(zint(i,j,l)>1.0E6)print*,'bad H ',i,j,l,zint(i,j,l)
1125  else
1126  zint(i,j,l)=spval
1127  end if
1128  end do
1129  end do
1130  if(debugprint)print*,'sample zint= ',isa,jsa,l,zint(isa,jsa,l)
1131  end do
1132 
1133  do l=lp1,1,-1
1134  do j=jsta,jend
1135  do i=ista,iend
1136  alpint(i,j,l)=log(pint(i,j,l))
1137  end do
1138  end do
1139  end do
1140 
1141  do l=lm,1,-1
1142  do j=jsta,jend
1143  do i=ista,iend
1144  if(zint(i,j,l+1)/=spval .and. zint(i,j,l)/=spval &
1145  .and. pmid(i,j,l)/=spval)then
1146  zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* &
1147  (log(pmid(i,j,l))-alpint(i,j,l+1))/ &
1148  (alpint(i,j,l)-alpint(i,j,l+1))
1149  if(zmid(i,j,l)>1.0e6)print*,'bad Hmid ',i,j,l,zmid(i,j,l)
1150  else
1151  zmid(i,j,l)=spval
1152  endif
1153  end do
1154  end do
1155  end do
1156 
1157 
1158  print *, 'gocart_on=',gocart_on
1159  print *, 'gccpp_on=',gccpp_on
1160  print *, 'nasa_on=',nasa_on
1161  if (gocart_on .or.gccpp_on .or. nasa_on) then
1162 
1163 ! GFS output dust in nemsio (GOCART)
1164  dustcb=0.0
1165  dustallcb=0.0
1166 ! DUST = SPVAL
1167 
1168  varname='dust1'
1169  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1170  spval,varname,dt1(ista_2l,jsta_2l,1),lm)
1171  varname='dust2'
1172  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1173  spval,varname,dt2(ista_2l,jsta_2l,1),lm)
1174  varname='dust3'
1175  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1176  spval,varname,dt3(ista_2l,jsta_2l,1),lm)
1177  varname='dust4'
1178  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1179  spval,varname,dt4(ista_2l,jsta_2l,1),lm)
1180  varname='dust5'
1181  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1182  spval,varname,dt5(ista_2l,jsta_2l,1),lm)
1183 
1184 
1185  do l=1,lm
1186 
1187 !$omp parallel do private(i,j)
1188  do j=jsta,jend
1189  do i=ista,iend
1190  dust(i,j,l,1)=dt1(i,j,l)
1191  dust(i,j,l,2)=dt2(i,j,l)
1192  dust(i,j,l,3)=dt3(i,j,l)
1193  dust(i,j,l,4)=dt4(i,j,l)
1194  dust(i,j,l,5)=dt5(i,j,l)
1195 
1196 
1197  dustcb(i,j)=dustcb(i,j)+&
1198  (dust(i,j,l,1)+0.38*dust(i,j,l,2))* &
1199  dpres(i,j,l)/grav
1200 
1201 
1202  dustallcb(i,j)=dustallcb(i,j)+ &
1203  (dust(i,j,l,1)+dust(i,j,l,2)+ &
1204  dust(i,j,l,3)+0.74*dust(i,j,l,4))* &
1205  dpres(i,j,l)/grav
1206  enddo
1207  enddo
1208  end do ! do loop for l
1209 
1210 
1211 ! GFS output sea salt in nemsio (GOCART)
1212  sscb=0.0
1213  ssallcb=0.0
1214 
1215  varname='seas1'
1216  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1217  spval,varname,dt1(ista_2l,jsta_2l,1),lm)
1218 
1219  varname='seas2'
1220  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1221  spval,varname,dt2(ista_2l,jsta_2l,1),lm)
1222 
1223  varname='seas3'
1224  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1225  spval,varname,dt3(ista_2l,jsta_2l,1),lm)
1226 
1227  varname='seas4'
1228  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1229  spval,varname,dt4(ista_2l,jsta_2l,1),lm)
1230 
1231  varname='seas5'
1232  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1233  spval,varname,dt5(ista_2l,jsta_2l,1),lm)
1234 
1235 
1236 
1237  do l=1,lm
1238 !$omp parallel do private(i,j)
1239  do j=jsta,jend
1240  do i=ista,iend
1241  salt(i,j,l,1)=dt1(i,j,l)
1242  salt(i,j,l,2)=dt2(i,j,l)
1243  salt(i,j,l,3)=dt3(i,j,l)
1244  salt(i,j,l,4)=dt4(i,j,l)
1245  salt(i,j,l,5)=dt5(i,j,l)
1246 
1247  sscb(i,j)=sscb(i,j)+ &
1248  (salt(i,j,l,1)+salt(i,j,l,2)+0.83*salt(i,j,l,3))* &
1249  dpres(i,j,l)/grav
1250 
1251 
1252  ssallcb(i,j)=ssallcb(i,j)+ &
1253  (salt(i,j,l,1)+salt(i,j,l,2)+salt(i,j,l,3)+salt(i,j,l,4))* &
1254  dpres(i,j,l)/grav
1255  enddo
1256  enddo
1257  end do ! do loop for l
1258 ! GFS output black carbon in nemsio (GOCART)
1259  bccb=0.0
1260 
1261 
1262  varname='bc1'
1263  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1264  spval,varname,dt1(ista_2l,jsta_2l,1),lm)
1265 
1266  varname='bc2'
1267  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1268  spval,varname,dt2(ista_2l,jsta_2l,1),lm)
1269 
1270  do l=1,lm
1271 !$omp parallel do private(i,j)
1272  do j=jsta,jend
1273  do i=ista,iend
1274 
1275  soot(i,j,l,1)=dt1(i,j,l)
1276  soot(i,j,l,2)=dt2(i,j,l)
1277 
1278  bccb(i,j)=bccb(i,j)+ &
1279  (soot(i,j,l,1)+soot(i,j,l,2))* &
1280  dpres(i,j,l)/grav
1281  enddo
1282  enddo
1283  end do ! do loop for l
1284 
1285  occb=0.0
1286 ! GFS output organic carbon in nemsio (GOCART)
1287 
1288  varname='oc1'
1289  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1290  spval,varname,dt1(ista_2l,jsta_2l,1),lm)
1291 
1292  varname='oc2'
1293  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1294  spval,varname,dt2(ista_2l,jsta_2l,1),lm)
1295  do l=1,lm
1296 !$omp parallel do private(i,j)
1297  do j=jsta,jend
1298  do i=ista,iend
1299  waso(i,j,l,1)=dt1(i,j,l)
1300  waso(i,j,l,2)=dt2(i,j,l)
1301 
1302  occb(i,j)=occb(i,j)+ &
1303  (waso(i,j,l,1)+waso(i,j,l,2))* &
1304  dpres(i,j,l)/grav
1305  enddo
1306  enddo
1307  end do ! do loop for l
1308 
1309 ! GFS output sulfate in netcdf (GOCART)
1310  sulfcb=0.0
1311 
1312 ! SUSO = SPVAL
1313  if (gocart_on .or. gccpp_on) then
1314  varname='sulf'
1315  endif
1316 
1317  if (nasa_on) then
1318  varname='so4'
1319  endif
1320  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1321  spval,varname,dt1(ista_2l,jsta_2l,1),lm)
1322 
1323  do l=1,lm
1324 !$omp parallel do private(i,j)
1325  do j=jsta,jend
1326  do i=ista,iend
1327  suso(i,j,l,1)=dt1(i,j,l)
1328 
1329  sulfcb(i,j)=sulfcb(i,j)+ &
1330  suso(i,j,l,1)* &
1331  dpres(i,j,l)/grav
1332  enddo
1333  enddo
1334  end do ! do loop for l
1335 
1336  if (nasa_on) then
1337 ! GFS output nitrate in netcdf (GOCART)
1338  no3cb=0.0
1339  varname='no3an1'
1340  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1341  spval,varname,dt1(ista_2l,jsta_2l,1),lm)
1342 
1343  varname='no3an2'
1344  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1345  spval,varname,dt2(ista_2l,jsta_2l,1),lm)
1346 
1347  varname='no3an3'
1348  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1349  spval,varname,dt3(ista_2l,jsta_2l,1),lm)
1350 
1351  do l=1,lm
1352 !$omp parallel do private(i,j)
1353  do j=jsta,jend
1354  do i=ista,iend
1355  no3(i,j,l,1)=dt1(i,j,l)
1356  no3(i,j,l,2)=dt2(i,j,l)
1357  no3(i,j,l,3)=dt3(i,j,l)
1358 
1359  no3cb(i,j)=no3cb(i,j)+ &
1360  (no3(i,j,l,1)+no3(i,j,l,2)+no3(i,j,l,3))* &
1361  dpres(i,j,l)/grav
1362  enddo
1363  enddo
1364  end do ! do loop for l
1365 
1366 ! GFS output NH4 in netcdf (GOCART)
1367  nh4cb=0.0
1368  varname='nh4a'
1369  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1370  spval,varname,dt1(ista_2l,jsta_2l,1),lm)
1371 
1372  do l=1,lm
1373 !$omp parallel do private(i,j)
1374  do j=jsta,jend
1375  do i=ista,iend
1376  nh4(i,j,l,1)=dt1(i,j,l)
1377 
1378  nh4cb(i,j)=nh4cb(i,j)+ &
1379  nh4(i,j,l,1)* &
1380  dpres(i,j,l)/grav
1381  enddo
1382  enddo
1383  end do ! do loop for l
1384 
1385 
1386  endif !nasa_on
1387 
1388 ! GFS output pp25 in nemsio (GOCART)
1389  pp25cb=0.0
1390 
1391  if (gocart_on .or. gccpp_on) then
1392  varname='pp25'
1393  endif
1394 
1395  if (nasa_on) then
1396  varname='pm25'
1397  endif
1398  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1399  spval,varname,dt1(ista_2l,jsta_2l,1),lm)
1400 
1401 
1402 ! GFS output pp10 in nemsio (GOCART)
1403  pp10cb=0.0
1404  if (gocart_on .or. gccpp_on) then
1405  varname='pp10'
1406  endif
1407 
1408  if (nasa_on) then
1409  varname='pm10'
1410  endif
1411 
1412  call read_netcdf_3d_para(ncid3d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
1413  spval,varname,dt2(ista_2l,jsta_2l,1),lm)
1414 
1415  do l=1,lm
1416 !$omp parallel do private(i,j)
1417  do j=jsta,jend
1418  do i=ista,iend
1419  pp25(i,j,l,1)=dt1(i,j,l)
1420  pp10(i,j,l,1)=dt2(i,j,l)
1421 
1422 
1423  pp25cb(i,j)=pp25cb(i,j)+ &
1424  pp25(i,j,l,1)* dpres(i,j,l)/grav
1425 
1426  pp10cb(i,j)=pp10cb(i,j)+ &
1427  pp10(i,j,l,1)* dpres(i,j,l)/grav
1428  enddo
1429  enddo
1430  end do ! do loop for l
1431 ! -- compute air density RHOMID and remove negative tracer values
1432  do l=1,lm
1433 !$omp parallel do private(i,j,tv)
1434  do j=jsta,jend
1435  do i=ista,iend
1436 
1437  tv = t(i,j,l) * (h1+d608*max(q(i,j,l),qmin))
1438  rhomid(i,j,l) = pmid(i,j,l) / (rd*tv)
1439  do n = 1, nbin_du
1440  IF ( dust(i,j,l,n) < spval) THEN
1441  dust(i,j,l,n) = max(dust(i,j,l,n), 0.0)
1442  ENDIF
1443  enddo
1444  do n = 1, nbin_ss
1445  IF ( salt(i,j,l,n) < spval) THEN
1446  salt(i,j,l,n) = max(salt(i,j,l,n), 0.0)
1447  ENDIF
1448  enddo
1449  do n = 1, nbin_oc
1450  IF ( waso(i,j,l,n) < spval) THEN
1451  waso(i,j,l,n) = max(waso(i,j,l,n), 0.0)
1452  ENDIF
1453  enddo
1454  do n = 1, nbin_bc
1455  IF ( soot(i,j,l,n) < spval) THEN
1456  soot(i,j,l,n) = max(soot(i,j,l,n), 0.0)
1457  ENDIF
1458  enddo
1459  do n = 1, nbin_su
1460  IF ( suso(i,j,l,n) < spval) THEN
1461  suso(i,j,l,n) = max(suso(i,j,l,n), 0.0)
1462  ENDIF
1463  enddo
1464  if (nasa_on) then
1465  do n = 1, nbin_no3
1466  IF ( no3(i,j,l,n) < spval) THEN
1467  no3(i,j,l,n) = max(no3(i,j,l,n), 0.0)
1468  ENDIF
1469  enddo
1470  do n = 1, nbin_nh4
1471  IF ( nh4(i,j,l,n) < spval) THEN
1472  nh4(i,j,l,n) = max(nh4(i,j,l,n), 0.0)
1473  ENDIF
1474  enddo
1475  endif !nasa_on
1476  end do
1477  end do
1478  end do
1479  l=lm
1480 !$omp parallel do private(i,j)
1481  do j=jsta,jend
1482  do i=ista,iend
1483  dustcb(i,j) = max(dustcb(i,j), 0.0)
1484  dustallcb(i,j) = max(dustallcb(i,j), 0.0)
1485  sscb(i,j) = max(sscb(i,j), 0.0)
1486  ssallcb(i,j) = max(ssallcb(i,j), 0.0)
1487  bccb(i,j) = max(bccb(i,j), 0.0)
1488  occb(i,j) = max(occb(i,j), 0.0)
1489  sulfcb(i,j) = max(sulfcb(i,j), 0.0)
1490  if (nasa_on) then
1491  no3cb(i,j) = max(no3cb(i,j), 0.0)
1492  nh4cb(i,j) = max(nh4cb(i,j), 0.0)
1493  endif
1494  pp25cb(i,j) = max(pp25cb(i,j), 0.0)
1495  pp10cb(i,j) = max(pp10cb(i,j), 0.0)
1496 
1497 ! PM25 dust and seasalt
1498  dustpm(i,j)=(dust(i,j,l,1)+0.38*dust(i,j,l,2))*rhomid(i,j,l) !ug/m3
1499  dustpm10(i,j)=(dust(i,j,l,1)+dust(i,j,l,2)+dust(i,j,l,3)+ &
1500  0.74*dust(i,j,l,4))*rhomid(i,j,l) !ug/m3
1501  sspm(i,j)=(salt(i,j,l,1)+salt(i,j,l,2)+ &
1502  0.83*salt(i,j,l,3))*rhomid(i,j,l) !ug/m3
1503 
1504  if (gocart_on .or. gccpp_on) then
1505 ! PM10 concentration
1506  dusmass(i,j)=(dust(i,j,l,1)+dust(i,j,l,2)+dust(i,j,l,3)+ &
1507  0.74*dust(i,j,l,4)+salt(i,j,l,1)+salt(i,j,l,2)+salt(i,j,l,3)+ &
1508  salt(i,j,l,4) + soot(i,j,l,1)+soot(i,j,l,2)+waso(i,j,l,1)+ &
1509  waso(i,j,l,2) +suso(i,j,l,1)+pp25(i,j,l,1)+pp10(i,j,l,1)) &
1510  *rhomid(i,j,l) !ug/m3
1511 ! PM25 concentration
1512  dusmass25(i,j)=(dust(i,j,l,1)+0.38*dust(i,j,l,2)+ &
1513  salt(i,j,l,1)+salt(i,j,l,2)+0.83*salt(i,j,l,3) + &
1514  soot(i,j,l,1)+soot(i,j,l,2)+waso(i,j,l,1)+ &
1515  waso(i,j,l,2) +suso(i,j,l,1)+pp25(i,j,l,1))*rhomid(i,j,l) !ug/m3
1516 
1517 ! PM10 column
1518  ducmass(i,j)=dustallcb(i,j)+ssallcb(i,j)+bccb(i,j)+ &
1519  occb(i,j)+sulfcb(i,j)+pp25cb(i,j)+pp10cb(i,j)
1520 ! PM25 column
1521  ducmass25(i,j)=dustcb(i,j)+sscb(i,j)+bccb(i,j)+occb(i,j) &
1522  +sulfcb(i,j)+pp25cb(i,j)
1523  endif !gocart_on
1524 
1525  if (nasa_on) then
1526 ! PM10 concentration
1527  dusmass(i,j)=pp10(i,j,l,1)*rhomid(i,j,l) !ug/m3
1528 ! PM25 concentration
1529  dusmass25(i,j)=pp25(i,j,l,1)*rhomid(i,j,l) !ug/m3
1530 
1531 ! PM10 column
1532  ducmass(i,j)=pp10cb(i,j)
1533 ! PM25 column
1534  ducmass25(i,j)=pp25cb(i,j)
1535  endif !nasa_on
1536 
1537 
1538  end do
1539  end do
1540 
1541 
1542  endif ! endif for gocart_on & nasa_on
1543 
1544 ! ',ll,waso(isa,jsa,ll,2)
1545 ! ',ll,waso(isa,jsa,ll,2)
1546 
1547 
1548 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1549 
1550 !
1551 
1552 ! done with 3d file, close it for now
1553  status=nf90_close(ncid3d)
1554  deallocate(recname)
1555 
1556 ! IVEGSRC=1 for IGBP, 0 for USGS, 2 for UMD
1557  varname='IVEGSRC'
1558  status=nf90_get_att(ncid2d,nf90_global,'IVEGSRC',ivegsrc)
1559  if (status /= 0) then
1560  print*,varname,' not found-Assigned 1 for IGBP as default'
1561  ivegsrc=1
1562  end if
1563  if (me == 0) print*,'IVEGSRC= ',ivegsrc
1564 
1565 ! set novegtype based on vegetation classification
1566  if(ivegsrc==2)then
1567  novegtype=13
1568  else if(ivegsrc==1)then
1569  novegtype=20
1570  else if(ivegsrc==0)then
1571  novegtype=24
1572  end if
1573  if (me == 0) print*,'novegtype= ',novegtype
1574 
1575  status=nf90_get_att(ncid2d,nf90_global,'fhzero',fhzero)
1576  if (status /= 0) then
1577  print*,'fhzero not found-Assigned 3 hours as default'
1578  fhzero=3
1579  end if
1580  if (me == 0) print*,'fhzero= ',fhzero
1581 !
1582  status=nf90_get_att(ncid2d,nf90_global,'dtp',dtp)
1583  if (status /= 0) then
1584  print*,'dtp not found-Assigned 90s as default'
1585  dtp=90
1586  end if
1587  if (me == 0) print*,'dtp= ',dtp
1588 ! Initializes constants for Ferrier microphysics
1589  if(imp_physics==5 .or. imp_physics==85 .or. imp_physics==95) then
1590  CALL microinit(imp_physics)
1591  end if
1592 
1593  tprec = float(fhzero)
1594  if(ifhr>240)tprec=12.
1595  tclod = tprec
1596  trdlw = tprec
1597  trdsw = tprec
1598  tsrfc = tprec
1599  tmaxmin = tprec
1600  td3d = tprec
1601  print*,'tprec = ',tprec
1602 
1603 
1604  varname='refl_10cm'
1605  call read_netcdf_3d_para(ncid2d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1606  spval,varname,ref_10cm(ista_2l,jsta_2l,1),lm)
1607 ! do l=1,lm
1608 ! if(debugprint)print*,'sample ',VarName,'isa,jsa,l =' &
1609 ! ,REF_10CM(isa,jsa,l),isa,jsa,l
1610 ! enddo
1611 
1612 ! turbulence kinetic energy (QKE = 2*TKE)
1613  varname='qke'
1614  call read_netcdf_3d_para(ncid2d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1615  spval,varname,q2(ista_2l,jsta_2l,1),lm)
1616  do l=1,lm
1617  do j=jsta,jend
1618  do i=ista,iend
1619  q2(i,j,l)=q2(i,j,l)/2.0
1620  enddo
1621  enddo
1622  enddo
1623 
1624 ! ice-friendly aerosol number concentration
1625  varname='nifa'
1626  call read_netcdf_3d_para(ncid2d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1627  spval,varname,qqnifa(ista_2l,jsta_2l,1),lm)
1628 
1629 ! water-friendly aerosol number concentration
1630  varname='nwfa'
1631  call read_netcdf_3d_para(ncid2d,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1632  spval,varname,qqnwfa(ista_2l,jsta_2l,1),lm)
1633 
1634  varname='land'
1635  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1636  spval,varname,sm)
1637  if(debugprint)print*,'sample ',varname,' =',sm((ista+iend)/2,(jsta+jend)/2)
1638 
1639 !$omp parallel do private(i,j)
1640  do j=jsta,jend
1641  do i=ista,iend
1642  if (sm(i,j) /= spval) sm(i,j) = 1.0 - sm(i,j)
1643  enddo
1644  enddo
1645 
1646 ! sea ice mask
1647 
1648  varname = 'icec'
1649  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1650  spval,varname,sice)
1651  if(debugprint)print*,'sample ',varname,' = ',sice(isa,jsa)
1652 
1653 ! where(sice /=spval .and. sice >=1.0)sm=0.0 !sea ice has sea
1654 ! mask=0
1655 ! GFS flux files have land points with non-zero sea ice, per Iredell,
1656 ! these
1657 ! points have sea ice changed to zero, i.e., trust land mask more than
1658 ! sea ice
1659 ! where(sm/=spval .and. sm==0.0)sice=0.0 !specify sea ice=0 at land
1660 
1661 !$omp parallel do private(i,j)
1662  do j=jsta,jend
1663  do i=ista,iend
1664  if (sm(i,j) /= spval .and. sm(i,j) == 0.0) sice(i,j) = 0.0
1665  enddo
1666  enddo
1667 
1668 
1669 ! PBL height using nemsio
1670  varname = 'hpbl'
1671  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1672  spval,varname,pblh)
1673  if(debugprint)print*,'sample ',varname,' = ',pblh(isa,jsa)
1674 
1675 ! frictional velocity using nemsio
1676  varname='fricv'
1677  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1678  spval,varname,ustar)
1679 ! if(debugprint)print*,'sample ',VarName,' = ',ustar(isa,jsa)
1680 
1681 ! roughness length using getgb
1682  varname='sfcr'
1683  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1684  spval,varname,z0)
1685 ! if(debugprint)print*,'sample ',VarName,' = ',z0(isa,jsa)
1686 
1687 ! sfc exchange coeff
1688  varname='sfexc'
1689  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1690  spval,varname,sfcexc)
1691 
1692 ! accumulated snowfall
1693  varname='tsnowp'
1694  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1695  spval,varname,snow_acm)
1696 ! snowfall bucket
1697  varname='tsnowpb'
1698  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1699  spval,varname,snow_bkt)
1700 
1701 ! accumulated graupel/sleet
1702  varname='frozr'
1703  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1704  spval,varname,acgraup)
1705 
1706 ! graupel/sleet bucket
1707  varname='frozrb'
1708  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1709  spval,varname,graup_bucket)
1710 
1711 ! accumulated freezing rain
1712  varname='frzr'
1713  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1714  spval,varname,acfrain)
1715 
1716 ! freezing rain bucket
1717  varname='frzrb'
1718  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1719  spval,varname,frzrn_bucket)
1720 
1721 ! time step snow (in m)
1722  varname='snow'
1723  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1724  spval,varname,snownc)
1725 
1726 ! time step graupel (in m)
1727  varname='graupel'
1728  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1729  spval,varname,graupelnc)
1730 
1731 ! aerodynamic conductance
1732  varname='acond'
1733  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1734  spval,varname,acond)
1735  if(debugprint)print*,'sample ',varname,' = ',acond(isa,jsa)
1736 ! mid day avg albedo
1737  varname='albdo_ave'
1738  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1739  spval,varname,avgalbedo)
1740 !$omp parallel do private(i,j)
1741  do j=jsta,jend
1742  do i=ista,iend
1743  if (avgalbedo(i,j) /= spval) avgalbedo(i,j) = avgalbedo(i,j) * 0.01
1744  enddo
1745  enddo
1746  if(debugprint)print*,'sample ',varname,' = ',avgalbedo(isa,jsa)
1747 
1748 ! surface potential T using getgb
1749  varname='tmpsfc'
1750  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1751  spval,varname,ths)
1752 
1753 ! where(ths/=spval)ths=ths*(p1000/pint(:,:,lp1))**CAPA ! convert to THS
1754 
1755 !$omp parallel do private(i,j)
1756  do j=jsta,jend
1757  do i=ista,iend
1758  if (ths(i,j) /= spval) then
1759 ! write(*,*)' i=',i,' j=',j,' ths=',ths(i,j),' pint=',pint(i,j,lp1)
1760  ths(i,j) = ths(i,j) * (p1000/pint(i,j,lp1))**capa
1761  endif
1762  qs(i,j) = spval ! GFS does not have surface specific humidity
1763  twbs(i,j) = spval ! GFS does not have inst sensible heat flux
1764  qwbs(i,j) = spval ! GFS does not have inst latent heat flux
1765 !assign sst
1766  if (sm(i,j) /= 0.0 .and. ths(i,j) < spval ) then
1767  if (sice(i,j) >= 0.15) then
1768  sst(i,j) = 271.4
1769  else
1770  sst(i,j) = ths(i,j) * (pint(i,j,lp1)/p1000)**capa
1771  endif
1772  else
1773  sst(i,j) = spval
1774  endif
1775  enddo
1776  enddo
1777  if(debugprint)print*,'sample ',varname,' = ',ths(isa,jsa)
1778 
1779 ! foundation temperature
1780  varname='tref'
1781  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1782  spval,varname,fdnsst)
1783  if(debugprint)print*,'sample ',varname,' = ',fdnsst(isa,jsa)
1784 
1785 
1786 ! GFS does not have time step and physics time step, make up ones since they
1787 ! are not really used anyway
1788 ! NPHS=1.
1789 ! DT=90.
1790 ! DTQ2 = DT * NPHS !MEB need to get physics DT
1791  dtq2 = dtp !MEB need to get physics DT
1792  nphs=1
1793  dt = dtq2/nphs !MEB need to get DT
1794  tsph = 3600./dt
1795 
1796 ! convective precip in m per physics time step using getgb
1797 ! read 3 hour bucket
1798  varname='cpratb_ave'
1799  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1800  spval,varname,avgcprate)
1801 ! where(avgcprate /= spval)avgcprate=avgcprate*dtq2/1000. ! convert to m
1802 !$omp parallel do private(i,j)
1803  do j=jsta,jend
1804  do i=ista,iend
1805  if (avgcprate(i,j) /= spval) avgcprate(i,j) = avgcprate(i,j) * (dtq2*0.001)
1806  enddo
1807  enddo
1808 ! if(debugprint)print*,'sample ',VarName,' = ',avgcprate(isa,jsa)
1809 
1810 ! print*,'maxval CPRATE: ', maxval(CPRATE)
1811 
1812 ! read continuous bucket
1813  varname='cprat_ave'
1814  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1815  spval,varname,avgcprate_cont)
1816 !$omp parallel do private(i,j)
1817  do j=jsta,jend
1818  do i=ista,iend
1819  if (avgcprate_cont(i,j) /= spval) avgcprate_cont(i,j) = &
1820  avgcprate_cont(i,j) * (dtq2*0.001)
1821  enddo
1822  enddo
1823 ! if(debugprint)print*,'sample ',VarName,' = ',avgcprate_cont(isa,jsa)
1824 
1825 ! print*,'maxval CPRATE: ', maxval(CPRATE)
1826 
1827 ! precip rate in m per physics time step using getgb
1828  varname='prateb_ave'
1829  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1830  spval,varname,avgprec)
1831 !$omp parallel do private(i,j)
1832  do j=jsta,jend
1833  do i=ista,iend
1834  if(avgprec(i,j) /= spval)avgprec(i,j)=avgprec(i,j)*(dtq2*0.001)
1835  enddo
1836  enddo
1837 
1838  if(debugprint)print*,'sample ',varname,' = ',avgprec(isa,jsa)
1839 
1840 ! prec = avgprec !set avg cprate to inst one to derive other fields
1841 
1842  varname='prate_ave'
1843  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1844  spval,varname,avgprec_cont)
1845 ! where(avgprec /= spval)avgprec=avgprec*dtq2/1000. ! convert to m
1846 !$omp parallel do private(i,j)
1847  do j=jsta,jend
1848  do i=ista,iend
1849  if (avgprec_cont(i,j) /=spval)avgprec_cont(i,j)=avgprec_cont(i,j) &
1850  * (dtq2*0.001)
1851  enddo
1852  enddo
1853 
1854  if(debugprint)print*,'sample ',varname,' = ',avgprec_cont(isa,jsa)
1855 ! precip rate in m per physics time step
1856  varname='tprcp'
1857  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1858  spval,varname,prec)
1859 !$omp parallel do private(i,j)
1860  do j=jsta,jend
1861  do i=ista,iend
1862  if (prec(i,j) /= spval) prec(i,j)=prec(i,j)* (dtq2*0.001) &
1863  * 1000. / dtp
1864  enddo
1865  enddo
1866 
1867 ! convective precip rate in m per physics time step
1868  varname='cnvprcp'
1869  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1870  spval,varname,cprate)
1871 !set cprate as 0.
1872  do j=jsta,jend
1873  do i=ista,iend
1874  if (cprate(i,j) /= spval) then
1875  cprate(i,j) = max(0.,cprate(i,j)) * (dtq2*0.001) &
1876  * 1000. / dtp
1877  else
1878  cprate(i,j) = 0.
1879  endif
1880  enddo
1881  enddo
1882 
1883 ! GFS does not have accumulated total, gridscale, and convective precip, will use inst precip to derive in SURFCE.f
1884 
1885 ! max hourly surface precipitation rate
1886  varname='pratemax'
1887  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1888  spval,varname,prate_max)
1889  if(debugprint)print*,'sample ',varname,' = ',prate_max(isa,jsa)
1890 ! max hourly 1-km agl reflectivity
1891  varname='refdmax'
1892  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1893  spval,varname,refd_max)
1894  if(debugprint)print*,'sample ',varname,' = ',refd_max(isa,jsa)
1895 ! max hourly -10C reflectivity
1896  varname='refdmax263k'
1897  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1898  spval,varname,refdm10c_max)
1899  if(debugprint)print*,'sample ',varname,' = ',refdm10c_max(isa,jsa)
1900 
1901 ! max hourly u comp of 10m agl wind
1902  varname='u10max'
1903  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1904  spval,varname,u10max)
1905  if(debugprint)print*,'sample ',varname,' = ',u10max(isa,jsa)
1906 ! max hourly v comp of 10m agl wind
1907  varname='v10max'
1908  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1909  spval,varname,v10max)
1910  if(debugprint)print*,'sample ',varname,' = ',v10max(isa,jsa)
1911 ! max hourly 10m agl wind speed
1912  varname='spd10max'
1913  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1914  spval,varname,wspd10max)
1915  if(debugprint)print*,'sample ',varname,' = ',wspd10max(isa,jsa)
1916 
1917 ! inst snow water eqivalent using nemsio
1918  varname='weasd'
1919  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1920  spval,varname,sno)
1921 ! mask water areas
1922 !$omp parallel do private(i,j)
1923  do j=jsta,jend
1924  do i=ista,iend
1925  if (sm(i,j) == 1.0 .and. sice(i,j)==0.) sno(i,j) = spval
1926  enddo
1927  enddo
1928  if(debugprint)print*,'sample ',varname,' = ',sno(isa,jsa)
1929 
1930 ! ave snow cover
1931  varname='snowc_ave'
1932  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1933  spval,varname,snoavg)
1934 ! snow cover is multipled by 100 in SURFCE before writing it out
1935  do j=jsta,jend
1936  do i=ista,iend
1937  if (sm(i,j)==1.0 .and. sice(i,j)==0.) snoavg(i,j)=spval
1938  if(snoavg(i,j)/=spval)snoavg(i,j)=snoavg(i,j)/100.
1939  end do
1940  end do
1941 
1942 ! snow depth in mm using nemsio
1943  varname='snod'
1944  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1945  spval,varname,si)
1946 !$omp parallel do private(i,j)
1947  do j=jsta,jend
1948  do i=ista,iend
1949  if (sm(i,j)==1.0 .and. sice(i,j)==0.) si(i,j)=spval
1950  if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0
1951  cldefi(i,j) = spval ! GFS does not have convective cloud efficiency
1952  lspa(i,j) = spval ! GFS does not have similated precip
1953  th10(i,j) = spval ! GFS does not have 10 m theta
1954  th10(i,j) = spval ! GFS does not have 10 m theta
1955  q10(i,j) = spval ! GFS does not have 10 m humidity
1956  albase(i,j) = spval ! GFS does not have snow free albedo
1957  enddo
1958  enddo
1959  if(debugprint)print*,'sample ',varname,' = ',si(isa,jsa)
1960 
1961 ! 2m T using nemsio
1962  varname='tmp2m'
1963  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1964  spval,varname,tshltr)
1965  if(debugprint)print*,'sample ',varname,' = ',tshltr(isa,jsa)
1966 
1967 ! GFS does not have 2m pres, estimate it, also convert t to theta
1968  Do j=jsta,jend
1969  Do i=ista,iend
1970  pshltr(i,j)=pint(i,j,lm+1)*exp(-0.068283/tshltr(i,j))
1971  tshltr(i,j)= tshltr(i,j)*(p1000/pshltr(i,j))**capa ! convert to theta
1972 ! if (j == jm/2 .and. mod(i,50) == 0)
1973 ! + print*,'sample 2m T and P after scatter= '
1974 ! + ,i,j,tshltr(i,j),pshltr(i,j)
1975  end do
1976  end do
1977 
1978 ! 2m specific humidity using nemsio
1979  varname='spfh2m'
1980  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1981  spval,varname,qshltr)
1982  if(debugprint)print*,'sample ',varname,' = ',qshltr(isa,jsa)
1983 
1984 ! time averaged column cloud fractionusing nemsio
1985  varname='tcdc_aveclm'
1986  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
1987  spval,varname,avgtcdc)
1988 ! where(avgtcdc /= spval)avgtcdc=avgtcdc/100. ! convert to fraction
1989 !$omp parallel do private(i,j)
1990  do j=jsta,jend
1991  do i=ista,iend
1992  if (avgtcdc(i,j) /= spval) avgtcdc(i,j) = avgtcdc(i,j) * 0.01
1993  enddo
1994  enddo
1995  if(debugprint)print*,'sample ',varname,' = ',avgtcdc(isa,jsa)
1996 
1997 ! GFS probably does not use zenith angle
1998 !$omp parallel do private(i,j)
1999  do j=jsta_2l,jend_2u
2000  do i=ista_2l,iend_2u
2001  czen(i,j) = spval
2002  czmean(i,j) = spval
2003  enddo
2004  enddo
2005 
2006 ! maximum snow albedo in fraction using nemsio
2007  varname='snoalb'
2008  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2009  spval,varname,mxsnal)
2010 
2011 ! land fraction
2012  varname='lfrac'
2013  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2014  spval,varname,landfrac)
2015 
2016 ! GFS probably does not use sigt4, set it to sig*t^4
2017 !$omp parallel do private(i,j,tlmh)
2018  Do j=jsta,jend
2019  Do i=ista,iend
2020  tlmh = t(i,j,lm) * t(i,j,lm)
2021  sigt4(i,j) = 5.67e-8 * tlmh * tlmh
2022  End do
2023  End do
2024 
2025 ! TG is not used, skip it for now
2026 
2027 ! GFS does not have inst cloud fraction for high, middle, and low cloud
2028 !$omp parallel do private(i,j)
2029  do j=jsta_2l,jend_2u
2030  do i=ista_2l,iend_2u
2031  cfrach(i,j) = spval
2032  cfracl(i,j) = spval
2033  cfracm(i,j) = spval
2034  enddo
2035  enddo
2036 
2037 ! ave high cloud fraction using nemsio
2038  varname='tcdc_avehcl'
2039  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2040  spval,varname,avgcfrach)
2041 ! where(avgcfrach /= spval)avgcfrach=avgcfrach/100. ! convert to fraction
2042 !$omp parallel do private(i,j)
2043  do j=jsta,jend
2044  do i=ista,iend
2045  if (avgcfrach(i,j) /= spval) avgcfrach(i,j) = avgcfrach(i,j) * 0.01
2046  enddo
2047  enddo
2048  if(debugprint)print*,'sample ',varname,' = ',avgcfrach(isa,jsa)
2049 
2050 ! ave low cloud fraction using nemsio
2051  varname='tcdc_avelcl'
2052  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2053  spval,varname,avgcfracl)
2054 ! where(avgcfracl /= spval)avgcfracl=avgcfracl/100. ! convert to fraction
2055 !$omp parallel do private(i,j)
2056  do j=jsta,jend
2057  do i=ista,iend
2058  if (avgcfracl(i,j) /= spval) avgcfracl(i,j) = avgcfracl(i,j) * 0.01
2059  enddo
2060  enddo
2061  if(debugprint)print*,'sample ',varname,' = ',avgcfracl(isa,jsa)
2062 
2063 ! ave middle cloud fraction using nemsio
2064  varname='tcdc_avemcl'
2065  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2066  spval,varname,avgcfracm)
2067 ! where(avgcfracm /= spval)avgcfracm=avgcfracm/100. ! convert to fraction
2068 !$omp parallel do private(i,j)
2069  do j=jsta,jend
2070  do i=ista,iend
2071  if (avgcfracm(i,j) /= spval) avgcfracm(i,j) = avgcfracm(i,j) * 0.01
2072  enddo
2073  enddo
2074  if(debugprint)print*,'sample ',varname,' = ',avgcfracm(isa,jsa)
2075 
2076 ! inst convective cloud fraction using nemsio
2077  varname='tcdccnvcl'
2078  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2079  spval,varname,cnvcfr)
2080 ! where(cnvcfr /= spval)cnvcfr=cnvcfr/100. ! convert to fraction
2081 !$omp parallel do private(i,j)
2082  do j=jsta,jend
2083  do i=ista,iend
2084  if (cnvcfr(i,j) /= spval) cnvcfr(i,j)= cnvcfr(i,j) * 0.01
2085  enddo
2086  enddo
2087 ! if(debugprint)print*,'sample ',VarName,' = ',cnvcfr(isa,jsa)
2088 
2089 ! slope type using nemsio
2090  varname='sltyp'
2091  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2092  spval,varname,buf)
2093 !$omp parallel do private(i,j)
2094  do j = jsta_2l, jend_2u
2095  do i=ista,iend
2096  if (buf(i,j) < spval) then
2097  islope(i,j) = nint(buf(i,j))
2098  else
2099  islope(i,j) = 0
2100  endif
2101  enddo
2102  enddo
2103 ! if(debugprint)print*,'sample ',VarName,' = ',islope(isa,jsa)
2104 
2105 ! plant canopy sfc wtr in m
2106  varname='cnwat'
2107  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2108  spval,varname,cmc)
2109 !$omp parallel do private(i,j)
2110  do j=jsta,jend
2111  do i=ista,iend
2112  if (cmc(i,j) /= spval) cmc(i,j) = cmc(i,j) * 0.001
2113  if (sm(i,j) /= 0.0) cmc(i,j) = spval
2114  enddo
2115  enddo
2116 ! if(debugprint)print*,'sample ',VarName,' = ',cmc(isa,jsa)
2117 
2118 !$omp parallel do private(i,j)
2119  do j=jsta_2l,jend_2u
2120  do i=ista_2l,iend_2u
2121  grnflx(i,j) = spval ! GFS does not have inst ground heat flux
2122  enddo
2123  enddo
2124 
2125 ! frozen precip fraction using nemsio
2126  varname='cpofp'
2127  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2128  spval,varname,sr)
2129 !$omp parallel do private(i,j)
2130  do j=jsta,jend
2131  do i=ista,iend
2132  if(sr(i,j) /= spval) then
2133 !set range within (0,1)
2134  sr(i,j)=min(1.,max(0.,sr(i,j)))
2135  endif
2136  enddo
2137  enddo
2138 
2139 ! sea ice skin temperature
2140  varname='tisfc'
2141  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2142  spval,varname,ti)
2143 !$omp parallel do private(i,j)
2144  do j=jsta,jend
2145  do i=ista,iend
2146  if (sice(i,j) == spval .or. sice(i,j) == 0.) ti(i,j)=spval
2147  enddo
2148  enddo
2149 
2150 ! vegetation fraction in fraction. using nemsio
2151  varname='veg'
2152  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2153  spval,varname,vegfrc)
2154 !$omp parallel do private(i,j)
2155  do j=jsta,jend
2156  do i=ista,iend
2157  if (vegfrc(i,j) /= spval) then
2158  vegfrc(i,j) = vegfrc(i,j) * 0.01
2159  else
2160  vegfrc(i,j) = 0.0
2161  endif
2162  enddo
2163  enddo
2164 ! mask water areas
2165 !$omp parallel do private(i,j)
2166  do j=jsta,jend
2167  do i=ista,iend
2168  if (sm(i,j) /= 0.0) vegfrc(i,j) = spval
2169  enddo
2170  enddo
2171 ! if(debugprint)print*,'sample ',VarName,' = ',vegfrc(isa,jsa)
2172 
2173 ! GFS doesn not yet output soil layer thickness, assign SLDPTH to be the same as nam
2174 
2175  sldpth(1) = 0.10
2176  sldpth(2) = 0.3
2177  sldpth(3) = 0.6
2178  sldpth(4) = 1.0
2179 
2180 ! Eric James, 1 Oct 2021: Because FV3 does not have 1d var "zs", used to
2181 ! assign soil depths for RUC LSM, hard wire 9 soil depths here
2182 ! so they aren't missing.
2183 
2184  IF (nsoil==9) THEN
2185  sllevel(1) = 0.0
2186  sllevel(2) = 0.01
2187  sllevel(3) = 0.04
2188  sllevel(4) = 0.1
2189  sllevel(5) = 0.3
2190  sllevel(6) = 0.6
2191  sllevel(7) = 1.0
2192  sllevel(8) = 1.6
2193  sllevel(9) = 3.0
2194  END IF
2195 
2196 ! liquid volumetric soil mpisture in fraction using nemsio
2197  varname='soill1'
2198  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2199  spval,varname,sh2o(ista_2l,jsta_2l,1))
2200 ! mask water areas
2201 !$omp parallel do private(i,j)
2202  do j=jsta,jend
2203  do i=ista,iend
2204  if (sm(i,j) /= 0.0) sh2o(i,j,1) = spval
2205  enddo
2206  enddo
2207  if(debugprint)print*,'sample l',varname,' = ',1,sh2o(isa,jsa,1)
2208 
2209  varname='soill2'
2210  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2211  spval,varname,sh2o(ista_2l,jsta_2l,2))
2212 ! mask water areas
2213 !$omp parallel do private(i,j)
2214  do j=jsta,jend
2215  do i=ista,iend
2216  if (sm(i,j) /= 0.0) sh2o(i,j,2) = spval
2217  enddo
2218  enddo
2219  if(debugprint)print*,'sample l',varname,' = ',1,sh2o(isa,jsa,2)
2220 
2221  varname='soill3'
2222  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2223  spval,varname,sh2o(ista_2l,jsta_2l,3))
2224 ! mask water areas
2225 !$omp parallel do private(i,j)
2226  do j=jsta,jend
2227  do i=ista,iend
2228  if (sm(i,j) /= 0.0) sh2o(i,j,3) = spval
2229  enddo
2230  enddo
2231  if(debugprint)print*,'sample l',varname,' = ',1,sh2o(isa,jsa,3)
2232 
2233  varname='soill4'
2234  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2235  spval,varname,sh2o(ista_2l,jsta_2l,4))
2236 ! mask water areas
2237 !$omp parallel do private(i,j)
2238  do j=jsta,jend
2239  do i=ista,iend
2240  if (sm(i,j) /= 0.0) sh2o(i,j,4) = spval
2241  enddo
2242  enddo
2243  if(debugprint)print*,'sample l',varname,' = ',1,sh2o(isa,jsa,4)
2244 
2245 ! volumetric soil moisture using nemsio
2246  varname='soilw1'
2247  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2248  spval,varname,smc(ista_2l,jsta_2l,1))
2249 ! mask water areas
2250 !$omp parallel do private(i,j)
2251  do j=jsta,jend
2252  do i=ista,iend
2253  if (sm(i,j) /= 0.0) smc(i,j,1) = spval
2254  enddo
2255  enddo
2256  if(debugprint)print*,'sample l',varname,' = ',1,smc(isa,jsa,1)
2257 
2258  varname='soilw2'
2259  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2260  spval,varname,smc(ista_2l,jsta_2l,2))
2261 ! mask water areas
2262 !$omp parallel do private(i,j)
2263  do j=jsta,jend
2264  do i=ista,iend
2265  if (sm(i,j) /= 0.0) smc(i,j,2) = spval
2266  enddo
2267  enddo
2268  if(debugprint)print*,'sample l',varname,' = ',1,smc(isa,jsa,2)
2269 
2270  varname='soilw3'
2271  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2272  spval,varname,smc(ista_2l,jsta_2l,3))
2273 ! mask water areas
2274 !$omp parallel do private(i,j)
2275  do j=jsta,jend
2276  do i=ista,iend
2277  if (sm(i,j) /= 0.0) smc(i,j,3) = spval
2278  enddo
2279  enddo
2280  if(debugprint)print*,'sample l',varname,' = ',1,smc(isa,jsa,3)
2281 
2282  varname='soilw4'
2283  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2284  spval,varname,smc(ista_2l,jsta_2l,4))
2285 ! mask water areas
2286 !$omp parallel do private(i,j)
2287  do j=jsta,jend
2288  do i=ista,iend
2289  if (sm(i,j) /= 0.0) smc(i,j,4) = spval
2290  enddo
2291  enddo
2292  if(debugprint)print*,'sample l',varname,' = ',1,smc(isa,jsa,4)
2293 
2294  IF (nsoil==9) THEN
2295 
2296  varname='soilw5'
2297  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2298  spval,varname,smc(ista_2l,jsta_2l,5))
2299 ! mask water areas
2300 !$omp parallel do private(i,j)
2301  do j=jsta,jend
2302  do i=ista,iend
2303  if (sm(i,j) /= 0.0) smc(i,j,5) = spval
2304  enddo
2305  enddo
2306  if(debugprint)print*,'sample l',varname,' = ',1,smc(isa,jsa,5)
2307 
2308  varname='soilw6'
2309  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2310  spval,varname,smc(ista_2l,jsta_2l,6))
2311 ! mask water areas
2312 !$omp parallel do private(i,j)
2313  do j=jsta,jend
2314  do i=ista,iend
2315  if (sm(i,j) /= 0.0) smc(i,j,6) = spval
2316  enddo
2317  enddo
2318  if(debugprint)print*,'sample l',varname,' = ',1,smc(isa,jsa,6)
2319 
2320  varname='soilw7'
2321  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2322  spval,varname,smc(ista_2l,jsta_2l,7))
2323 ! mask water areas
2324 !$omp parallel do private(i,j)
2325  do j=jsta,jend
2326  do i=ista,iend
2327  if (sm(i,j) /= 0.0) smc(i,j,7) = spval
2328  enddo
2329  enddo
2330  if(debugprint)print*,'sample l',varname,' = ',1,smc(isa,jsa,7)
2331 
2332  varname='soilw8'
2333  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2334  spval,varname,smc(ista_2l,jsta_2l,8))
2335 ! mask water areas
2336 !$omp parallel do private(i,j)
2337  do j=jsta,jend
2338  do i=ista,iend
2339  if (sm(i,j) /= 0.0) smc(i,j,8) = spval
2340  enddo
2341  enddo
2342  if(debugprint)print*,'sample l',varname,' = ',1,smc(isa,jsa,8)
2343 
2344  varname='soilw9'
2345  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2346  spval,varname,smc(ista_2l,jsta_2l,9))
2347 ! mask water areas
2348 !$omp parallel do private(i,j)
2349  do j=jsta,jend
2350  do i=ista,iend
2351  if (sm(i,j) /= 0.0) smc(i,j,9) = spval
2352  enddo
2353  enddo
2354  if(debugprint)print*,'sample l',varname,' = ',1,smc(isa,jsa,9)
2355 
2356  END IF
2357 
2358 ! soil temperature using nemsio
2359  varname='soilt1'
2360  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2361  spval,varname,stc(ista_2l,jsta_2l,1))
2362 ! mask open water areas, combine with sea ice tmp
2363 !$omp parallel do private(i,j)
2364  do j=jsta,jend
2365  do i=ista,iend
2366  if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,1) = spval
2367  !if (sm(i,j) /= 0.0) stc(i,j,1) = spval
2368  enddo
2369  enddo
2370  if(debugprint)print*,'sample l','stc',' = ',1,stc(isa,jsa,1)
2371 
2372  varname='soilt2'
2373  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2374  spval,varname,stc(ista_2l,jsta_2l,2))
2375 ! mask open water areas, combine with sea ice tmp
2376 !$omp parallel do private(i,j)
2377  do j=jsta,jend
2378  do i=ista,iend
2379  if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,2) = spval
2380  !if (sm(i,j) /= 0.0) stc(i,j,2) = spval
2381  enddo
2382  enddo
2383  if(debugprint)print*,'sample stc = ',1,stc(isa,jsa,2)
2384 
2385  varname='soilt3'
2386  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2387  spval,varname,stc(ista_2l,jsta_2l,3))
2388 ! mask open water areas, combine with sea ice tmp
2389 !$omp parallel do private(i,j)
2390  do j=jsta,jend
2391  do i=ista,iend
2392  if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,3) = spval
2393  !if (sm(i,j) /= 0.0) stc(i,j,3) = spval
2394  enddo
2395  enddo
2396  if(debugprint)print*,'sample stc = ',1,stc(isa,jsa,3)
2397 
2398  varname='soilt4'
2399  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2400  spval,varname,stc(ista_2l,jsta_2l,4))
2401 ! mask open water areas, combine with sea ice tmp
2402 !$omp parallel do private(i,j)
2403  do j=jsta,jend
2404  do i=ista,iend
2405  if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,4) = spval
2406  !if (sm(i,j) /= 0.0) stc(i,j,4) = spval
2407  enddo
2408  enddo
2409  if(debugprint)print*,'sample stc = ',1,stc(isa,jsa,4)
2410 
2411  IF (nsoil==9) THEN
2412 
2413  varname='soilt5'
2414  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2415  spval,varname,stc(ista_2l,jsta_2l,5))
2416 ! mask open water areas, combine with sea ice tmp
2417 !$omp parallel do private(i,j)
2418  do j=jsta,jend
2419  do i=ista,iend
2420  if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,5) = spval
2421  !if (sm(i,j) /= 0.0) stc(i,j,5) = spval
2422  enddo
2423  enddo
2424  if(debugprint)print*,'sample stc = ',1,stc(isa,jsa,5)
2425 
2426  varname='soilt6'
2427  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2428  spval,varname,stc(ista_2l,jsta_2l,6))
2429 ! mask open water areas, combine with sea ice tmp
2430 !$omp parallel do private(i,j)
2431  do j=jsta,jend
2432  do i=ista,iend
2433  if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,6) = spval
2434  !if (sm(i,j) /= 0.0) stc(i,j,6) = spval
2435  enddo
2436  enddo
2437  if(debugprint)print*,'sample stc = ',1,stc(isa,jsa,6)
2438 
2439  varname='soilt7'
2440  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2441  spval,varname,stc(ista_2l,jsta_2l,7))
2442 ! mask open water areas, combine with sea ice tmp
2443 !$omp parallel do private(i,j)
2444  do j=jsta,jend
2445  do i=ista,iend
2446  if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,7) = spval
2447  !if (sm(i,j) /= 0.0) stc(i,j,7) = spval enddo
2448  enddo
2449  enddo
2450  if(debugprint)print*,'sample stc = ',1,stc(isa,jsa,7)
2451 
2452  varname='soilt8'
2453  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2454  spval,varname,stc(ista_2l,jsta_2l,8))
2455 ! mask open water areas, combine with sea ice tmp
2456 !$omp parallel do private(i,j)
2457  do j=jsta,jend
2458  do i=ista,iend
2459  if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,8) = spval
2460  !if (sm(i,j) /= 0.0) stc(i,j,8) = spval
2461  enddo
2462  enddo
2463  if(debugprint)print*,'sample stc = ',1,stc(isa,jsa,8)
2464 
2465  varname='soilt9'
2466  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2467  spval,varname,stc(ista_2l,jsta_2l,9))
2468 ! mask open water areas, combine with sea ice tmp
2469 !$omp parallel do private(i,j)
2470  do j=jsta,jend
2471  do i=ista,iend
2472  if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) stc(i,j,9) = spval
2473  !if (sm(i,j) /= 0.0) stc(i,j,9) = spval
2474  enddo
2475  enddo
2476  if(debugprint)print*,'sample stc = ',1,stc(isa,jsa,9)
2477 
2478  END IF
2479 !
2480 ! E. James - 27 Sep 2022: this is for RRFS, adding smoke and dust
2481 ! extinction; it needs to be after ZINT is defined.
2482 !
2483  if (modelname == 'FV3R') then
2484  do l = 1, lm
2485  do j = jsta_2l, jend_2u
2486  do i = ista_2l, iend_2u
2487  if(ext550(i,j,l)<spval)then
2488  taod5503d( i, j, l) = ext550( i, j, l )
2489  dz = zint( i, j, l ) - zint( i, j, l+1 )
2490  aextc55( i, j, l ) = taod5503d( i, j, l ) / dz
2491  endif
2492  if(debugprint.and.i==im/2.and.j==(jsta+jend)/2)print*,'sample taod5503d= ', &
2493  i,j,l,taod5503d( i, j, l )
2494  if(debugprint.and.i==im/2.and.j==(jsta+jend)/2)print*,'sample dz= ', &
2495  dz
2496  if(debugprint.and.i==im/2.and.j==(jsta+jend)/2)print*,'sample AEXTC55= ', &
2497  i,j,l,aextc55( i, j, l )
2498  end do
2499  end do
2500  end do
2501  deallocate(ext550)
2502  end if
2503 
2504 !$omp parallel do private(i,j)
2505  do j=jsta,jend
2506  do i=ista,iend
2507  acfrcv(i,j) = spval ! GFS does not output time averaged convective and strat cloud fraction, set acfrcv to spval, ncfrcv to 1
2508  ncfrcv(i,j) = 1.0
2509  acfrst(i,j) = spval ! GFS does not output time averaged cloud fraction, set acfrst to spval, ncfrst to 1
2510  ncfrst(i,j) = 1.0
2511  bgroff(i,j) = spval ! GFS does not have UNDERGROUND RUNOFF
2512  enddo
2513  enddo
2514 ! trdlw(i,j) = 6.0
2515  ardlw = 1.0 ! GFS incoming sfc longwave has been averaged over 6 hr bucket, set ARDLW to 1
2516 
2517 ! time averaged incoming sfc longwave
2518  varname='dlwrf_ave'
2519  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2520  spval,varname,alwin)
2521 
2522 ! inst incoming sfc longwave
2523  varname='dlwrf'
2524  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2525  spval,varname,rlwin)
2526 
2527 ! time averaged outgoing sfc longwave
2528  varname='ulwrf_ave'
2529  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2530  spval,varname,alwout)
2531 
2532 ! inst outgoing sfc longwave
2533  varname='ulwrf'
2534  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2535  spval,varname,radot)
2536 
2537 ! where(alwout /= spval) alwout=-alwout ! CLDRAD puts a minus sign before gribbing
2538 !$omp parallel do private(i,j)
2539  do j=jsta,jend
2540  do i=ista,iend
2541  if (alwout(i,j) /= spval) alwout(i,j) = -alwout(i,j)
2542  enddo
2543  enddo
2544 ! if(debugprint)print*,'sample l',VarName,' = ',1,alwout(isa,jsa)
2545 
2546 ! time averaged outgoing model top longwave using gfsio
2547  varname='ulwrf_avetoa'
2548  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2549  spval,varname,alwtoa)
2550 ! if(debugprint)print*,'sample l',VarName,' = ',1,alwtoa(isa,jsa)
2551 
2552 ! instant outgoing model top longwave
2553  varname='ulwrf_toa'
2554  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2555  spval,varname,rlwtoa)
2556 ! if(debugprint)print*,'sample l',VarName,' = ',1,rlwtoa(isa,jsa)
2557 
2558 ! GFS incoming sfc longwave has been averaged, set ARDLW to 1
2559  ardsw=1.0
2560 ! trdsw=6.0
2561 
2562 ! time averaged incoming sfc shortwave
2563  varname='dswrf_ave'
2564  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2565  spval,varname,aswin)
2566 ! if(debugprint)print*,'sample l',VarName,' = ',1,aswin(isa,jsa)
2567 
2568 ! inst incoming sfc shortwave
2569  varname='dswrf'
2570  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2571  spval,varname,rswin)
2572 
2573 ! inst incoming clear sky sfc shortwave
2574 ! FV3 do not output instant incoming clear sky sfc shortwave
2575  !$omp parallel do private(i,j)
2576  do j=jsta_2l,jend_2u
2577  do i=ista_2l,iend_2u
2578  rswinc(i,j) = spval
2579  enddo
2580  enddo
2581 
2582 ! time averaged incoming sfc uv-b using getgb
2583  varname='duvb_ave'
2584  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2585  spval,varname,auvbin)
2586 ! if(debugprint)print*,'sample l',VarName,' = ',1,auvbin(isa,jsa)
2587 
2588 ! time averaged incoming sfc clear sky uv-b using getgb
2589  varname='cduvb_ave'
2590  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2591  spval,varname,auvbinc)
2592 ! if(debugprint)print*,'sample l',VarName,' = ',1,auvbinc(isa,jsa)
2593 
2594 ! time averaged outgoing sfc shortwave using gfsio
2595  varname='uswrf_ave'
2596  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2597  spval,varname,aswout)
2598 ! where(aswout /= spval) aswout=-aswout ! CLDRAD puts a minus sign before gribbing
2599 !$omp parallel do private(i,j)
2600  do j=jsta,jend
2601  do i=ista,iend
2602  if (aswout(i,j) /= spval) aswout(i,j) = -aswout(i,j)
2603  enddo
2604  enddo
2605 ! if(debugprint)print*,'sample l',VarName,' = ',1,aswout(isa,jsa)
2606 
2607 ! inst outgoing sfc shortwave using gfsio
2608  varname='uswrf'
2609  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2610  spval,varname,rswout)
2611 
2612 ! time averaged model top incoming shortwave
2613  varname='dswrf_avetoa'
2614  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2615  spval,varname,aswintoa)
2616 ! if(debugprint)print*,'sample l',VarName,' = ',1,aswintoa(isa,jsa)
2617 
2618 ! time averaged model top outgoing shortwave
2619  varname='uswrf_avetoa'
2620  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2621  spval,varname,aswtoa)
2622 ! if(debugprint)print*,'sample l',VarName,' = ',1,aswtoa(isa,jsa)
2623 
2624 ! time averaged surface sensible heat flux, multiplied by -1 because wrf model flux
2625 ! has reversed sign convention using gfsio
2626  varname='shtfl_ave'
2627  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2628  spval,varname,sfcshx)
2629 ! where (sfcshx /= spval)sfcshx=-sfcshx
2630 !$omp parallel do private(i,j)
2631  do j=jsta,jend
2632  do i=ista,iend
2633  if (sfcshx(i,j) /= spval) sfcshx(i,j) = -sfcshx(i,j)
2634  enddo
2635  enddo
2636 ! if(debugprint)print*,'sample l',VarName,' = ',1,sfcshx(isa,jsa)
2637 
2638 ! inst surface sensible heat flux
2639  varname='shtfl'
2640  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2641  spval,varname,twbs)
2642 !$omp parallel do private(i,j)
2643  do j=jsta,jend
2644  do i=ista,iend
2645  if (twbs(i,j) /= spval) twbs(i,j) = -twbs(i,j)
2646  enddo
2647  enddo
2648 
2649 ! GFS surface flux has been averaged, set ASRFC to 1
2650  asrfc=1.0
2651 ! tsrfc=6.0
2652 
2653 ! time averaged surface latent heat flux, multiplied by -1 because wrf model flux
2654 ! has reversed sign vonvention using gfsio
2655  varname='lhtfl_ave'
2656  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2657  spval,varname,sfclhx)
2658 ! where (sfclhx /= spval)sfclhx=-sfclhx
2659 !$omp parallel do private(i,j)
2660  do j=jsta,jend
2661  do i=ista,iend
2662  if (sfclhx(i,j) /= spval) sfclhx(i,j) = -sfclhx(i,j)
2663  enddo
2664  enddo
2665 ! if(debugprint)print*,'sample l',VarName,' = ',1,sfclhx(isa,jsa)
2666 
2667 ! inst surface latent heat flux
2668  varname='lhtfl'
2669  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2670  spval,varname,qwbs)
2671 !$omp parallel do private(i,j)
2672  do j=jsta,jend
2673  do i=ista,iend
2674  if (qwbs(i,j) /= spval) qwbs(i,j) = -qwbs(i,j)
2675  enddo
2676  enddo
2677 
2678  if(me==0)print*,'rdaod= ',rdaod
2679 ! inst aod550 optical depth
2680  if(rdaod) then
2681  varname='aod550'
2682  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2683  spval,varname,aod550)
2684 
2685  varname='du_aod550'
2686  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2687  spval,varname,du_aod550)
2688 
2689  varname='ss_aod550'
2690  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2691  spval,varname,ss_aod550)
2692 
2693  varname='su_aod550'
2694  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2695  spval,varname,su_aod550)
2696 
2697  varname='oc_aod550'
2698  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2699  spval,varname,oc_aod550)
2700 
2701  varname='bc_aod550'
2702  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2703  spval,varname,bc_aod550)
2704  end if
2705 
2706 ! time averaged ground heat flux using nemsio
2707  varname='gflux_ave'
2708  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2709  spval,varname,subshx)
2710 ! mask water areas
2711 !$omp parallel do private(i,j)
2712  do j=jsta,jend
2713  do i=ista,iend
2714  if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) subshx(i,j) = spval
2715  enddo
2716  enddo
2717 ! if(debugprint)print*,'sample l',VarName,' = ',1,subshx(isa,jsa)
2718 
2719 ! inst ground heat flux using nemsio
2720  varname='gflux'
2721  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2722  spval,varname,grnflx)
2723 ! mask water areas
2724 !$omp parallel do private(i,j)
2725  do j=jsta,jend
2726  do i=ista,iend
2727  if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) grnflx(i,j) = spval
2728  enddo
2729  enddo
2730 
2731 ! time averaged zonal momentum flux using gfsio
2732  varname='uflx_ave'
2733  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2734  spval,varname,sfcux)
2735 ! if(debugprint)print*,'sample l',VarName,' = ',1,sfcux(isa,jsa)
2736 
2737 ! time averaged meridional momentum flux using nemsio
2738  varname='vflx_ave'
2739  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2740  spval,varname,sfcvx)
2741 ! if(debugprint)print*,'sample l',VarName,' = ',1,sfcvx(isa,jsa)
2742 
2743 ! dong read in inst surface flux
2744 ! inst zonal momentum flux using gfsio
2745  varname='uflx'
2746  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2747  spval,varname,sfcuxi)
2748  if(debugprint)print*,'sample l',varname,' = ',1,sfcuxi(isa,jsa)
2749 
2750 ! inst meridional momentum flux using nemsio
2751  varname='vflx'
2752  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2753  spval,varname,sfcvxi)
2754  if(debugprint)print*,'sample l',varname,' = ',1,sfcvxi(isa,jsa)
2755 
2756 
2757 !$omp parallel do private(i,j)
2758  do j=jsta_2l,jend_2u
2759  do i=ista_2l,iend_2u
2760  sfcuvx(i,j) = spval ! GFS does not use total momentum flux
2761  enddo
2762  enddo
2763 
2764 ! time averaged zonal gravity wave stress using nemsio
2765  varname='u-gwd_ave'
2766  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2767  spval,varname,gtaux)
2768 ! if(debugprint)print*,'sample l',VarName,' = ',1,gtaux(isa,jsa)
2769 
2770 ! time averaged meridional gravity wave stress using getgb
2771  varname='v-gwd_ave'
2772  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2773  spval,varname,gtauy)
2774 ! if(debugprint)print*,'sample l',VarName,' = ',1,gtauy(isa,jsa)
2775 
2776 ! time averaged accumulated potential evaporation
2777  varname='pevpr_ave'
2778  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2779  spval,varname,avgpotevp)
2780 ! mask water areas
2781 !$omp parallel do private(i,j)
2782  do j=jsta,jend
2783  do i=ista,iend
2784  if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) avgpotevp(i,j) = spval
2785  enddo
2786  enddo
2787 ! if(debugprint)print*,'sample l',VarName,' = ',1,potevp(isa,jsa)
2788 
2789 ! inst potential evaporation
2790  varname='pevpr'
2791  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2792  spval,varname,potevp)
2793 ! mask water areas
2794 !$omp parallel do private(i,j)
2795  do j=jsta,jend
2796  do i=ista,iend
2797  if (sm(i,j) == 1.0 .and. sice(i,j) ==0.) potevp(i,j) = spval
2798  enddo
2799  enddo
2800 
2801  do l=1,lm
2802 !$omp parallel do private(i,j)
2803  do j=jsta_2l,jend_2u
2804  do i=ista_2l,iend_2u
2805 ! GFS does not have temperature tendency due to long wave radiation
2806  rlwtt(i,j,l) = spval
2807 ! GFS does not have temperature tendency due to short wave radiation
2808  rswtt(i,j,l) = spval
2809 ! GFS does not have temperature tendency due to latent heating from convection
2810  tcucn(i,j,l) = spval
2811  tcucns(i,j,l) = spval
2812 ! GFS does not have temperature tendency due to latent heating from grid scale
2813  train(i,j,l) = spval
2814  enddo
2815  enddo
2816  enddo
2817 
2818 ! set avrain to 1
2819  avrain=1.0
2820  avcnvc=1.0
2821  theat=6.0 ! just in case GFS decides to output T tendency
2822 
2823 ! 10 m u using nemsio
2824  varname='ugrd10m'
2825  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2826  spval,varname,u10)
2827 
2828  do j=jsta,jend
2829  do i=ista,iend
2830  u10h(i,j)=u10(i,j)
2831  end do
2832  end do
2833 ! if(debugprint)print*,'sample l',VarName,' = ',1,u10(isa,jsa)
2834 
2835 ! 10 m v using gfsio
2836  varname='vgrd10m'
2837  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2838  spval,varname,v10)
2839 
2840  do j=jsta,jend
2841  do i=ista,iend
2842  v10h(i,j)=v10(i,j)
2843  end do
2844  end do
2845 ! if(debugprint)print*,'sample l',VarName,' = ',1,v10(isa,jsa)
2846 
2847 ! vegetation type, it's in GFS surface file, hopefully will merge into gfsio soon
2848  varname='vtype'
2849  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2850  spval,varname,buf)
2851 ! where (buf /= spval)
2852 ! ivgtyp=nint(buf)
2853 ! elsewhere
2854 ! ivgtyp=0 !need to feed reasonable value to crtm
2855 ! end where
2856 !$omp parallel do private(i,j)
2857  do j = jsta_2l, jend_2u
2858  do i=ista,iend
2859  if (buf(i,j) < spval) then
2860  ivgtyp(i,j) = nint(buf(i,j))
2861  else
2862  ivgtyp(i,j) = 0
2863  endif
2864  enddo
2865  enddo
2866 ! if(debugprint)print*,'sample l',VarName,' = ',1,ivgtyp(isa,jsa)
2867 
2868 ! soil type, it's in GFS surface file, hopefully will merge into gfsio soon
2869  varname='sotyp'
2870  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2871  spval,varname,buf)
2872  l=1
2873 !$omp parallel do private(i,j)
2874  do j = jsta_2l, jend_2u
2875  do i=ista,iend
2876  if (buf(i,j) < spval) then
2877  isltyp(i,j) = nint(buf(i,j))
2878  else
2879  isltyp(i,j) = 0 !need to feed reasonable value to crtm
2880  endif
2881  enddo
2882  enddo
2883 ! if(debugprint)print*,'sample l',VarName,' = ',1,isltyp(isa,jsa)
2884 
2885  varname='wetness'
2886  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2887  spval,varname,buf)
2888 !$omp parallel do private(i,j)
2889  do j=jsta,jend
2890  do i=ista,iend
2891  smstav(i,j) = buf(i,j)
2892  enddo
2893  enddo
2894  varname='snacc_land'
2895  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2896  spval,varname,buf)
2897  varname='snacc_ice'
2898  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2899  spval,varname,buf2)
2900 !$omp parallel do private(i,j)
2901  do j = jsta_2l, jend_2u
2902  do i=ista,iend
2903  if(buf(i,j)<spval .and. buf2(i,j)<spval) then
2904  sndepac(i,j) = buf(i,j) + buf2(i,j)
2905  else
2906  sndepac(i,j) = spval
2907  endif
2908  enddo
2909  enddo
2910 !$omp parallel do private(i,j)
2911  do j=jsta_2l,jend_2u
2912  do i=ista_2l,iend_2u
2913 ! smstav(i,j) = spval ! GFS does not have soil moisture availability
2914 ! smstot(i,j) = spval ! GFS does not have total soil moisture
2915  sfcevp(i,j) = spval ! GFS does not have accumulated surface evaporation
2916  acsnom(i,j) = spval ! GFS does not have snow melt
2917 ! sst(i,j) = spval ! GFS does not have sst????
2918  thz0(i,j) = ths(i,j) ! GFS does not have THZ0, use THS to substitute
2919  qz0(i,j) = spval ! GFS does not output humidity at roughness length
2920  uz0(i,j) = spval ! GFS does not output u at roughness length
2921  vz0(i,j) = spval ! GFS does not output humidity at roughness length
2922  enddo
2923  enddo
2924  do l=1,lm
2925 !$omp parallel do private(i,j)
2926  do j=jsta_2l,jend_2u
2927  do i=ista_2l,iend_2u
2928  el_pbl(i,j,l) = spval ! GFS does not have mixing length
2929  exch_h(i,j,l) = spval ! GFS does not output exchange coefficient
2930  enddo
2931  enddo
2932  enddo
2933 ! if(debugprint)print*,'sample l',VarName,' = ',1,thz0(isa,jsa)
2934 
2935 ! retrieve inst convective cloud top, GFS has cloud top pressure instead of index,
2936 ! will need to modify CLDRAD.f to use pressure directly instead of index
2937 ! VarName='pres'
2938 ! VcoordName='convect-cld top'
2939 ! l=1
2940 ! if(debugprint)print*,'sample l',VarName,' = ',1,ptop(isa,jsa)
2941  varname='prescnvclt'
2942  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2943  spval,varname,ptop)
2944 
2945 
2946 !$omp parallel do private(i,j)
2947  do j=jsta,jend
2948  do i=ista,iend
2949  htop(i,j) = spval
2950  if(ptop(i,j) <= 0.0) ptop(i,j) = spval
2951  enddo
2952  enddo
2953  do j=jsta,jend
2954  do i=ista,iend
2955  if(ptop(i,j) < spval)then
2956  do l=1,lm
2957  if(ptop(i,j) <= pmid(i,j,l))then
2958  htop(i,j) = l
2959 ! if(i==ii .and. j==jj)print*,'sample ptop,pmid pmid-1,pint= ', &
2960 ! ptop(i,j),pmid(i,j,l),pmid(i,j,l-1),pint(i,j,l),htop(i,j)
2961  exit
2962  end if
2963  end do
2964  end if
2965  end do
2966  end do
2967 
2968 ! retrieve inst convective cloud bottom, GFS has cloud top pressure instead of index,
2969 ! will need to modify CLDRAD.f to use pressure directly instead of index
2970  varname='prescnvclb'
2971  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
2972  spval,varname,pbot)
2973 ! if(debugprint)print*,'sample l',VarName,VcoordName,' = ',1,pbot(isa,jsa)
2974 !$omp parallel do private(i,j)
2975  do j=jsta,jend
2976  do i=ista,iend
2977  hbot(i,j) = spval
2978  if(pbot(i,j) <= 0.0) pbot(i,j) = spval
2979  enddo
2980  enddo
2981  do j=jsta,jend
2982  do i=ista,iend
2983 ! if(.not.lb(i,j))print*,'false bitmask for pbot at '
2984 ! + ,i,j,pbot(i,j)
2985  if(pbot(i,j) < spval)then
2986  do l=lm,1,-1
2987  if(pbot(i,j) >= pmid(i,j,l)) then
2988  hbot(i,j) = l
2989 ! if(i==ii .and. j==jj)print*,'sample pbot,pmid= ', &
2990 ! pbot(i,j),pmid(i,j,l),hbot(i,j)
2991  exit
2992  end if
2993  end do
2994  end if
2995  end do
2996  end do
2997  if(debugprint)print*,'sample hbot = ',hbot(isa,jsa)
2998 ! retrieve time averaged low cloud top pressure using nemsio
2999  varname='pres_avelct'
3000  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3001  spval,varname,ptopl)
3002 ! if(debugprint)print*,'sample l',VarName,' = ',1,ptopl(isa,jsa)
3003 
3004 ! retrieve time averaged low cloud bottom pressure using nemsio
3005  varname='pres_avelcb'
3006  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3007  spval,varname,pbotl)
3008 ! if(debugprint)print*,'sample l',VarName,' = ',1,pbotl(isa,jsa)
3009 
3010 ! retrieve time averaged low cloud top temperature using nemsio
3011  varname='tmp_avelct'
3012  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3013  spval,varname,ttopl)
3014 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',1,Ttopl(isa,jsa)
3015 
3016 ! retrieve time averaged middle cloud top pressure using nemsio
3017  varname='pres_avemct'
3018  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3019  spval,varname,ptopm)
3020 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',1,ptopm(isa,jsa)
3021 
3022 ! retrieve time averaged middle cloud bottom pressure using nemsio
3023  varname='pres_avemcb'
3024  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3025  spval,varname,pbotm)
3026 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',1,pbotm(isa,jsa)
3027 
3028 ! retrieve time averaged middle cloud top temperature using nemsio
3029  varname='tmp_avemct'
3030  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3031  spval,varname,ttopm)
3032 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',1,Ttopm(isa,jsa)
3033 
3034 ! retrieve time averaged high cloud top pressure using nemsio *********
3035  varname='pres_avehct'
3036  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3037  spval,varname,ptoph)
3038 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',1,ptoph(isa,jsa)
3039 
3040 ! retrieve time averaged high cloud bottom pressure using nemsio
3041  varname='pres_avehcb'
3042  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3043  spval,varname,pboth)
3044 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',1,pboth(isa,jsa)
3045 
3046 ! retrieve time averaged high cloud top temperature using nemsio
3047  varname='tmp_avehct'
3048  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3049  spval,varname,ttoph)
3050 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',1,Ttoph(isa,jsa)
3051 
3052 ! retrieve boundary layer cloud cover using nemsio
3053  varname='tcdc_avebndcl'
3054  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3055  spval,varname,pblcfr)
3056 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', 1,pblcfr(isa,jsa)
3057 ! where (pblcfr /= spval)pblcfr=pblcfr/100. ! convert to fraction
3058 !$omp parallel do private(i,j)
3059  do j = jsta_2l, jend_2u
3060  do i=ista,iend
3061  if (pblcfr(i,j) < spval) pblcfr(i,j) = pblcfr(i,j) * 0.01
3062  enddo
3063  enddo
3064 
3065 ! retrieve cloud work function
3066  varname='cwork_aveclm'
3067  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3068  spval,varname,cldwork)
3069 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', 1,cldwork(isa,jsa)
3070 
3071 ! accumulated total (base+surface) runoff
3072  varname='watr_acc'
3073  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3074  spval,varname,runoff)
3075 ! mask water areas
3076 !$omp parallel do private(i,j)
3077  do j=jsta,jend
3078  do i=ista,iend
3079  if (sm(i,j) /= 0.0) runoff(i,j) = spval
3080  enddo
3081  enddo
3082 
3083 ! total water storage in aquifer
3084  varname='wa_acc'
3085  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3086  spval,varname,twa)
3087 ! mask water areas
3088 !$omp parallel do private(i,j)
3089  do j=jsta,jend
3090  do i=ista,iend
3091  if (sm(i,j) /= 0.0) twa(i,j) = spval
3092  enddo
3093  enddo
3094 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', 1,runoff(isa,jsa)
3095 
3096 ! accumulated evaporation of intercepted water
3097  varname='ecan_acc'
3098  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3099  spval,varname,tecan)
3100 ! mask water areas
3101 !$omp parallel do private(i,j)
3102  do j=jsta,jend
3103  do i=ista,iend
3104  if (sm(i,j) /= 0.0) tecan(i,j) = spval
3105  enddo
3106  enddo
3107 
3108 ! accumulated plant transpiration
3109  varname='etran_acc'
3110  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3111  spval,varname,tetran)
3112 ! mask water areas
3113 !$omp parallel do private(i,j)
3114  do j=jsta,jend
3115  do i=ista,iend
3116  if (sm(i,j) /= 0.0) tetran(i,j) = spval
3117  enddo
3118  enddo
3119 
3120 ! accumulated soil surface evaporation
3121  varname='edir_acc'
3122  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3123  spval,varname,tedir)
3124 ! mask water areas
3125 !$omp parallel do private(i,j)
3126  do j=jsta,jend
3127  do i=ista,iend
3128  if (sm(i,j) /= 0.0) tedir(i,j) = spval
3129  enddo
3130  enddo
3131 
3132 ! retrieve shelter max temperature using nemsio
3133  varname='t02max'
3134  if(modelname=='GFS') varname='tmax_max2m'
3135  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3136  spval,varname,maxtshltr)
3137 
3138 ! retrieve shelter min temperature using nemsio
3139  varname='t02min'
3140  if(modelname=='GFS') varname='tmin_min2m'
3141  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3142  spval,varname,mintshltr)
3143 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', &
3144 ! 1,mintshltr((ista+iend)/2,(jsta+jend)/2)
3145 
3146 ! retrieve shelter max RH
3147  varname='rh02max'
3148  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3149  spval,varname,maxrhshltr)
3150 
3151 ! retrieve shelter min temperature using nemsio
3152  varname='rh02min'
3153  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3154  spval,varname,minrhshltr)
3155 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', &
3156 ! 1,mintshltr((ista+iend)/2,(jsta+jend)/2)
3157 
3158 ! retrieve shelter max specific humidity using nemsio
3159  varname='spfhmax_max2m'
3160  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3161  spval,varname,maxqshltr)
3162 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',
3163 ! 1,maxqshltr(isa,jsa)
3164 
3165 ! retrieve shelter min temperature using nemsio
3166  varname='spfhmin_min2m'
3167  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3168  spval,varname,minqshltr)
3169 
3170 ! retrieve ice thickness using nemsio
3171  varname='icetk'
3172  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3173  spval,varname,dzice)
3174 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', 1,dzice(isa,jsa)
3175 
3176 ! retrieve wilting point using nemsio
3177  varname='wilt'
3178  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3179  spval,varname,smcwlt)
3180 ! mask water areas
3181 !$omp parallel do private(i,j)
3182  do j=jsta,jend
3183  do i=ista,iend
3184  if (sm(i,j) /= 0.0) smcwlt(i,j) = spval
3185  enddo
3186  enddo
3187 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', 1,smcwlt(isa,jsa)
3188 
3189 ! retrieve sunshine duration using nemsio
3190  varname='sunsd_acc'
3191  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3192  spval,varname,suntime)
3193 
3194 ! retrieve field capacity using nemsio
3195  varname='fldcp'
3196  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3197  spval,varname,fieldcapa)
3198 ! mask water areas
3199 !$omp parallel do private(i,j)
3200  do j=jsta,jend
3201  do i=ista,iend
3202  if (sm(i,j) /= 0.0) fieldcapa(i,j) = spval
3203  enddo
3204  enddo
3205 ! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', 1,fieldcapa(isa,jsa)
3206 
3207 ! retrieve time averaged surface visible beam downward solar flux
3208  varname='vbdsf_ave'
3209  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3210  spval,varname,avisbeamswin)
3211  vcoordname='sfc'
3212  l=1
3213 
3214 ! retrieve time averaged surface visible diffuse downward solar flux
3215  varname='vddsf_ave'
3216  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3217  spval,varname,avisdiffswin)
3218 
3219 ! retrieve time averaged surface near IR beam downward solar flux
3220  varname='nbdsf_ave'
3221  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3222  spval,varname,airbeamswin)
3223 
3224 ! retrieve time averaged surface near IR diffuse downward solar flux
3225  varname='nddsf_ave'
3226  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3227  spval,varname,airdiffswin)
3228 
3229 ! retrieve time averaged surface clear sky outgoing LW
3230  varname='csulf'
3231  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3232  spval,varname,alwoutc)
3233 
3234 ! retrieve time averaged TOA clear sky outgoing LW
3235  varname='csulftoa'
3236  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3237  spval,varname,alwtoac)
3238 
3239 ! retrieve time averaged surface clear sky outgoing SW
3240  varname='csusf'
3241  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3242  spval,varname,aswoutc)
3243 
3244 ! retrieve time averaged TOA clear sky outgoing LW
3245  varname='csusftoa'
3246  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3247  spval,varname,aswtoac)
3248 
3249 ! retrieve time averaged surface clear sky incoming LW
3250  varname='csdlf'
3251  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3252  spval,varname,alwinc)
3253 
3254 ! retrieve time averaged surface clear sky incoming SW
3255  varname='csdsf'
3256  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3257  spval,varname,aswinc)
3258 
3259 ! retrieve storm runoff using nemsio
3260  varname='ssrun_acc'
3261  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3262  spval,varname,ssroff)
3263 ! mask water areas
3264 !$omp parallel do private(i,j)
3265  do j=jsta,jend
3266  do i=ista,iend
3267  if (sm(i,j) /= 0.0) ssroff(i,j) = spval
3268  enddo
3269  enddo
3270 
3271 ! retrieve direct soil evaporation
3272  varname='evbs_ave'
3273  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3274  spval,varname,avgedir)
3275 ! mask water areas
3276 !$omp parallel do private(i,j)
3277  do j=jsta,jend
3278  do i=ista,iend
3279  if (sm(i,j) /= 0.0) avgedir(i,j) = spval
3280  enddo
3281  enddo
3282 
3283 ! retrieve CANOPY WATER EVAP
3284  varname='evcw_ave'
3285  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3286  spval,varname,avgecan)
3287 ! mask water areas
3288 !$omp parallel do private(i,j)
3289  do j=jsta,jend
3290  do i=ista,iend
3291  if (sm(i,j) /= 0.0) avgecan(i,j) = spval
3292  enddo
3293  enddo
3294 
3295 ! retrieve AVERAGED PRECIP ADVECTED HEAT FLUX
3296  varname='pah_ave'
3297  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3298  spval,varname,paha)
3299 ! mask water areas
3300 !$omp parallel do private(i,j)
3301  do j=jsta,jend
3302  do i=ista,iend
3303  if (sm(i,j) /= 0.0) paha(i,j) = spval
3304  enddo
3305  enddo
3306 
3307 ! retrieve instantaneous PRECIP ADVECTED HEAT FLUX
3308  varname='pahi'
3309  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3310  spval,varname,pahi)
3311 ! mask water areas
3312 !$omp parallel do private(i,j)
3313  do j=jsta,jend
3314  do i=ista,iend
3315  if (sm(i,j) /= 0.0) pahi(i,j) = spval
3316  enddo
3317  enddo
3318 
3319 ! retrieve PLANT TRANSPIRATION
3320  varname='trans_ave'
3321  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3322  spval,varname,avgetrans)
3323 ! mask water areas
3324 !$omp parallel do private(i,j)
3325  do j=jsta,jend
3326  do i=ista,iend
3327  if (sm(i,j) /= 0.0) avgetrans(i,j) = spval
3328  enddo
3329  enddo
3330 
3331 ! retrieve snow sublimation
3332  varname='sbsno_ave'
3333  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3334  spval,varname,avgesnow)
3335 ! mask water areas
3336 !$omp parallel do private(i,j)
3337  do j=jsta,jend
3338  do i=ista,iend
3339  if (sm(i,j)==1.0 .and. sice(i,j)==0.) avgesnow(i,j)=spval
3340  enddo
3341  enddo
3342 
3343 ! retrive total soil moisture
3344  varname='soilm'
3345  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3346  spval,varname,smstot)
3347 ! mask water areas
3348 !$omp parallel do private(i,j)
3349  do j=jsta,jend
3350  do i=ista,iend
3351  if (sm(i,j) /= 0.0) smstot(i,j) = spval
3352  enddo
3353  enddo
3354 
3355 ! retrieve snow phase change heat flux
3356  varname='snohf'
3357  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3358  spval,varname,snopcx)
3359 ! mask water areas
3360 !$omp parallel do private(i,j)
3361  do j=jsta,jend
3362  do i=ista,iend
3363  if (sm(i,j) /= 0.0) snopcx(i,j) = spval
3364  enddo
3365  enddo
3366 
3367 ! retrieve pwater
3368  varname='pwat'
3369  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3370  spval,varname,pwat)
3371 
3372 ! GFS does not have deep convective cloud top and bottom fields
3373 
3374 !$omp parallel do private(i,j)
3375  do j=jsta,jend
3376  do i=ista,iend
3377  htopd(i,j) = spval
3378  hbotd(i,j) = spval
3379  htops(i,j) = spval
3380  hbots(i,j) = spval
3381  cuppt(i,j) = spval
3382  enddo
3383  enddo
3384 
3385 
3386  print *, 'gocart_on=',gocart_on
3387  print *, 'gccpp_on=',gccpp_on
3388  print *, 'nasa_on=',nasa_on
3389  if ((gocart_on .or. gccpp_on) .and. d2d_chem) then
3390 
3391 
3392 ! retrieve dust emission fluxes
3393  do k = 1, nbin_du
3394  if ( k == 1) varname='duem001'
3395  if ( k == 2) varname='duem002'
3396  if ( k == 3) varname='duem003'
3397  if ( k == 4) varname='duem004'
3398  if ( k == 5) varname='duem005'
3399 
3400  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3401  spval,varname,chem_2d)
3402 
3403  duem(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3404  enddo
3405 
3406 ! retrieve dust sedimentation fluxes
3407  do k = 1, nbin_du
3408  if ( k == 1) varname='dust1sd'
3409  if ( k == 2) varname='dust2sd'
3410  if ( k == 3) varname='dust3sd'
3411  if ( k == 4) varname='dust4sd'
3412  if ( k == 5) varname='dust5sd'
3413  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3414  spval,varname,chem_2d)
3415  dusd(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3416  enddo
3417 
3418 ! retrieve dust dry deposition fluxes
3419  do k = 1, nbin_du
3420  if ( k == 1) varname='dust1dp'
3421  if ( k == 2) varname='dust2dp'
3422  if ( k == 3) varname='dust3dp'
3423  if ( k == 4) varname='dust4dp'
3424  if ( k == 5) varname='dust5dp'
3425  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3426  spval,varname,chem_2d)
3427  dudp(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3428  enddo
3429 
3430 ! retrieve dust wet deposition fluxes
3431  do k = 1, nbin_du
3432  if ( k == 1) varname='dust1wtl'
3433  if ( k == 2) varname='dust2wtl'
3434  if ( k == 3) varname='dust3wtl'
3435  if ( k == 4) varname='dust4wtl'
3436  if ( k == 5) varname='dust5wtl'
3437  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3438  spval,varname,chem_2d)
3439  duwt(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3440  enddo
3441 
3442 ! retrieve dust scavenging fluxes
3443  do k = 1, nbin_du
3444  if ( k == 1) varname='dust1wtc'
3445  if ( k == 2) varname='dust2wtc'
3446  if ( k == 3) varname='dust3wtc'
3447  if ( k == 4) varname='dust4wtc'
3448  if ( k == 5) varname='dust5wtc'
3449  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3450  spval,varname,chem_2d)
3451  dusv(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3452  enddo
3453 
3454 ! retrieve seasalt emission fluxes
3455  do k = 1, nbin_ss
3456  if ( k == 1) varname='ssem001'
3457  if ( k == 2) varname='ssem002'
3458  if ( k == 3) varname='ssem003'
3459  if ( k == 4) varname='ssem004'
3460  if ( k == 5) varname='ssem005'
3461  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3462  spval,varname,chem_2d)
3463  ssem(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3464  enddo
3465 
3466 ! retrieve seasalt emission fluxes
3467  do k = 1, nbin_ss
3468  if ( k == 1) varname='seas1sd'
3469  if ( k == 2) varname='seas2sd'
3470  if ( k == 3) varname='seas3sd'
3471  if ( k == 4) varname='seas4sd'
3472  if ( k == 5) varname='seas5sd'
3473  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3474  spval,varname,chem_2d)
3475  sssd(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3476  enddo
3477 
3478 ! retrieve seasalt dry deposition fluxes
3479  do k = 1, nbin_ss
3480  if ( k == 1) varname='seas1dp'
3481  if ( k == 2) varname='seas2dp'
3482  if ( k == 3) varname='seas3dp'
3483  if ( k == 4) varname='seas4dp'
3484  if ( k == 5) varname='seas5dp'
3485  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3486  spval,varname,chem_2d)
3487  ssdp(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3488  enddo
3489 
3490 ! retrieve seasalt wet deposition fluxes
3491  do k = 1, nbin_ss
3492  if ( k == 1) varname='seas1wtl'
3493  if ( k == 2) varname='seas2wtl'
3494  if ( k == 3) varname='seas3wtl'
3495  if ( k == 4) varname='seas4wtl'
3496  if ( k == 5) varname='seas5wtl'
3497  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3498  spval,varname,chem_2d)
3499  sswt(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3500  enddo
3501 
3502 ! retrieve seasalt scavenging fluxes
3503  do k = 1, nbin_ss
3504  if ( k == 1) varname='seas1wtc'
3505  if ( k == 2) varname='seas1wtc'
3506  if ( k == 3) varname='seas1wtc'
3507  if ( k == 4) varname='seas1wtc'
3508  if ( k == 5) varname='seas1wtc'
3509  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3510  spval,varname,chem_2d)
3511  sssv(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3512  enddo
3513 
3514 ! retrieve bc emission fluxes
3515  do k = 1, nbin_bc
3516  if ( k == 1) varname='bceman'
3517  if ( k == 2) varname='bcembb'
3518  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3519  spval,varname,chem_2d)
3520  bcem(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3521  enddo
3522 
3523 ! retrieve bc sedimentation fluxes
3524  do k = 1, nbin_bc
3525  if ( k == 1) varname='bc1sd'
3526  if ( k == 2) varname='bc2sd'
3527  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3528  spval,varname,chem_2d)
3529  bcsd(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3530  enddo
3531 
3532 ! retrieve bc dry deposition fluxes
3533  do k = 1, nbin_bc
3534  if ( k == 1) varname='bc1dp'
3535  if ( k == 2) varname='bc2dp'
3536  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3537  spval,varname,chem_2d)
3538  bcdp(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3539  enddo
3540 
3541 ! retrieve bc large wet deposition fluxes
3542  do k = 1, nbin_bc
3543  if ( k == 1) varname='bc1wtl'
3544  if ( k == 2) varname='bc2wtl'
3545  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3546  spval,varname,chem_2d)
3547  bcwt(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3548  enddo
3549 
3550 ! retrieve bc convective wet deposition fluxes
3551  do k = 1, nbin_bc
3552  if ( k == 1) varname='bc1wtc'
3553  if ( k == 2) varname='bc2wtc'
3554  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3555  spval,varname,chem_2d)
3556  bcsv(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3557  enddo
3558 
3559 ! retrieve oc emission fluxes
3560  do k = 1, nbin_oc
3561  if ( k == 1) varname='oceman'
3562  if ( k == 2) varname='ocembb'
3563  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3564  spval,varname,chem_2d)
3565  ocem(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3566  enddo
3567 
3568 ! retrieve oc sedimentation fluxes
3569  do k = 1, nbin_oc
3570  if ( k == 1) varname='oc1sd'
3571  if ( k == 2) varname='oc2sd'
3572  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3573  spval,varname,chem_2d)
3574  ocsd(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3575  enddo
3576 
3577 ! retrieve oc dry deposition fluxes
3578  do k = 1, nbin_oc
3579  if ( k == 1) varname='oc1dp'
3580  if ( k == 2) varname='oc2dp'
3581  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3582  spval,varname,chem_2d)
3583  ocdp(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3584  enddo
3585 
3586 ! retrieve oc large wet deposition fluxes
3587  do k = 1, nbin_oc
3588  if ( k == 1) varname='oc1wtl'
3589  if ( k == 2) varname='oc2wtl'
3590  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3591  spval,varname,chem_2d)
3592  ocwt(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3593  enddo
3594 
3595 ! retrieve oc convective wet deposition fluxes
3596  do k = 1, nbin_oc
3597  if ( k == 1) varname='oc1wtc'
3598  if ( k == 2) varname='oc2wtc'
3599  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3600  spval,varname,chem_2d)
3601  ocsv(1:im,jsta_2l:jend_2u,k)=chem_2d(1:im,jsta_2l:jend_2u)
3602  enddo
3603 
3604 ! retrieve MIE AOD
3605  varname='maod'
3606  call read_netcdf_2d_para(ncid2d,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u,&
3607  spval,varname,chem_2d)
3608  maod(1:im,jsta_2l:jend_2u)=chem_2d(1:im,jsta_2l:jend_2u)
3609 
3610  endif ! gocart_on
3611 ! done with flux file, close it for now
3612  status=nf90_close(ncid2d)
3613 ! deallocate(tmp,recname,reclevtyp,reclev)
3614 
3615 ! pos east
3616 ! call collect_loc(gdlat,dummy)
3617 ! if(me == 0)then
3618 ! latstart = nint(dummy(1,1)*gdsdegr)
3619 ! latlast = nint(dummy(im,jm)*gdsdegr)
3620 ! print*,'laststart,latlast B bcast= ',latstart,latlast,'gdsdegr=',gdsdegr,&
3621 ! 'dummy(1,1)=',dummy(1,1),dummy(im,jm),'gdlat=',gdlat(1,1)
3622 ! end if
3623 ! call mpi_bcast(latstart,1,MPI_INTEGER,0,mpi_comm_comp,irtn)
3624 ! call mpi_bcast(latlast,1,MPI_INTEGER,0,mpi_comm_comp,irtn)
3625 ! write(6,*) 'laststart,latlast,me A calling bcast=',latstart,latlast,me
3626 ! call collect_loc(gdlon,dummy)
3627 ! if(me == 0)then
3628 ! lonstart = nint(dummy(1,1)*gdsdegr)
3629 ! lonlast = nint(dummy(im,jm)*gdsdegr)
3630 ! end if
3631 ! call mpi_bcast(lonstart,1,MPI_INTEGER,0,mpi_comm_comp,irtn)
3632 ! call mpi_bcast(lonlast, 1,MPI_INTEGER,0,mpi_comm_comp,irtn)
3633 
3634 ! write(6,*)'lonstart,lonlast A calling bcast=',lonstart,lonlast
3635 !
3636 
3637 ! generate look up table for lifted parcel calculations
3638 
3639  thl = 210.
3640  plq = 70000.
3641  pt_tbl = 10000. ! this is for 100 hPa added by Moorthi
3642 
3643  CALL table(ptbl,ttbl,pt_tbl, &
3644  rdq,rdth,rdp,rdthe,pl,thl,qs0,sqs,sthe,the0)
3645 
3646  CALL tableq(ttblq,rdpq,rdtheq,plq,thl,stheq,the0q)
3647 
3648 !
3649 !
3650  IF(me == 0)THEN
3651  WRITE(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: '
3652  WRITE(6,51) (spl(l),l=1,lsm)
3653  50 FORMAT(14(f4.1,1x))
3654  51 FORMAT(8(f8.1,1x))
3655  ENDIF
3656 !
3657 !$omp parallel do private(l)
3658  DO l = 1,lsm
3659  alsl(l) = log(spl(l))
3660  END DO
3661 !
3662 !HC WRITE IGDS OUT FOR WEIGHTMAKER TO READ IN AS KGDSIN
3663  if(me == 0)then
3664  print*,'writing out igds'
3665  igdout = 110
3666 ! open(igdout,file='griddef.out',form='unformatted'
3667 ! + ,status='unknown')
3668  if(maptype == 1)THEN ! Lambert conformal
3669  WRITE(igdout)3
3670  WRITE(6,*)'igd(1)=',3
3671  WRITE(igdout)im
3672  WRITE(igdout)jm
3673  WRITE(igdout)latstart
3674  WRITE(igdout)lonstart
3675  WRITE(igdout)8
3676  WRITE(igdout)cenlon
3677  WRITE(igdout)dxval
3678  WRITE(igdout)dyval
3679  WRITE(igdout)0
3680  WRITE(igdout)64
3681  WRITE(igdout)truelat2
3682  WRITE(igdout)truelat1
3683  WRITE(igdout)255
3684  ELSE IF(maptype == 2)THEN !Polar stereographic
3685  WRITE(igdout)5
3686  WRITE(igdout)im
3687  WRITE(igdout)jm
3688  WRITE(igdout)latstart
3689  WRITE(igdout)lonstart
3690  WRITE(igdout)8
3691  WRITE(igdout)cenlon
3692  WRITE(igdout)dxval
3693  WRITE(igdout)dyval
3694  WRITE(igdout)0
3695  WRITE(igdout)64
3696  WRITE(igdout)truelat2 !Assume projection at +-90
3697  WRITE(igdout)truelat1
3698  WRITE(igdout)255
3699  ! Note: The calculation of the map scale factor at the standard
3700  ! lat/lon and the PSMAPF
3701  ! Get map factor at 60 degrees (N or S) for PS projection, which will
3702  ! be needed to correctly define the DX and DY values in the GRIB GDS
3703  if (truelat1 < 0.) THEN
3704  lat = -60.
3705  else
3706  lat = 60.
3707  end if
3708 
3709  CALL msfps(lat,truelat1*0.001,psmapf)
3710 
3711  ELSE IF(maptype == 3) THEN !Mercator
3712  WRITE(igdout)1
3713  WRITE(igdout)im
3714  WRITE(igdout)jm
3715  WRITE(igdout)latstart
3716  WRITE(igdout)lonstart
3717  WRITE(igdout)8
3718  WRITE(igdout)latlast
3719  WRITE(igdout)lonlast
3720  WRITE(igdout)truelat1
3721  WRITE(igdout)0
3722  WRITE(igdout)64
3723  WRITE(igdout)dxval
3724  WRITE(igdout)dyval
3725  WRITE(igdout)255
3726  ELSE IF(maptype == 0 .OR. maptype == 203)THEN !A STAGGERED E-GRID
3727  WRITE(igdout)203
3728  WRITE(igdout)im
3729  WRITE(igdout)jm
3730  WRITE(igdout)latstart
3731  WRITE(igdout)lonstart
3732  WRITE(igdout)136
3733  WRITE(igdout)cenlat
3734  WRITE(igdout)cenlon
3735  WRITE(igdout)dxval
3736  WRITE(igdout)dyval
3737  WRITE(igdout)64
3738  WRITE(igdout)0
3739  WRITE(igdout)0
3740  WRITE(igdout)0
3741  ELSE IF(maptype == 207)THEN !Rotated lat-lon grid
3742  write(flatlon,1001)ifhr
3743  open(112,file=trim(flatlon),form='formatted', &
3744  status='unknown')
3745  write(112,1002)latstart/1000,lonstart/1000,&
3746  latse/1000,lonse/1000,latnw/1000,lonnw/1000,&
3747  latlast/1000,lonlast/1000
3748  1001 format('latlons_corners.txt.f',i3.3)
3749  1002 format(4(i6,i7,x))
3750  close(112)
3751  END IF
3752  end if
3753 !
3754 !
3755 
3756  RETURN
3757  END
3758 
3759 
3760  subroutine read_netcdf_3d_para(ncid,im,jm,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3761  spval,varname,buf,lm)
3762 
3763  use netcdf
3764  use ctlblk_mod, only : me
3765  use params_mod, only : small
3766  implicit none
3767  include "mpif.h"
3768 
3769  character(len=20),intent(in) :: varname
3770  real,intent(in) :: spval
3771  integer,intent(in) :: ncid,im,jm,lm,jsta_2l,jend_2u,jsta,jend
3772  integer,intent(in) :: ista_2l,iend_2u,ista,iend
3773  real,intent(out) :: buf(ista_2l:iend_2u,jsta_2l:jend_2u,lm)
3774  integer :: varid,iret,ii,jj,i,j,l,kk
3775  integer :: start(3), count(3), stride(3)
3776  real,parameter :: spval_netcdf=9.99e+20
3777  real :: fill_value
3778 
3779  iret = nf90_inq_varid(ncid,trim(varname),varid)
3780  if (iret /= 0) then
3781  if (me == 0) print*,varname," not found -Assigned missing values"
3782 !$omp parallel do private(i,j,l)
3783  do l=1,lm
3784  do j=jsta,jend
3785  do i=ista,iend
3786  buf(i,j,l)=spval
3787  enddo
3788  enddo
3789  enddo
3790  else
3791  iret = nf90_get_att(ncid,varid,"_FillValue",fill_value)
3792  if (iret /= 0) fill_value = spval_netcdf
3793  start = (/ista,jsta,1/)
3794  ii=iend-ista+1
3795  jj=jend-jsta+1
3796  count = (/ii,jj,lm/)
3797  iret = nf90_get_var(ncid,varid,buf(ista:iend,jsta:jend,1:lm),start=start,count=count)
3798  if (iret /= 0) then
3799  print*," iret /=0, Error in reading varid "
3800  endif
3801  do l=1,lm
3802  do j=jsta,jend
3803  do i=ista,iend
3804  if(abs(buf(i,j,l)-fill_value)<small)buf(i,j,l)=spval
3805  end do
3806  end do
3807  end do
3808  endif
3809 
3810  end subroutine read_netcdf_3d_para
3811 
3812  subroutine read_netcdf_2d_para(ncid,ista,ista_2l,iend,iend_2u,jsta,jsta_2l,jend,jend_2u, &
3813  spval,varname,buf)
3814 
3815  use netcdf
3816  use ctlblk_mod, only : me
3817  use params_mod, only : small
3818  implicit none
3819  include "mpif.h"
3820 
3821  character(len=20),intent(in) :: varname
3822  real,intent(in) :: spval
3823  integer,intent(in) :: ncid,jsta_2l,jend_2u,jsta,jend,ista_2l,iend_2u,ista,iend
3824  real,intent(out) :: buf(ista_2l:iend_2u,jsta_2l:jend_2u)
3825  integer :: varid,iret,ii,jj,i,j,l,kk
3826  integer :: start(2), count(2)
3827  real,parameter :: spval_netcdf=9.99e+20
3828  real :: fill_value
3829 
3830  iret = nf90_inq_varid(ncid,trim(varname),varid)
3831  if (iret /= 0) then
3832  if (me==0) print*,varname," not found -Assigned missing values"
3833 !$omp parallel do private(i,j)
3834  do j=jsta,jend
3835  do i=ista,iend
3836  buf(i,j)=spval
3837  enddo
3838  enddo
3839  else
3840  iret = nf90_get_att(ncid,varid,"_FillValue",fill_value)
3841  if (iret /= 0) fill_value = spval_netcdf
3842  start = (/ista,jsta/)
3843  ii=iend-ista+1
3844  jj=jend-jsta+1
3845  count = (/ii,jj/)
3846  iret = nf90_get_var(ncid,varid,buf(ista:iend,jsta:jend),start=start,count=count)
3847  if (iret /= 0) then
3848  print*," iret /=0, Error in reading varid "
3849  endif
3850  do j=jsta,jend
3851  do i=ista,iend
3852  if(abs(buf(i,j)-fill_value)<small)buf(i,j)=spval
3853  end do
3854  end do
3855  endif
3856 
3857  end subroutine read_netcdf_2d_para
Definition: MASKS_mod.f:1
Definition: physcons.f:1
Definition: SOIL_mod.f:1
subroutine msfps(LAT, TRUELAT1, MSF)
msfps() computes the map scale factor for a polar stereographic grid at a give latitude.
Definition: MSFPS.f:26
elemental real function, public fpvsnew(t)
Definition: UPP_PHYSICS.f:378
subroutine initpost_netcdf(ncid2d, ncid3d)
This routine initializes constants and variables at the start of GFS model or post processor run...