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