118#if defined(BUILD_WITH_NEMSIO)
119 use nemsio_module,
only: nemsio_getheadvar, nemsio_gfile, nemsio_init, nemsio_open, &
120 nemsio_getfilehead,nemsio_close
122 use ctlblk_mod,
only: filenameaer, me, num_procs, num_servers, mpi_comm_comp, datestr, &
123 mpi_comm_inter, filename, ioform, grib, idat, filenameflux, filenamed3d, gdsdegr, &
124 spldef, modelname, ihrst, lsmdef,vtimeunits, tprec, pthresh, datahandle, im, jm, lm, &
125 lp1, lm1, im_jm, isf_surface_physics, nsoil, spl, lsmp1, global, imp_physics, &
126 ista, iend, ista_m, iend_m, ista_2l, iend_2u, &
127 jsta, jend, jsta_m, jend_m, jsta_2l, jend_2u, novegtype, icount_calmict, npset, datapd,&
131 readxml_tim, spval, fullmodelname, submodelname, hyb_sigp, filenameflat, aqf_on,numx, &
132 run_ifi_tim, slrutah_on, d2d_chem, gtg_on, method_blsn
133 use grib2_module,
only: gribit2,num_pset,nrecout,first_grbtbl,grib_info_finalize
134 use upp_ifi_mod,
only: write_ifi_debug_files
138#if defined(BUILD_WITH_NEMSIO)
139 type(nemsio_gfile) :: nfile,ffile,rfile
149 real(kind=8) :: time_initpost=0.,initpost_tim=0.,btim,bbtim
150 real rinc(5), untcnvt
151 integer :: status=0,iostatusd3d=0,iostatusflux=0
152 integer i,j,iii,l,k,ierr,nrec,ist,lusig,idrt,ncid3d,ncid2d,varid
153 integer :: prntsec,iim,jjm,llm,ioutcount,itmp,iret,iunit, &
154 iunitd3d,iyear,imn,iday,lcntrl,ieof
155 integer :: iostatusaer
158 integer :: kpo,kth,kpv
159 real,
dimension(komax) :: po,th,pv
160 namelist/nampgb/kpo,po,kth,th,kpv,pv,filenameaer,d3d_on,gocart_on,gccpp_on, nasa_on,gtg_on,method_blsn,popascal &
161 ,hyb_sigp,rdaod,d2d_chem, aqf_on,slrutah_on, vtimeunits,numx,write_ifi_debug_files
163 namelist/model_inputs/filename,ioform,grib,datestr,modelname,submodelname &
164 ,filenameflux,filenameflat
166 character startdate*19,sysdepinfo*80,iowrfname*3,post_fname*255
167 character cgar*1,cdum*4,line*10
193 if (me == 0)
CALL w3tagb(
'nems ',0000,0000,0000,
'np23 ')
195 if ( me >= num_procs )
then
207 filenameflat=
'postxconfig-NT.txt'
211 read(5,nml=model_inputs,iostat=itag_ierr,err=888)
212888
if (itag_ierr /= 0)
then
213 print*,
'Incorrect namelist variable(s) found in the itag file,stopping.'
216 if (me == 0)
write(6, model_inputs)
224 303
format(
'MODELNAME="',a,
'" SUBMODELNAME="',a,
'"')
226 if(me==0)
write(*,*)
'MODELNAME: ', modelname, submodelname
229 read(datestr,300) iyear,imn,iday,ihrst,imin
230 if (me==0)
write(*,*)
'in WRFPOST iyear,imn,iday,ihrst,imin', &
231 iyear,imn,iday,ihrst,imin
232 300
format(i4,1x,i2,1x,i2,1x,i2,1x,i2)
248 if(grib==
'grib2')
then
256 th = (/310.,320.,350.,450.,550.,650.,(0.,k=kth+1,komax)/)
258 pv = (/0.5,-0.5,1.0,-1.0,1.5,-1.5,2.0,-2.0,(0.,k=kpv+1,komax)/)
275 read(5,nampgb,iostat=iret,
end=119)
277 if (me == 0)
write(6, nampgb)
278 if(mod(num_procs,numx)/=0)
then
280 print*,
'total proces, num_procs=', num_procs
281 print*,
'number of subdomain in x direction, numx=', numx
282 print*,
'remainder of num_procs/numx = ', mod(num_procs,numx)
283 print*,
'Warning!!! the remainder of num_procs/numx is not 0, reset numx=1 &
284 & in this run or you adjust numx in the itag file to restart'
288 if(me == 0) print*,
'Warning!!! Reset numx as 1, numx=',numx
290 if(numx>num_procs/2)
then
292 print*,
'total proces, num_procs=', num_procs
293 print*,
'number of subdomain in x direction, numx=', numx
294 print*,
'Warning!!! numx cannot exceed num_procs/2, reset numx=1 in this run'
295 print*,
'or you adjust numx in the itag file to restart'
298 if(me == 0) print*,
'Warning!!! Reset numx as 1, numx=',numx
301 print*,
'komax,iret for nampgb= ',komax,iret
302 print*,
'komax,kpo,kth,th,kpv,pv,fileNameAER,nasa_on,popascal= ',komax,kpo &
303 & ,kth,th(1:kth),kpv,pv(1:kpv),trim(filenameaer),nasa_on,popascal
304 print*,
'NUM_PROCS=',num_procs
308 IF(trim(ioform) /=
'netcdfpara' .AND. trim(ioform) /=
'netcdf' )
THEN
310 if(me == 0) print*,
'2D decomposition only supports netcdfpara IO.'
311 if(me == 0) print*,
'Reset numx= ',numx
314 IF(modelname /=
'FV3R' .AND. modelname /=
'GFS')
THEN
316 if(me == 0) print*,
'2D decomposition only supports GFS and FV3R.'
317 if(me == 0) print*,
'Reset numx= ',numx
324 print*,
'using default pressure levels,spldef=',(spldef(l),l=1,lsmdef)
333 print*,
'using pressure levels from POSTGPVARS'
336 if( .not. popascal )
then
341 if(po(lsm) < po(1))
then
343 spl(l) = po(lsm-l+1)*untcnvt
347 spl(l) = po(l)*untcnvt
356 if(modelname ==
'NMM')
then
362 if(trim(ioform) ==
'netcdf' .OR. trim(ioform) ==
'netcdfpara')
THEN
363 IF(modelname ==
'NCAR' .OR. modelname ==
'RAPR' .OR. modelname ==
'NMM')
THEN
364 call ext_ncd_ioinit(sysdepinfo,status)
365 call ext_ncd_open_for_read( trim(filename), 0, 0,
" ", &
367 if ( status /= 0 )
then
368 print*,
'error opening ',filename,
' Status = ', status ; stop
370 call ext_ncd_get_dom_ti_integer(datahandle &
371 ,
'WEST-EAST_GRID_DIMENSION',iim,1,ioutcount, status )
373 call ext_ncd_get_dom_ti_integer(datahandle &
374 ,
'SOUTH-NORTH_GRID_DIMENSION',jjm,1,ioutcount, status )
376 call ext_ncd_get_dom_ti_integer(datahandle &
377 ,
'BOTTOM-TOP_GRID_DIMENSION',llm,1,ioutcount, status )
384 call ext_ncd_get_dom_ti_integer(datahandle &
385 ,
'SF_SURFACE_PHYSICS',itmp,1,ioutcount, status )
386 isf_surface_physics = itmp
392 ELSE IF(itmp == 3)
then
394 ELSE IF(itmp == 7)
then
398 call ext_ncd_ioclose ( datahandle, status )
402 status = nf90_open(trim(filename),ior(nf90_nowrite,nf90_mpiio), &
403 ncid3d,comm=mpi_comm_world,info=mpi_info_null)
404 if ( status /= 0 )
then
405 print*,
'error opening ',filename,
' Status = ', status
408 status = nf90_open(trim(filenameflux),ior(nf90_nowrite,nf90_mpiio), &
409 ncid2d,comm=mpi_comm_world,info=mpi_info_null)
410 if ( status /= 0 )
then
411 print*,
'error opening ',filenameflux,
' Status = ', status
415 status=nf90_get_att(ncid2d,nf90_global,
'landsfcmdl', isf_surface_physics)
417 print*,
'landsfcmdl not found; assigning to 2'
418 isf_surface_physics=2
420 if(isf_surface_physics<2)
then
421 isf_surface_physics=2
423 status=nf90_get_att(ncid2d,nf90_global,
'nsoil', nsoil)
425 print*,
'nsoil not found; assigning to 4'
429 status=nf90_get_att(ncid2d,nf90_global,
'imp_physics',imp_physics)
431 print*,
'imp_physics not found; assigning to GFDL 11'
435 status = nf90_inq_dimid(ncid3d,
'grid_xt',varid)
436 if ( status /= 0 )
then
440 status = nf90_inquire_dimension(ncid3d,varid,len=im)
441 if ( status /= 0 )
then
445 status = nf90_inq_dimid(ncid3d,
'grid_yt',varid)
446 if ( status /= 0 )
then
450 status = nf90_inquire_dimension(ncid3d,varid,len=jm)
451 if ( status /= 0 )
then
455 status = nf90_inq_dimid(ncid3d,
'pfull',varid)
456 if ( status /= 0 )
then
460 status = nf90_inquire_dimension(ncid3d,varid,len=lm)
461 if ( status /= 0 )
then
473 ELSE IF(trim(ioform) ==
'binary' .OR. &
474 trim(ioform) ==
'binarympiio' )
THEN
475 print*,
'WRF Binary format is no longer supported'
478#if defined(BUILD_WITH_NEMSIO)
479 ELSE IF(trim(ioform) ==
'binarynemsio' .or. &
480 trim(ioform) ==
'binarynemsiompiio' )
THEN
484 call nemsio_init(iret=status)
485 call nemsio_open(nfile,trim(filename),
'read',iret=status)
486 if ( status /= 0 )
then
487 print*,
'error opening ',filename,
' Status = ', status ; stop
490 call nemsio_getfilehead(nfile,iret=status,nrec=nrec &
491 ,dimx=im,dimy=jm,dimz=lm,nsoil=nsoil)
492 if ( status /= 0 )
then
493 print*,
'error finding model dimensions '; stop
495 call nemsio_getheadvar(nfile,
'global',global,iret)
497 print*,
"global not found in file-Assigned false"
500 IF(modelname ==
'GFS') global = .true.
502 if(global .and. modelname ==
'NMM') im = im-1
506 CALL mpi_bcast(im, 1,mpi_integer,0, mpi_comm_comp,status)
507 call mpi_bcast(jm, 1,mpi_integer,0, mpi_comm_comp,status)
508 call mpi_bcast(lm, 1,mpi_integer,0, mpi_comm_comp,status)
509 call mpi_bcast(nsoil,1,mpi_integer,0, mpi_comm_comp,status)
511 call mpi_bcast(global,1,mpi_logical,0,mpi_comm_comp,status)
517 IF(modelname ==
'GFS')
THEN
519 call nemsio_open(ffile,trim(filenameflux),
'read',iret=iostatusflux)
520 if ( iostatusflux /= 0 )
then
521 print*,
'error opening ',filenameflux,
' Status = ', iostatusflux
527 call nemsio_open(rfile,trim(filenameaer),
'read',iret=iostatusaer)
528 if ( iostatusaer /= 0 .and. me == 0)
then
529 print*,
'error opening AER ',filenameaer,
' Status = ', iostatusaer
537 print*,
'UNKNOWN MODEL OUTPUT FORMAT, STOPPING'
555 if(modelname ==
'GFS')
THEN
558 else if(modelname==
'NMM' .and. trim(ioform)==
'binarynemsio')
then
561 else if(modelname==
'RAPR')
then
571 IF(trim(ioform) ==
'netcdf' .OR. trim(ioform) ==
'netcdfpara')
THEN
572 IF(modelname ==
'NCAR' .OR. modelname ==
'RAPR')
THEN
574 ELSE IF (modelname ==
'FV3R' .OR. modelname ==
'GFS')
THEN
578 print*,
'POST does not have netcdf option for model,',modelname,
' STOPPING,'
581 ELSE IF(trim(ioform) ==
'binarympiio')
THEN
582 IF(modelname ==
'NCAR' .OR. modelname ==
'RAPR' .OR. modelname ==
'NMM')
THEN
583 print*,
'WRF BINARY IO FORMAT IS NO LONGER SUPPORTED, STOPPING'
585 ELSE IF(modelname ==
'RSM')
THEN
586 print*,
'MPI BINARY IO IS NOT YET INSTALLED FOR RSM, STOPPING'
589 print*,
'POST does not have mpiio option for this model, STOPPING'
592#if defined(BUILD_WITH_NEMSIO)
593 ELSE IF(trim(ioform) ==
'binarynemsio')
THEN
594 IF(modelname ==
'NMM')
THEN
597 print*,
'POST does not have nemsio option for model,',modelname,
' STOPPING,'
602 ELSE IF(trim(ioform) ==
'binarynemsiompiio')
THEN
603 IF(modelname ==
'GFS')
THEN
605 call nemsio_close(nfile,iret=status)
606 call nemsio_close(ffile,iret=status)
607 call nemsio_close(rfile,iret=status)
610 print*,
'POST does not have nemsio mpi option for model,',modelname, &
617 print*,
'UNKNOWN MODEL OUTPUT FORMAT, STOPPING'
620 initpost_tim = initpost_tim +(mpi_wtime() - btim)
622 WRITE(6,*)
'WRFPOST: INITIALIZED POST COMMON BLOCKS'
627 if(grib ==
"grib2")
then
630 readxml_tim = readxml_tim + (mpi_wtime() - btim)
638 first_grbtbl = .true.
675 if (me==0)
write(*,*)
' in WRFPOST OUTFORM= ',grib
676 if (me==0)
write(*,*)
' GRIB1 IS NOT SUPPORTED ANYMORE'
677 if (grib ==
"grib2")
then
678 do while (npset < num_pset)
680 if (me==0)
write(*,*)
' in WRFPOST npset=',npset,
' num_pset=',num_pset
682 if (me==0)
write(*,*)
' in WRFPOST size datapd',
size(datapd)
683 if(
allocated(datapd))
deallocate(datapd)
686 allocate(datapd(1:iend-ista+1,1:jend-jsta+1,nrecout+100))
697 call get_postfilename(post_fname)
698 if (me==0)
write(*,*)
'post_fname=',trim(post_fname)
699 if (me==0)
write(*,*)
'get_postfilename,post_fname=',trim(post_fname), &
700 'npset=',npset,
'num_pset=',num_pset, &
701 'iSF_SURFACE_PHYSICS=',isf_surface_physics
708 CALL process(kth,kpv,th(1:kth),pv(1:kpv),iostatusd3d)
709 IF(me == 0)
WRITE(6,*)
'WRFPOST: PREPARE TO PROCESS NEXT GRID'
712 call mpi_barrier(mpi_comm_comp,ierr)
716 call gribit2(post_fname)
727 call grib_info_finalize()
731 WRITE(6,*)
'ALL GRIDS PROCESSED.'
742 print*,
'INITPOST_tim = ', initpost_tim
743 print*,
'MDLFLD_tim = ', etafld2_tim
744 print*,
'MDL2P_tim = ',eta2p_tim
745 print*,
'MDL2SIGMA_tim = ',mdl2sigma_tim
746 print*,
'MDL2AGL_tim = ',mdl2agl_tim
747 print*,
'SURFCE_tim = ',surfce2_tim
748 print*,
'CLDRAD_tim = ',cldrad_tim
749 print*,
'MISCLN_tim = ',miscln_tim
750 print*,
'MDL2STD_tim = ',mdl2std_tim
751 print*,
'FIXED_tim = ',fixed_tim
752 print*,
'MDL2THANDPV_tim = ',mdl2thandpv_tim
753 print*,
'CALRAD_WCLOUD_tim = ',calrad_wcloud_tim
754 print*,
'RUN_IFI_tim = ',run_ifi_tim
755 print*,
'Total time = ',(mpi_wtime() - bbtim)
756 print*,
'Time for OUTPUT = ',time_output
757 print*,
'Time for READxml = ',readxml_tim
773 if (me == 0)
CALL w3tage(
'UNIFIED_POST')
774 CALL mpi_finalize(ierr)
subroutine allocate_all()
SET UP MESSGAE PASSING INFO.
subroutine de_allocate
2023-08-16 | Yali Mao | Add CIT to GTG fields.
subroutine initpost
This routine initializes constants and variables at the start of an ETA model or post processor run.
subroutine initpost_gfs_nems_mpiio(iostatusaer)
initializes constants and variables at the start of GFS model or post processor run.
subroutine initpost_nems(nrec, nfile)
INITPOST_NEMS This routine initializes constants and variables at the start of an NEMS model or post ...
subroutine initpost_netcdf(ncid2d, ncid3d)
2023-04-17 | Eric James | Read in unified ext550 extinction (and remove aodtot) for RRFS 2023-04-21 |...
subroutine mpi_first()
MPI_FIRST() Sets up message passing info (MPI).
subroutine mpi_last
SUBPROGRAM: MPI_LAST SHUTS DOWN THE IO SERVER PRGRMMR: TUCCILLO ORG: IBM.
subroutine process(kth, kpv, th, pv, iostatusd3d)
process() is a driver for major post routines.
subroutine server
SUBPROGRAM: SERVER PERFORMS IO TO DISK PRGRMMR: TUCCILLO ORG: IBM.
subroutine setup_servers(mype, npes, inumq, mpi_comm_comp, mpi_comm_inter)
This subroutine is to setup I/O servers.
subroutine set_outflds(kth, th, kpv, pv)
Reads post XML control file.
real(kind=8) etafld2_tim
Time to execute named routine; note that ETAFLD2 and ETA2P refer to MDLFLD and MDL2P routines respect...
real(kind=8) mdl2agl_tim
Time to execute named routine; note that ETAFLD2 and ETA2P refer to MDLFLD and MDL2P routines respect...
real(kind=8) surfce2_tim
Time to execute named routine; note that ETAFLD2 and ETA2P refer to MDLFLD and MDL2P routines respect...
real(kind=8) eta2p_tim
Time to execute named routine; note that ETAFLD2 and ETA2P refer to MDLFLD and MDL2P routines respect...
real(kind=8) calrad_wcloud_tim
Time to execute named routine; note that ETAFLD2 and ETA2P refer to MDLFLD and MDL2P routines respect...
real(kind=8) mdl2std_tim
Time to execute named routine; note that ETAFLD2 and ETA2P refer to MDLFLD and MDL2P routines respect...
real(kind=8) run_ifi_tim
Time to execute named routine; note that ETAFLD2 and ETA2P refer to MDLFLD and MDL2P routines respect...
real(kind=8) time_output
Initialized as 0, but never used.
real(kind=8) fixed_tim
Time to execute named routine; note that ETAFLD2 and ETA2P refer to MDLFLD and MDL2P routines respect...
real(kind=8) readxml_tim
Time to execute named routine; note that ETAFLD2 and ETA2P refer to MDLFLD and MDL2P routines respect...
real(kind=8) miscln_tim
Time to execute named routine; note that ETAFLD2 and ETA2P refer to MDLFLD and MDL2P routines respect...
real(kind=8) mdl2thandpv_tim
Time to execute named routine; note that ETAFLD2 and ETA2P refer to MDLFLD and MDL2P routines respect...
real(kind=8) cldrad_tim
Time to execute named routine; note that ETAFLD2 and ETA2P refer to MDLFLD and MDL2P routines respect...
real(kind=8) mdl2sigma_tim
Time to execute named routine; note that ETAFLD2 and ETA2P refer to MDLFLD and MDL2P routines respect...