120#if defined(BUILD_WITH_NEMSIO)
121 use nemsio_module,
only: nemsio_getheadvar, nemsio_gfile, nemsio_init, nemsio_open, &
122 nemsio_getfilehead,nemsio_close
124 use ctlblk_mod,
only: filenameaer, me, num_procs, num_servers, mpi_comm_comp, datestr, &
125 mpi_comm_inter, filename, ioform, grib, idat, filenameflux, filenamed3d, gdsdegr, &
126 spldef, modelname, ihrst, lsmdef,vtimeunits, tprec, pthresh, datahandle, im, jm, lm, &
127 lp1, lm1, im_jm, isf_surface_physics, nsoil, spl, lsmp1, global, imp_physics, &
128 ista, iend, ista_m, iend_m, ista_2l, iend_2u, &
129 jsta, jend, jsta_m, jend_m, jsta_2l, jend_2u, novegtype, icount_calmict, npset, datapd,&
133 readxml_tim, spval, fullmodelname, submodelname, hyb_sigp, filenameflat, aqf_on,numx, &
134 run_ifi_tim, slrutah_on, d2d_chem, gtg_on, method_blsn
135 use grib2_module,
only: gribit2,num_pset,nrecout,first_grbtbl,grib_info_finalize
136 use upp_ifi_mod,
only: write_ifi_debug_files
140#if defined(BUILD_WITH_NEMSIO)
141 type(nemsio_gfile) :: nfile,ffile,rfile
151 real(kind=8) :: time_initpost=0.,initpost_tim=0.,btim,bbtim
152 real rinc(5), untcnvt
153 integer :: status=0,iostatusd3d=0,iostatusflux=0
154 integer i,j,iii,l,k,ierr,nrec,ist,lusig,idrt,ncid3d,ncid2d,varid
155 integer :: prntsec,iim,jjm,llm,ioutcount,itmp,iret,iunit, &
156 iunitd3d,iyear,imn,iday,lcntrl,ieof
157 integer :: iostatusaer
160 integer :: kpo,kth,kpv
161 real,
dimension(komax) :: po,th,pv
162 namelist/nampgb/kpo,po,kth,th,kpv,pv,filenameaer,d3d_on,gocart_on,gccpp_on, nasa_on,gtg_on,method_blsn,popascal &
163 ,hyb_sigp,rdaod,d2d_chem, aqf_on,slrutah_on, vtimeunits,numx,write_ifi_debug_files
165 namelist/model_inputs/filename,ioform,grib,datestr,modelname,submodelname &
166 ,filenameflux,filenameflat
168 character startdate*19,sysdepinfo*80,iowrfname*3,post_fname*255
169 character cgar*1,cdum*4,line*10
195 if (me == 0)
CALL w3tagb(
'nems ',0000,0000,0000,
'np23 ')
197 if ( me >= num_procs )
then
209 filenameflat=
'postxconfig-NT.txt'
213 read(5,nml=model_inputs,iostat=itag_ierr,err=888)
214888
if (itag_ierr /= 0)
then
215 print*,
'Incorrect namelist variable(s) found in the itag file,stopping.'
218 if (me == 0)
write(6, model_inputs)
226 303
format(
'MODELNAME="',a,
'" SUBMODELNAME="',a,
'"')
228 if(me==0)
write(*,*)
'MODELNAME: ', modelname, submodelname
231 read(datestr,300) iyear,imn,iday,ihrst,imin
232 if (me==0)
write(*,*)
'in WRFPOST iyear,imn,iday,ihrst,imin', &
233 iyear,imn,iday,ihrst,imin
234 300
format(i4,1x,i2,1x,i2,1x,i2,1x,i2)
250 if(grib==
'grib2')
then
258 th = (/310.,320.,350.,450.,550.,650.,(0.,k=kth+1,komax)/)
260 pv = (/0.5,-0.5,1.0,-1.0,1.5,-1.5,2.0,-2.0,(0.,k=kpv+1,komax)/)
277 read(5,nampgb,iostat=iret,
end=119)
279 if (me == 0)
write(6, nampgb)
280 if(mod(num_procs,numx)/=0)
then
282 print*,
'total proces, num_procs=', num_procs
283 print*,
'number of subdomain in x direction, numx=', numx
284 print*,
'remainder of num_procs/numx = ', mod(num_procs,numx)
285 print*,
'Warning!!! the remainder of num_procs/numx is not 0, reset numx=1 &
286 & in this run or you adjust numx in the itag file to restart'
290 if(me == 0) print*,
'Warning!!! Reset numx as 1, numx=',numx
292 if(numx>num_procs/2)
then
294 print*,
'total proces, num_procs=', num_procs
295 print*,
'number of subdomain in x direction, numx=', numx
296 print*,
'Warning!!! numx cannot exceed num_procs/2, reset numx=1 in this run'
297 print*,
'or you adjust numx in the itag file to restart'
300 if(me == 0) print*,
'Warning!!! Reset numx as 1, numx=',numx
303 print*,
'komax,iret for nampgb= ',komax,iret
304 print*,
'komax,kpo,kth,th,kpv,pv,fileNameAER,nasa_on,popascal= ',komax,kpo &
305 & ,kth,th(1:kth),kpv,pv(1:kpv),trim(filenameaer),nasa_on,popascal
306 print*,
'NUM_PROCS=',num_procs
310 IF(trim(ioform) /=
'netcdfpara' .AND. trim(ioform) /=
'netcdf' )
THEN
312 if(me == 0) print*,
'2D decomposition only supports netcdfpara IO.'
313 if(me == 0) print*,
'Reset numx= ',numx
316 IF(modelname /=
'FV3R' .AND. modelname /=
'GFS')
THEN
318 if(me == 0) print*,
'2D decomposition only supports GFS and FV3R.'
319 if(me == 0) print*,
'Reset numx= ',numx
326 print*,
'using default pressure levels,spldef=',(spldef(l),l=1,lsmdef)
335 print*,
'using pressure levels from POSTGPVARS'
338 if( .not. popascal )
then
343 if(po(lsm) < po(1))
then
345 spl(l) = po(lsm-l+1)*untcnvt
349 spl(l) = po(l)*untcnvt
358 if(modelname ==
'NMM')
then
364 if(trim(ioform) ==
'netcdf' .OR. trim(ioform) ==
'netcdfpara')
THEN
365 IF(modelname ==
'NCAR' .OR. modelname ==
'RAPR' .OR. modelname ==
'NMM')
THEN
366 call ext_ncd_ioinit(sysdepinfo,status)
367 call ext_ncd_open_for_read( trim(filename), 0, 0,
" ", &
369 if ( status /= 0 )
then
370 print*,
'error opening ',filename,
' Status = ', status ; stop
372 call ext_ncd_get_dom_ti_integer(datahandle &
373 ,
'WEST-EAST_GRID_DIMENSION',iim,1,ioutcount, status )
375 call ext_ncd_get_dom_ti_integer(datahandle &
376 ,
'SOUTH-NORTH_GRID_DIMENSION',jjm,1,ioutcount, status )
378 call ext_ncd_get_dom_ti_integer(datahandle &
379 ,
'BOTTOM-TOP_GRID_DIMENSION',llm,1,ioutcount, status )
386 call ext_ncd_get_dom_ti_integer(datahandle &
387 ,
'SF_SURFACE_PHYSICS',itmp,1,ioutcount, status )
392 if (modelname ==
'RAPR' .and. submodelname ==
'MPAS') itmp = 3
394 isf_surface_physics = itmp
400 ELSE IF(itmp == 3)
then
402 ELSE IF(itmp == 7)
then
406 call ext_ncd_ioclose ( datahandle, status )
410 status = nf90_open(trim(filename),ior(nf90_nowrite,nf90_mpiio), &
411 ncid3d,comm=mpi_comm_world,info=mpi_info_null)
412 if ( status /= 0 )
then
413 print*,
'error opening ',filename,
' Status = ', status
416 status = nf90_open(trim(filenameflux),ior(nf90_nowrite,nf90_mpiio), &
417 ncid2d,comm=mpi_comm_world,info=mpi_info_null)
418 if ( status /= 0 )
then
419 print*,
'error opening ',filenameflux,
' Status = ', status
423 status=nf90_get_att(ncid2d,nf90_global,
'landsfcmdl', isf_surface_physics)
425 print*,
'landsfcmdl not found; assigning to 2'
426 isf_surface_physics=2
428 if(isf_surface_physics<2)
then
429 isf_surface_physics=2
431 status=nf90_get_att(ncid2d,nf90_global,
'nsoil', nsoil)
433 print*,
'nsoil not found; assigning to 4'
437 status=nf90_get_att(ncid2d,nf90_global,
'imp_physics',imp_physics)
439 print*,
'imp_physics not found; assigning to GFDL 11'
443 status = nf90_inq_dimid(ncid3d,
'grid_xt',varid)
444 if ( status /= 0 )
then
448 status = nf90_inquire_dimension(ncid3d,varid,len=im)
449 if ( status /= 0 )
then
453 status = nf90_inq_dimid(ncid3d,
'grid_yt',varid)
454 if ( status /= 0 )
then
458 status = nf90_inquire_dimension(ncid3d,varid,len=jm)
459 if ( status /= 0 )
then
463 status = nf90_inq_dimid(ncid3d,
'pfull',varid)
464 if ( status /= 0 )
then
468 status = nf90_inquire_dimension(ncid3d,varid,len=lm)
469 if ( status /= 0 )
then
481 ELSE IF(trim(ioform) ==
'binary' .OR. &
482 trim(ioform) ==
'binarympiio' )
THEN
483 print*,
'WRF Binary format is no longer supported'
486#if defined(BUILD_WITH_NEMSIO)
487 ELSE IF(trim(ioform) ==
'binarynemsio' .or. &
488 trim(ioform) ==
'binarynemsiompiio' )
THEN
492 call nemsio_init(iret=status)
493 call nemsio_open(nfile,trim(filename),
'read',iret=status)
494 if ( status /= 0 )
then
495 print*,
'error opening ',filename,
' Status = ', status ; stop
498 call nemsio_getfilehead(nfile,iret=status,nrec=nrec &
499 ,dimx=im,dimy=jm,dimz=lm,nsoil=nsoil)
500 if ( status /= 0 )
then
501 print*,
'error finding model dimensions '; stop
503 call nemsio_getheadvar(nfile,
'global',global,iret)
505 print*,
"global not found in file-Assigned false"
508 IF(modelname ==
'GFS') global = .true.
510 if(global .and. modelname ==
'NMM') im = im-1
514 CALL mpi_bcast(im, 1,mpi_integer,0, mpi_comm_comp,status)
515 call mpi_bcast(jm, 1,mpi_integer,0, mpi_comm_comp,status)
516 call mpi_bcast(lm, 1,mpi_integer,0, mpi_comm_comp,status)
517 call mpi_bcast(nsoil,1,mpi_integer,0, mpi_comm_comp,status)
519 call mpi_bcast(global,1,mpi_logical,0,mpi_comm_comp,status)
525 IF(modelname ==
'GFS')
THEN
527 call nemsio_open(ffile,trim(filenameflux),
'read',iret=iostatusflux)
528 if ( iostatusflux /= 0 )
then
529 print*,
'error opening ',filenameflux,
' Status = ', iostatusflux
535 call nemsio_open(rfile,trim(filenameaer),
'read',iret=iostatusaer)
536 if ( iostatusaer /= 0 .and. me == 0)
then
537 print*,
'error opening AER ',filenameaer,
' Status = ', iostatusaer
545 print*,
'UNKNOWN MODEL OUTPUT FORMAT, STOPPING'
563 if(modelname ==
'GFS')
THEN
566 else if(modelname==
'NMM' .and. trim(ioform)==
'binarynemsio')
then
569 else if(modelname==
'RAPR')
then
579 IF(trim(ioform) ==
'netcdf' .OR. trim(ioform) ==
'netcdfpara')
THEN
580 IF(modelname ==
'NCAR' .OR. modelname ==
'RAPR')
THEN
581 IF (submodelname ==
'MPAS')
THEN
586 ELSE IF (modelname ==
'FV3R' .OR. modelname ==
'GFS')
THEN
590 print*,
'POST does not have netcdf option for model,',modelname,
' STOPPING,'
593 ELSE IF(trim(ioform) ==
'binarympiio')
THEN
594 IF(modelname ==
'NCAR' .OR. modelname ==
'RAPR' .OR. modelname ==
'NMM')
THEN
595 print*,
'WRF BINARY IO FORMAT IS NO LONGER SUPPORTED, STOPPING'
597 ELSE IF(modelname ==
'RSM')
THEN
598 print*,
'MPI BINARY IO IS NOT YET INSTALLED FOR RSM, STOPPING'
601 print*,
'POST does not have mpiio option for this model, STOPPING'
604#if defined(BUILD_WITH_NEMSIO)
605 ELSE IF(trim(ioform) ==
'binarynemsio')
THEN
606 IF(modelname ==
'NMM')
THEN
609 print*,
'POST does not have nemsio option for model,',modelname,
' STOPPING,'
614 ELSE IF(trim(ioform) ==
'binarynemsiompiio')
THEN
615 IF(modelname ==
'GFS')
THEN
617 call nemsio_close(nfile,iret=status)
618 call nemsio_close(ffile,iret=status)
619 call nemsio_close(rfile,iret=status)
622 print*,
'POST does not have nemsio mpi option for model,',modelname, &
629 print*,
'UNKNOWN MODEL OUTPUT FORMAT, STOPPING'
632 initpost_tim = initpost_tim +(mpi_wtime() - btim)
634 WRITE(6,*)
'WRFPOST: INITIALIZED POST COMMON BLOCKS'
639 if(grib ==
"grib2")
then
642 readxml_tim = readxml_tim + (mpi_wtime() - btim)
650 first_grbtbl = .true.
687 if (me==0)
write(*,*)
' in WRFPOST OUTFORM= ',grib
688 if (me==0)
write(*,*)
' GRIB1 IS NOT SUPPORTED ANYMORE'
689 if (grib ==
"grib2")
then
690 do while (npset < num_pset)
692 if (me==0)
write(*,*)
' in WRFPOST npset=',npset,
' num_pset=',num_pset
694 if (me==0)
write(*,*)
' in WRFPOST size datapd',
size(datapd)
695 if(
allocated(datapd))
deallocate(datapd)
698 allocate(datapd(1:iend-ista+1,1:jend-jsta+1,nrecout+100))
709 call get_postfilename(post_fname)
710 if (me==0)
write(*,*)
'post_fname=',trim(post_fname)
711 if (me==0)
write(*,*)
'get_postfilename,post_fname=',trim(post_fname), &
712 'npset=',npset,
'num_pset=',num_pset, &
713 'iSF_SURFACE_PHYSICS=',isf_surface_physics
720 CALL process(kth,kpv,th(1:kth),pv(1:kpv),iostatusd3d)
721 IF(me == 0)
WRITE(6,*)
'WRFPOST: PREPARE TO PROCESS NEXT GRID'
724 call mpi_barrier(mpi_comm_comp,ierr)
728 call gribit2(post_fname)
739 call grib_info_finalize()
743 WRITE(6,*)
'ALL GRIDS PROCESSED.'
754 print*,
'INITPOST_tim = ', initpost_tim
755 print*,
'MDLFLD_tim = ', etafld2_tim
756 print*,
'MDL2P_tim = ',eta2p_tim
757 print*,
'MDL2SIGMA_tim = ',mdl2sigma_tim
758 print*,
'MDL2AGL_tim = ',mdl2agl_tim
759 print*,
'SURFCE_tim = ',surfce2_tim
760 print*,
'CLDRAD_tim = ',cldrad_tim
761 print*,
'MISCLN_tim = ',miscln_tim
762 print*,
'MDL2STD_tim = ',mdl2std_tim
763 print*,
'FIXED_tim = ',fixed_tim
764 print*,
'MDL2THANDPV_tim = ',mdl2thandpv_tim
765 print*,
'CALRAD_WCLOUD_tim = ',calrad_wcloud_tim
766 print*,
'RUN_IFI_tim = ',run_ifi_tim
767 print*,
'Total time = ',(mpi_wtime() - bbtim)
768 print*,
'Time for OUTPUT = ',time_output
769 print*,
'Time for READxml = ',readxml_tim
785 if (me == 0)
CALL w3tage(
'UNIFIED_POST')
786 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_mpas
This routine initializes constants and variables when using UPP on MPAS model output.
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...